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