65 lines
1.9 KiB
Haskell
65 lines
1.9 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 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 sassMime sassLoc fp
|
|
| sassMime `elem` [ "text/x-sass", "text/x-scss" ]
|
|
= return . pure $ def
|
|
{ ebHaskellName = Just $ pathToName ebLocation
|
|
, 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 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) |]
|
|
}
|