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