diff --git a/package.yaml b/package.yaml index 3c8e52b..f6cf3dc 100644 --- a/package.yaml +++ b/package.yaml @@ -46,8 +46,10 @@ dependencies: - time - case-insensitive - wai +- conduit-combinators >= 1.1 && < 1.2 - gitrev >= 1.3 && <1.4 - libravatar >=0.4 && <0.5 +- split >=0.2 && <0.3 - yesod-sitemap >=1.4 && <1.5 # The library contains all of our application code. The executable diff --git a/src/Import.hs b/src/Import.hs index a102001..17e42b2 100644 --- a/src/Import.hs +++ b/src/Import.hs @@ -3,4 +3,5 @@ module Import ) where import Foundation as Import +import Settings.StaticR as Import import Import.NoFoundation as Import diff --git a/src/Settings/StaticR.hs b/src/Settings/StaticR.hs new file mode 100644 index 0000000..e681ed3 --- /dev/null +++ b/src/Settings/StaticR.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module Settings.StaticR ( staticR ) where + +import Foundation ( App, Route(StaticR) ) +import Settings ( appStaticDir, compileTimeAppSettings ) +import Yesod.Static ( Route(StaticRoute) ) + +import Settings.StaticR.TH ( mkHashMap ) + +import qualified Data.Map as M +import qualified Data.Text as T + +staticR :: [T.Text] -> Route App +staticR pieces = StaticR $ StaticRoute pieces params + where params = case pieces `M.lookup` staticMap of + Just etag -> [("etag", etag)] + Nothing -> [] + +staticMap :: M.Map [T.Text] T.Text +staticMap = M.fromList $(mkHashMap . appStaticDir $ compileTimeAppSettings) diff --git a/src/Settings/StaticR/TH.hs b/src/Settings/StaticR/TH.hs new file mode 100644 index 0000000..098d30e --- /dev/null +++ b/src/Settings/StaticR/TH.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +module Settings.StaticR.TH ( mkHashMap ) where + +import Conduit hiding ( lift ) +import Data.List.Split ( splitOn ) +import Language.Haskell.TH.Syntax ( Q, Exp, lift, runIO ) +import Yesod.Static ( base64md5 ) + +import qualified Data.ByteString.Lazy as L + +base64md5File :: MonadIO m => FilePath -> m String +base64md5File = fmap base64md5 . liftIO . L.readFile + +genHashPair :: MonadIO m => FilePath -> m ([String], String) +genHashPair fp = (tail $ splitOn "/" fp,) <$> base64md5File fp + +genHashMap :: FilePath -> IO [([String], String)] +genHashMap dir = runConduitRes + $ sourceDirectoryDeep True dir + .| mapMC genHashPair + .| sinkList + +mkHashMap :: FilePath -> Q Exp +mkHashMap fp = lift =<< runIO (genHashMap fp)