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

{- |
   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 :: MimeTypeTable -> IOStateArrow s b b
setMimeTypeTable MimeTypeTable
mtt            = SysConfig -> IOStateArrow s b b
forall s c. SysConfig -> IOStateArrow s c c
configSysVar (SysConfig -> IOStateArrow s b b)
-> SysConfig -> IOStateArrow s b b
forall a b. (a -> b) -> a -> b
$ Selector XIOSysState (MimeTypeTable, String)
-> (MimeTypeTable, String) -> SysConfig
forall s a. Selector s a -> a -> s -> s
setS (Selector XIOSysState MimeTypeTable
theMimeTypes Selector XIOSysState MimeTypeTable
-> Selector XIOSysState String
-> Selector XIOSysState (MimeTypeTable, String)
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 :: String -> IOStateArrow s b b
setMimeTypeTableFromFile String
file   = SysConfig -> IOStateArrow s b b
forall s c. SysConfig -> IOStateArrow s c c
configSysVar (SysConfig -> IOStateArrow s b b)
-> SysConfig -> IOStateArrow s b b
forall a b. (a -> b) -> a -> b
$ Selector XIOSysState String -> String -> SysConfig
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 :: IOStateArrow s b MimeTypeTable
getMimeTypeTable                = (MimeTypeTable, String) -> IOStateArrow s b MimeTypeTable
forall s b.
(MimeTypeTable, String) -> IOSLA (XIOState s) b MimeTypeTable
getMime ((MimeTypeTable, String) -> IOStateArrow s b MimeTypeTable)
-> IOSLA (XIOState s) b (MimeTypeTable, String)
-> IOStateArrow s b MimeTypeTable
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< Selector XIOSysState (MimeTypeTable, String)
-> IOSLA (XIOState s) b (MimeTypeTable, String)
forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar (Selector XIOSysState MimeTypeTable
theMimeTypes Selector XIOSysState MimeTypeTable
-> Selector XIOSysState String
-> Selector XIOSysState (MimeTypeTable, String)
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) b MimeTypeTable
getMime (MimeTypeTable
mtt, String
"")           = MimeTypeTable -> IOSLA (XIOState s) b MimeTypeTable
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA MimeTypeTable
mtt
    getMime (MimeTypeTable
_,  String
mtf)           = IOSLA (XIOState s) b b -> IOSLA (XIOState s) b b
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform (MimeTypeTable -> IOSLA (XIOState s) b b
forall s b. MimeTypeTable -> IOStateArrow s b b
setMimeTypeTable (MimeTypeTable -> IOSLA (XIOState s) b b)
-> IOSLA (XIOState s) b MimeTypeTable -> IOSLA (XIOState s) b b
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< IO MimeTypeTable -> IOSLA (XIOState s) b MimeTypeTable
forall (a :: * -> * -> *) c b. ArrowIO a => IO c -> a b c
arrIO0 ( String -> IO MimeTypeTable
readMimeTypeTable String
mtf))
                                  IOSLA (XIOState s) b b
-> IOSLA (XIOState s) b MimeTypeTable
-> IOSLA (XIOState s) b MimeTypeTable
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  IOSLA (XIOState s) b MimeTypeTable
forall s b. IOStateArrow s b MimeTypeTable
getMimeTypeTable

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