module Web.Herringbone.Precompile where
import Language.Haskell.TH.Syntax (Q, Exp(..), Lit(..), runIO)
import Data.FileEmbed (embedDir)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B8
import qualified Filesystem.Path.CurrentOS as F
import qualified Data.Text as T
import Control.Monad (forM, (>=>))
import Web.Herringbone
import Web.Herringbone.Internal.GetBuildMapping (getBuildMapping)
import Web.Herringbone.Internal.Types (BuildSpec(..), LogicalPath(..))
precompile :: Herringbone -> IO [(LogicalPath, AssetError)]
precompile hb = do
mapping <- getBuildMapping hb
results <- forM mapping $ \(BuildSpec _ destPath _) -> do
let Just path = toLogicalPath $ destPath
asset <- findAsset hb path
case asset of
Right _ -> return []
Left err -> return [(path, err)]
return $ concat results
where
toLogicalPath =
toMaybe F.toText >=>
return . T.splitOn "/" >=>
makeLogicalPath
toMaybe f x = case f x of
Right y -> Just y
Left _ -> Nothing
embedAssets :: IO Herringbone -> Q Exp
embedAssets iohb = do
hb <- runIO iohb
errs <- runIO (precompile hb)
let errsExp = ListE $ map (\(path, err) ->
TupE [logicalPathToExp path, errToExp err]) errs
SigE filesExp' _ <- embedDir (F.encodeString $ hbDestDir hb)
let filesExp = transformFiles filesExp'
let expr = TupE [errsExp, filesExp]
type_ <- [t| ([(LogicalPath, AssetError)], [(LogicalPath, ByteString)]) |]
return $ SigE expr type_
where
logicalPathToExp logicalPath =
AppE
(ConE 'LogicalPath)
(ListE (map (LitE . StringL . T.unpack)
(fromLogicalPath logicalPath)))
errToExp e = case e of
AssetNotFound ->
ConE 'AssetNotFound
AssetCompileError err ->
AppE (ConE 'AssetCompileError) $ compileErrToExp err
AmbiguousSources srcs ->
AppE (ConE 'AmbiguousSources) $ sourcesToExp srcs
compileErrToExp err = LitE (StringL (B8.unpack err))
sourcesToExp srcs = ListE $ map filePathToExp srcs
filePathToExp path = LitE (StringL (F.encodeString path))
transformFiles (ListE tups) =
let f (TupE [LitE (StringL path), contents]) =
TupE [logicalPathExp path, contents]
f _ = error "unexpected Exp in precompileEmbed"
in ListE $ map f tups
transformFiles _ = error "unexpected Exp in precompileEmbed"
logicalPathExp = logicalPathToExp . stringToLogicalPath
stringToLogicalPath = unsafeMakeLogicalPath . T.splitOn "/" . T.pack