-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.Arrow.XmlState.MimeTypeTable
   Copyright  : Copyright (C) 2010 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : stable
   Portability: portable

   the mime type configuration functions

-}

-- ------------------------------------------------------------

module Text.XML.HXT.Arrow.XmlState.MimeTypeTable
where

import Control.Arrow                            -- arrow classes
import Control.Arrow.ArrowList
import Control.Arrow.ArrowIO

import Text.XML.HXT.DOM.Interface

import Text.XML.HXT.Arrow.XmlState.TypeDefs

-- ------------------------------------------------------------

-- | set the table mapping of file extensions to mime types in the system state
--
-- Default table is defined in 'Text.XML.HXT.DOM.MimeTypeDefaults'.
-- This table is used when reading loacl files, (file: protocol) to determine the mime type

setMimeTypeTable                :: MimeTypeTable -> IOStateArrow s b b
setMimeTypeTable :: forall s b. MimeTypeTable -> IOStateArrow s b b
setMimeTypeTable MimeTypeTable
mtt            = forall s c. SysConfig -> IOStateArrow s c c
configSysVar forall a b. (a -> b) -> a -> b
$ forall s a. Selector s a -> a -> s -> s
setS (Selector XIOSysState MimeTypeTable
theMimeTypes forall s a b. Selector s a -> Selector s b -> Selector s (a, b)
.&&&. Selector XIOSysState String
theMimeTypeFile) (MimeTypeTable
mtt, String
"")

-- | set the table mapping of file extensions to mime types by an external config file
--
-- The config file must follow the conventions of /etc/mime.types on a debian linux system,
-- that means all empty lines and all lines starting with a # are ignored. The other lines
-- must consist of a mime type followed by a possible empty list of extensions.
-- The list of extenstions and mime types overwrites the default list in the system state
-- of the IOStateArrow

setMimeTypeTableFromFile        :: FilePath -> IOStateArrow s b b
setMimeTypeTableFromFile :: forall s b. String -> IOStateArrow s b b
setMimeTypeTableFromFile String
file   = forall s c. SysConfig -> IOStateArrow s c c
configSysVar forall a b. (a -> b) -> a -> b
$ forall s a. Selector s a -> a -> s -> s
setS Selector XIOSysState String
theMimeTypeFile String
file

-- | read the system mimetype table

getMimeTypeTable                :: IOStateArrow s b MimeTypeTable
getMimeTypeTable :: forall s b. IOStateArrow s b MimeTypeTable
getMimeTypeTable                = forall {s} {c}.
(MimeTypeTable, String) -> IOSLA (XIOState s) c MimeTypeTable
getMime forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar (Selector XIOSysState MimeTypeTable
theMimeTypes forall s a b. Selector s a -> Selector s b -> Selector s (a, b)
.&&&. Selector XIOSysState String
theMimeTypeFile)
    where
    getMime :: (MimeTypeTable, String) -> IOSLA (XIOState s) c MimeTypeTable
getMime (MimeTypeTable
mtt, String
"")           = forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA MimeTypeTable
mtt
    getMime (MimeTypeTable
_,  String
mtf)           = forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform (forall s b. MimeTypeTable -> IOStateArrow s b b
setMimeTypeTable forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall (a :: * -> * -> *) c b. ArrowIO a => IO c -> a b c
arrIO0 ( String -> IO MimeTypeTable
readMimeTypeTable String
mtf))
                                  forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  forall s b. IOStateArrow s b MimeTypeTable
getMimeTypeTable

-- ------------------------------------------------------------