1 {-# LANGUAGE OverloadedStrings #-} 2 module Databrary.Web.Templates 3 ( generateTemplatesJS 4 ) where 5 6 import Control.Monad (guard, unless, forM_) 7 import Control.Monad.IO.Class (liftIO) 8 import qualified Data.ByteString as BS 9 import qualified Data.ByteString.Builder as BSB 10 import qualified Data.ByteString.Char8 as BSC 11 import Data.Char (isSpace) 12 import Data.Monoid ((<>)) 13 import System.IO (withFile, withBinaryFile, IOMode(ReadMode, WriteMode), hPutStrLn, hIsEOF, hFlush) 14 import qualified Data.ByteString.Builder as B 15 import qualified Data.ByteString.Builder.Prim as BP 16 import Data.Word (Word8) 17 import Data.ByteString.Internal (c2w) 18 19 import Databrary.Files 20 import Databrary.Web 21 import Databrary.Web.Types 22 import Databrary.Web.Files 23 import Databrary.Web.Generate 24 25 wordEscaped :: Char -> BP.BoundedPrim Word8 26 wordEscaped q = 27 BP.condB (== c2w q) (backslash q) $ 28 BP.condB (== c2w '\\') (backslash '\\') $ 29 BP.condB (>= c2w ' ') (BP.liftFixedToBounded BP.word8) $ 30 BP.condB (== c2w '\n') (backslash 'n') $ 31 BP.condB (== c2w '\r') (backslash 'r') $ 32 BP.condB (== c2w '\t') (backslash 't') $ 33 BP.liftFixedToBounded $ (\c -> ('\\', ('u', fromIntegral c))) BP.>$< BP.char8 BP.>*< BP.char8 BP.>*< BP.word16HexFixed 34 where 35 backslash c = BP.liftFixedToBounded $ const ('\\', c) BP.>$< BP.char8 BP.>*< BP.char8 36 37 -- | Escape (but do not quote) a ByteString 38 escapeByteString :: Char -> BS.ByteString -> B.Builder 39 escapeByteString = BP.primMapByteStringBounded . wordEscaped 40 41 quoteByteString :: Char -> BS.ByteString -> B.Builder 42 quoteByteString q s = B.char8 q <> escapeByteString q s <> B.char8 q 43 44 processTemplate :: RawFilePath -> (BS.ByteString -> IO ()) -> IO () 45 processTemplate f g = do 46 fp <- liftIO $ unRawFilePath f 47 withFile fp ReadMode go 48 where 49 go h = do 50 e <- hIsEOF h 51 unless e $ do 52 l <- BS.hGetLine h 53 g $ BSC.dropWhile isSpace l 54 go h 55 56 generateTemplatesJS :: WebGenerator 57 generateTemplatesJS fo@(f, _) = do 58 tl <- liftIO $ findWebFiles ".html" 59 guard (not $ null tl) 60 fp <- liftIO $ unRawFilePath $ webFileAbs f 61 webRegenerate 62 (withBinaryFile fp WriteMode $ \h -> do 63 hPutStrLn h "app.run(['$templateCache',function(t){" 64 forM_ tl $ \tf -> do 65 BSB.hPutBuilder h $ BSB.string8 "t.put(" <> quoteByteString q (webFileRel tf) <> BSB.char8 ',' <> BSB.char8 q 66 processTemplate (webFileAbs tf) $ \s -> do 67 let j = escapeByteString q s 68 BSB.hPutBuilder h j -- this is hanging 69 hFlush h -- without this!!! 70 hPutStrLn h $ q : ");" 71 hPutStrLn h "}]);") 72 [] tl fo 73 where q = '\''