1 {-# LANGUAGE OverloadedStrings, CPP #-} 2 module 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 Ops (fromMaybeM) 16 import Files (RawFilePath) 17 import Web (WebFilePath (..), makeWebFilePath) 18 import Web.Types (WebGenerator, WebGeneratorM, WebFileInfo (..), WebFileMap) 19 import Web.Files (findWebFiles) 20 import Web.Info (makeWebFileInfo) 21 import Web.Generate (fileNewer) 22 #ifndef NODB 23 import Web.Constants 24 import Web.Routes 25 #endif 26 import Web.Templates 27 import Web.Messages 28 import Web.Coffee 29 import Web.Uglify 30 import Web.Stylus 31 import Web.Libs 32 import Web.All 33 import 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, _) -> 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 (label (show (webFileRel f))) $ 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_ (generateWebFile True) 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