1 {-# LANGUAGE OverloadedStrings #-}
    2 module Databrary.Web.Libs
    3   ( generateLib
    4   , webDeps
    5   , cssWebDeps
    6   , webLibs
    7   , webIncludes
    8   ) where
    9 
   10 import Control.Monad (mzero)
   11 import Control.Monad.IO.Class (liftIO)
   12 import Data.Maybe (maybeToList)
   13 import Data.List (stripPrefix)
   14 import System.FilePath ((</>), splitFileName, (<.>))
   15 
   16 import Databrary.Web
   17 import Databrary.Files (rawFilePath, unRawFilePath)
   18 import Databrary.Web.Types
   19 import Databrary.Web.Generate
   20 
   21 prefix :: FilePath
   22 prefix = "node_modules"
   23 
   24 jsDeps, jsIncludes, jsAll :: [(FilePath, FilePath)]
   25 jsDeps = -- included in all
   26   [ ("jquery",              "jquery/dist")
   27   , ("angular",             "angular")
   28   , ("angular-route",       "angular-route")
   29   , ("ng-flow-standalone",  "@flowjs/ng-flow/dist")
   30   , ("pivot",               "pivottable/dist")
   31   , ("index",               "lodash")
   32   ]
   33 jsIncludes = -- included in app (along with our js)
   34   [ ("jquery-ui", "jquery-ui-dist") ] ++
   35   [ ("slider", "angular-ui-slider/src") ]
   36 jsAll = jsDeps ++ jsIncludes
   37 
   38 extensions :: [FilePath]
   39 extensions = ["js", "min.js", "min.map", "min.js.map", "css", "min.css"]
   40 
   41 generateLib :: WebGenerator
   42 generateLib = \fo@(f, _) -> do
   43   fp <- liftIO $ unRawFilePath $ webFileRel f
   44   let (libDir, l) = splitFileName fp
   45       nodeDir = case [ p | (b, p) <- jsAll, ('.':e) <- maybeToList (stripPrefix b l), e `elem` extensions ] of
   46             [a] -> Just a
   47             _ -> Nothing
   48   case (libDir, nodeDir) of
   49     ("lib/", Just p) -> webLinkDataFile (prefix </> p </> l) fo
   50     _ -> mzero
   51 
   52 webJS :: Bool -> [(FilePath, FilePath)] -> IO [WebFilePath]
   53 webJS mn =
   54     makeWebFilePaths
   55   . map
   56         (  ("lib" </>)
   57          . (<.> if mn then ".min.js" else ".js")
   58          . fst
   59         )
   60 
   61 webDeps :: Bool -> IO [WebFilePath]
   62 webDeps debug = webJS (not debug) jsDeps
   63 
   64 cssWebDeps :: Bool -> IO [WebFilePath]
   65 cssWebDeps debug = makeWebFilePaths $ map ((<.> if debug then ".css" else ".min.css")) ["lib/pivot", "app"]
   66 
   67 webLibs :: IO [WebFilePath]
   68 webLibs = do
   69   paths <- webJS True jsDeps
   70   pivotCssWebFilePath <- makeWebFilePath "lib/pivot.css"
   71   return $ paths ++ [pivotCssWebFilePath]
   72 
   73 webIncludes :: IO [WebFilePath]
   74 webIncludes = webJS False jsIncludes
   75 
   76 makeWebFilePaths :: [FilePath] -> IO [WebFilePath]
   77 makeWebFilePaths = mapM (\f -> makeWebFilePath =<< rawFilePath f)