1 {-# LANGUAGE OverloadedStrings, ViewPatterns, TupleSections, CPP #-} 2 module Databrary.Web.Rules 3 ( generateWebFile 4 , generateWebFiles 5 ) where 6 7 import Control.Monad (guard, mzero, msum, (<=<)) 8 import Control.Monad.IO.Class (liftIO) 9 import Control.Monad.State.Strict (execStateT, modify, gets) 10 import Control.Monad.Trans.Except (runExceptT, withExceptT) 11 import qualified Data.HashMap.Strict as HM 12 import qualified System.Posix.FilePath as RF 13 import System.Process (callCommand) 14 15 import Databrary.Ops (fromMaybeM) 16 import Databrary.Files (RawFilePath) 17 import Databrary.Web (WebFilePath (..), makeWebFilePath) 18 import Databrary.Web.Types (WebGenerator, WebGeneratorM, WebFileInfo (..), WebFileMap) 19 import Databrary.Web.Files (findWebFiles) 20 import Databrary.Web.Info (makeWebFileInfo) 21 import Databrary.Web.Generate (fileNewer) 22 #ifndef NODB 23 import Databrary.Web.Constants 24 import Databrary.Web.Routes 25 #endif 26 import Databrary.Web.Templates 27 import Databrary.Web.Messages 28 import Databrary.Web.Coffee 29 import Databrary.Web.Uglify 30 import Databrary.Web.Stylus 31 import Databrary.Web.Libs 32 import Databrary.Web.All 33 import Databrary.Web.GZip 34 35 staticGenerators :: [(RawFilePath, WebGenerator)] 36 #ifdef NODB 37 staticGenerators = [] 38 #else 39 staticGenerators = 40 [ ("constants.json", generateConstantsJSON) 41 , ("constants.js", generateConstantsJS) 42 , ("routes.js", generateRoutesJS) 43 ] 44 #endif 45 46 fixedGenerators :: [(RawFilePath, WebGenerator)] 47 fixedGenerators = 48 [ ("messages.js", generateMessagesJS) 49 , ("templates.js", generateTemplatesJS) 50 , ("app.min.js", generateUglifyJS) 51 , ("app.css", generateStylusCSS) 52 , ("app.min.css", generateStylusCSS) 53 , ("all.min.js", generateAllJS) 54 , ("all.min.css", generateAllCSS) 55 ] 56 57 generateFixed :: Bool -> WebGenerator 58 generateFixed includeStatic = \fo@(f, _) -> do 59 case lookup (webFileRel f) $ (if includeStatic then (staticGenerators ++) else id) fixedGenerators of 60 Just g -> g fo 61 _ -> mzero 62 63 generateStatic :: WebGenerator 64 generateStatic fo@(f, _) = fileNewer (webFileAbs f) fo 65 66 generateRules :: Bool -> WebGenerator 67 generateRules includeStatic (fileToGen, mPriorFileInfo) = msum $ map (\gen -> gen (fileToGen, mPriorFileInfo)) 68 ([ 69 generateFixed includeStatic 70 , generateCoffeeJS 71 , generateLib 72 , generateGZip 73 , generateStatic 74 ] :: [WebGenerator]) 75 76 updateWebInfo :: WebFilePath -> WebGeneratorM WebFileInfo 77 updateWebInfo f = do 78 n <- liftIO $ makeWebFileInfo f 79 modify $ HM.insert f n 80 return n 81 82 generateWebFile :: Bool -> WebFilePath -> WebGeneratorM WebFileInfo 83 generateWebFile includeStatic f = 84 withExceptT (\val -> label (show (webFileRel f)) val) $ do 85 mExistingInfo <- gets $ HM.lookup f 86 r <- generateRules includeStatic (f, mExistingInfo) 87 fromMaybeM 88 (updateWebInfo f) 89 (guard (not r) >> mExistingInfo :: Maybe WebFileInfo) 90 where 91 label n "" = n 92 label n s = n ++ ": " ++ s 93 94 generateAll :: WebGeneratorM () 95 generateAll = do 96 svg <- liftIO $ findWebFiles ".svg" 97 ( mapM_ (\webFilePath -> generateWebFile True webFilePath) 98 <=< mapM (liftIO . makeWebFilePath) 99 $ mconcat 100 [ (map fst staticGenerators) 101 , ["constants.json.gz", "all.min.js.gz", "all.min.css.gz"] 102 , map ((RF.<.> ".gz") . webFileRel) svg 103 ]) 104 105 generateWebFiles :: IO WebFileMap 106 generateWebFiles = do 107 webFileMap <- 108 execStateT 109 (do 110 eWebFileMap <- runExceptT generateAll 111 either fail return eWebFileMap) 112 HM.empty 113 -- TODO: variables for filenames 114 callCommand "cat web/all.min.js web/all.min.css | md5sum | cut -d ' ' -f 1 > jsCssVersion.txt" 115 pure webFileMap