57 lines
1.5 KiB
Haskell
57 lines
1.5 KiB
Haskell
module Network.Mime.TH
|
|
( mimeMapFile, mimeSetFile
|
|
) where
|
|
|
|
import ClassyPrelude.Yesod hiding (lift)
|
|
import Language.Haskell.TH hiding (Extension)
|
|
import Language.Haskell.TH.Syntax (qAddDependentFile, Lift(..))
|
|
|
|
import qualified Data.Set as Set
|
|
import qualified Data.Map as Map
|
|
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as Text
|
|
import qualified Data.Text.IO as Text
|
|
import qualified Data.Text.Encoding as Text
|
|
|
|
import Network.Mime
|
|
|
|
import Instances.TH.Lift ()
|
|
|
|
|
|
mimeMapFile, mimeSetFile :: FilePath -> ExpQ
|
|
mimeMapFile file = do
|
|
qAddDependentFile file
|
|
|
|
mappings <- runIO $ filter (not . isComment) . Text.lines <$> Text.readFile file
|
|
let
|
|
coMappings :: [(Extension, MimeType)]
|
|
coMappings = do
|
|
(mimeType : extensions) <- filter (not . Text.null) . Text.words <$> mappings
|
|
ext <- extensions
|
|
return (ext, Text.encodeUtf8 mimeType)
|
|
|
|
mimeMap = Map.fromListWithKey duplicateError coMappings
|
|
|
|
duplicateError ext t1 t2 = error . Text.unpack $ "Duplicate mimeMap-entries for extension " <> ext <> ": " <> Text.decodeUtf8 t1 <> ", " <> Text.decodeUtf8 t2
|
|
|
|
|
|
lift mimeMap
|
|
mimeSetFile file = do
|
|
qAddDependentFile file
|
|
|
|
ls <- runIO $ filter (not . isComment) . Text.lines <$> Text.readFile file
|
|
|
|
let mimeSet :: Set MimeType
|
|
mimeSet = Set.fromList $ map (encodeUtf8 . Text.strip) ls
|
|
|
|
lift mimeSet
|
|
|
|
isComment :: Text -> Bool
|
|
isComment line = or
|
|
[ commentSymbol `Text.isPrefixOf` Text.stripStart line
|
|
, Text.null $ Text.strip line
|
|
]
|
|
where
|
|
commentSymbol = "#"
|