This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Settings/StaticFiles/Generator.hs
2019-02-13 19:58:35 +01:00

73 lines
2.4 KiB
Haskell

module Settings.StaticFiles.Generator
( staticGenerator
) where
import ClassyPrelude
import Yesod.EmbeddedStatic.Types
import Yesod.EmbeddedStatic
import System.FilePath
import System.Directory.Tree
import Network.Mime
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as Map
import qualified Text.Sass.Compilation as Sass
import Text.Sass.Options
import Data.Default
import qualified Data.Foldable as Fold
staticGenerator :: FilePath -> Generator
staticGenerator staticDir = do
dirTree' <- runIO $ readDirectoryWith toEntries staticDir
Fold.forM_ (fst <$> zipPaths dirTree') addDependentFile
return . Fold.fold $ dirTree dirTree'
where
toEntries :: FilePath -- ^ Absolute path
-> IO [Entry]
toEntries loc = compile (mimeByExt mimeMap defaultMimeType $ pack loc) (makeRelative staticDir loc) loc
mimeMap = defaultMimeMap `mappend` Map.fromList
[ ("sass", "text/x-sass")
, ("scss", "text/x-scss")
]
compile :: MimeType
-> Location -- ^ Relative location
-> FilePath -- ^ Absolute filepath
-> IO [Entry]
compile "text/x-scss" sassLoc fp = return . pure $ def
{ ebHaskellName = Just $ pathToName sassLoc
, ebLocation
, ebMimeType = "text/css"
, ebProductionContent = either (fail <=< Sass.errorMessage) (return . LBS.fromStrict) =<< Sass.compileFile fp def
, ebDevelReload = [| either (fail <=< Sass.errorMessage) (return . LBS.fromStrict) =<< Sass.compileFile $(litE $ stringL fp) def |]
}
where
ebLocation = sassLoc -<.> "css"
compile "text/x-sass" sassLoc fp = return . pure $ def
{ ebHaskellName = Just $ pathToName sassLoc
, ebLocation
, ebMimeType = "text/css"
, ebProductionContent = either (fail <=< Sass.errorMessage) (return . LBS.fromStrict) =<< Sass.compileFile fp (def { sassIsIndentedSyntax = True })
, ebDevelReload = [| either (fail <=< Sass.errorMessage) (return . LBS.fromStrict) =<< Sass.compileFile $(litE $ stringL fp) (def { sassIsIndentedSyntax = True }) |]
}
where
ebLocation = sassLoc -<.> "css"
compile ebMimeType ebLocation fp = return . pure $ def
{ ebHaskellName = Just $ pathToName ebLocation
, ebLocation
, ebMimeType
, ebProductionContent = LBS.fromStrict <$> BS.readFile fp
, ebDevelReload = [| LBS.fromStrict <$> BS.readFile $(litE $ stringL fp) |]
}