Add a utility function, staticR, which can dynamically build StaticR routes with their ETags attached (still calculated at compile-time)

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

src/Import.hs

@@ -3,4 +3,5 @@ module Import
     ) where
 
 import Foundation            as Import
+import Settings.StaticR      as Import
 import Import.NoFoundation   as Import

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)

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)