1 module Databrary.Web.Generate
    2   ( fileNewer
    3   , staticWebGenerate
    4   , webRegenerate
    5   , webLinkDataFile
    6   ) where
    7 
    8 import Control.Monad (when, unless)
    9 import Control.Monad.Except (throwError)
   10 import Control.Monad.IO.Class (liftIO)
   11 import System.Directory (createDirectoryIfMissing, canonicalizePath)
   12 import System.FilePath (splitFileName, takeDirectory)
   13 import qualified System.FilePath as FP
   14 import System.Posix.Files.ByteString (createSymbolicLink, rename, fileExist, removeLink)
   15 
   16 import Paths_databrary (getDataFileName)
   17 import Databrary.Files
   18 import Databrary.Model.Time
   19 import Databrary.Web
   20 import Databrary.Web.Types
   21 import {-# SOURCE #-} Databrary.Web.Rules
   22 
   23 anyM :: Monad m => [m Bool] -> m Bool
   24 anyM [] = return False
   25 anyM (a:l) = do
   26   r <- a
   27   if r then return True else anyM l
   28 
   29 fileNotFound :: RawFilePath -> WebGeneratorM a
   30 fileNotFound rf = do
   31   f <- liftIO $ unRawFilePath rf
   32   throwError $ f ++ " not found\n"
   33 
   34 fileNewerThan :: Timestamp -> RawFilePath -> WebGeneratorM Bool
   35 fileNewerThan t f =
   36   maybe (fileNotFound f) (return . (t <) . snd) =<< liftIO (fileInfo f)
   37 
   38 fileNewer :: RawFilePath -> WebGenerator
   39 fileNewer f (_, Nothing) = do
   40   e <- liftIO $ fileExist f
   41   unless e $ fileNotFound f
   42   return True
   43 fileNewer f (_, Just o) =
   44   fileNewerThan (webFileTimestamp o) f
   45 
   46 whether :: Bool -> IO () -> IO Bool
   47 whether g = (g <$) . when g
   48 
   49 webRegenerate :: IO () -> [RawFilePath] -> [WebFilePath] -> WebGenerator
   50 webRegenerate createOrCombineGeneratedIntoOutputFile fs inputFiles (fileToGen, mPriorFileInfo) = do
   51   let dontIncludeStatic = False
   52   wr <- mapM (generateWebFile dontIncludeStatic) inputFiles
   53   ft <-
   54     liftIO
   55         $ maybe (fmap snd <$> fileInfo (webFileAbs fileToGen)) (return . Just . webFileTimestamp) mPriorFileInfo
   56   fr <- maybe (return False) (\t -> anyM $ map (fileNewerThan t) fs) ft
   57   liftIO
   58       $ whether (all (\t -> fr || any ((t <) . webFileTimestamp) wr) ft)
   59             createOrCombineGeneratedIntoOutputFile
   60 
   61 -- | Generates a file and compares with the existing file to determine whether
   62 -- replacement is necessary
   63 staticWebGenerate :: (FilePath -> IO ()) -> WebGenerator
   64 staticWebGenerate g = \(w, _) -> liftIO $ do
   65   tempFile <- do
   66     f <- unRawFilePath $ webFileAbs w
   67     let (d, n) = splitFileName f
   68     rawFilePath $ d FP.</> ('.' : n)
   69   g =<< unRawFilePath tempFile
   70   c <- catchDoesNotExist $ compareFiles (webFileAbs w) tempFile
   71   if or c
   72     then False <$ removeLink tempFile -- Files are the same, so remove temporary file
   73     else True <$ rename tempFile (webFileAbs w) -- Files are different so replace old file with newly generated file
   74 
   75 webLinkDataFile :: FilePath -> WebGenerator
   76 webLinkDataFile s = \fo@(f, _) -> do
   77   wf <- liftIO $ rawFilePath =<< canonicalizePath =<< getDataFileName s
   78   webRegenerate (do
   79     r <- removeFile (webFileAbs f)
   80     f' <- unRawFilePath $ webFileAbs f
   81     unless r $ createDirectoryIfMissing False $ takeDirectory f'
   82     createSymbolicLink wf (webFileAbs f))
   83     [wf] [] fo