Static file combining code from FP Complete codebase

example-usage.hs

do
    $(combineStylesheets 'StaticR
        [ design_fonts_fonts_css
        , design_css_normalize_css
        , design_css_style_css
        , css_icomoon_css

        , codemirror_lib_codemirror_css

        , codemirror_addon_dialog_dialog_css
        ])

    $(combineScripts 'StaticR
        [ design_js_init_js
        , js_blockUI_js

        , codemirror_lib_codemirror_js
        , codemirror_lib_util_multiplex_js
        , codemirror_lib_util_runmode_js

        , codemirror_mode_xml_xml_js
        , codemirror_mode_css_css_js
        , codemirror_mode_javascript_javascript_js
        , codemirror_mode_htmlmixed_htmlmixed_js
        , codemirror_mode_haskell_haskell_js
        , codemirror_mode_haskell_routes_js
        , codemirror_mode_haskell_shakespeare_shakespeare_js
        , codemirror_mode_haskell_shakespeare_css_js
        , codemirror_mode_haskell_shakespeare_julius_js
        , codemirror_mode_haskell_shakespeare_lucius_js
        , codemirror_mode_haskell_shakespeare_cassius_js
        , codemirror_mode_haskell_shakespeare_hamlet_js
        , codemirror_mode_haskell_shakespeare_yesod_js
        , codemirror_mode_markdown_markdown_js
        , codemirror_mode_yaml_yaml_js

        , codemirror_keymap_emacs_js
        , codemirror_keymap_vim_js

        , codemirror_addon_dialog_dialog_js
        ])

StaticFiles.hs

combineStatics' :: Text -- ^ filename extension
                -> ([FilePath] -> LByteString -> IO LByteString) -- ^ post-process
                -> [Route Static]
                -> Q Exp -- FIXME some version of this function should move to yesod-static. FIXME: during development, automatically recombine
combineStatics' extension postProcess routes = do
    texts <- qRunIO $ runResourceT $ mapM_ yield fps $$ awaitForever readUTFFile =$ consume
    bs <-    qRunIO
           $ postProcess fps
           $ encodeUtf8
           -- FIXME The following borders on a hack. With combining of files,
           -- the final location of the CSS is no longer fixed, so relative
           -- references will break. Instead, we switched to using /static/
           -- absolute references. However, when served from a separate domain
           -- name, this will break too. The solution is that, during
           -- development, we keep /static/, and in the combining phase, we
           -- replace /static with a relative reference to the parent folder.
           $ TL.replace "'/static/" "'../"
           $ TL.replace "\"/static/" "\"../"
           $ fromChunks texts
    let hash' = base64md5 bs
        suffix = "combined" </> pack hash' <.> extension
        fp = root </> suffix
    qRunIO $ do
        createTree $ directory fp
        writeFile fp bs
    let slashToSpace '/' = ' '
        slashToSpace c = c
    let pieces = words $ map slashToSpace $ unpack suffix
    [|StaticRoute (map pack $ pieces) []|]
  where
    fps :: [FilePath]
    fps = map toFP routes
    toFP (StaticRoute pieces _) = root </> concat (map repack pieces)
    root = pack staticDir
    readUTFFile fp = sourceFile fp =$= detectUtf

errorIntro :: [FilePath] -> [Char] -> [Char]
errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s

minifyJS :: [FilePath] -> LByteString -> IO LByteString
minifyJS _fps = return -- FIXME = either (error . (errorIntro fps)) return . minifym

minifyCSS :: [FilePath] -> LByteString -> IO LByteString
minifyCSS fps
    = either (error . (errorIntro fps)) (return . encodeUtf8)
    . flip luciusRTMinified []
    . decodeUtf8

combineStylesheets :: Name -> [Route Static] -> Q Exp
combineStylesheets con routes
    | development = [| mapM_ (addStylesheet . $(return $ ConE con)) $(liftRoutes routes) |]
    | otherwise = [| addStylesheet $ $(return $ ConE con) $(combineStatics' "css" minifyCSS routes) |]

combineScripts :: Name -> [Route Static] -> Q Exp
combineScripts con routes
    | development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |]
    | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' "js" minifyJS routes) |]