{-# LANGUAGE TemplateHaskell #-}
module Snap.Snaplet.Heist.Internal where
import Prelude
import Control.Lens
import Control.Monad.State
import qualified Data.ByteString as B
import Data.Char
import qualified Data.HashMap.Strict as Map
import Data.IORef
import Data.List
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import Heist
import Heist.Splices.Cache
import System.FilePath.Posix
import Snap.Core
import Snap.Snaplet
data DefaultMode = Compiled | Interpreted
data Heist b = Configuring
{ forall b. Heist b -> IORef (HeistConfig (Handler b b), DefaultMode)
_heistConfig :: IORef (HeistConfig (Handler b b), DefaultMode)
}
| Running
{ forall b. Heist b -> HeistConfig (Handler b b)
_masterConfig :: HeistConfig (Handler b b)
, forall b. Heist b -> HeistState (Handler b b)
_heistState :: HeistState (Handler b b)
, forall b. Heist b -> CacheTagState
_heistCTS :: CacheTagState
, forall b. Heist b -> DefaultMode
_defMode :: DefaultMode
}
makeLenses ''Heist
gHeistInit :: Handler b (Heist b) ()
-> FilePath
-> SnapletInit b (Heist b)
gHeistInit :: forall b.
Handler b (Heist b) () -> FilePath -> SnapletInit b (Heist b)
gHeistInit Handler b (Heist b) ()
serve FilePath
templateDir = do
Text
-> Text
-> Maybe (IO FilePath)
-> Initializer b (Heist b) (Heist b)
-> SnapletInit b (Heist b)
forall b v.
Text
-> Text
-> Maybe (IO FilePath)
-> Initializer b v v
-> SnapletInit b v
makeSnaplet Text
"heist" Text
"" Maybe (IO FilePath)
forall a. Maybe a
Nothing (Initializer b (Heist b) (Heist b) -> SnapletInit b (Heist b))
-> Initializer b (Heist b) (Heist b) -> SnapletInit b (Heist b)
forall a b. (a -> b) -> a -> b
$ do
Heist b
hs <- FilePath
-> HeistConfig (Handler b b) -> Initializer b (Heist b) (Heist b)
forall b.
FilePath
-> HeistConfig (Handler b b) -> Initializer b (Heist b) (Heist b)
heistInitWorker FilePath
templateDir HeistConfig (Handler b b)
forall {m :: * -> *}. HeistConfig m
defaultConfig
[(ByteString, Handler b (Heist b) ())]
-> Initializer b (Heist b) ()
forall b v. [(ByteString, Handler b v ())] -> Initializer b v ()
addRoutes [ (ByteString
"", Handler b (Heist b) ()
serve)
, (ByteString
"heistReload", Handler b (Heist b) () -> Handler b (Heist b) ()
forall (m :: * -> *) b. MonadSnap m => m b -> m b
failIfNotLocal Handler b (Heist b) ()
forall b. Handler b (Heist b) ()
heistReloader)
]
Heist b -> Initializer b (Heist b) (Heist b)
forall (m :: * -> *) a. Monad m => a -> m a
return Heist b
hs
where
sc :: SpliceConfig m
sc = ASetter
(SpliceConfig m)
(SpliceConfig m)
(Splices (Splice IO))
(Splices (Splice IO))
-> Splices (Splice IO) -> SpliceConfig m -> SpliceConfig m
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(SpliceConfig m)
(SpliceConfig m)
(Splices (Splice IO))
(Splices (Splice IO))
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(Splices (Splice IO) -> f (Splices (Splice IO)))
-> SpliceConfig m -> f (SpliceConfig m)
scLoadTimeSplices Splices (Splice IO)
forall (m :: * -> *). MonadIO m => Splices (Splice m)
defaultLoadTimeSplices SpliceConfig m
forall a. Monoid a => a
mempty
defaultConfig :: HeistConfig m
defaultConfig = HeistConfig m
forall {m :: * -> *}. HeistConfig m
emptyHeistConfig HeistConfig m -> (HeistConfig m -> HeistConfig m) -> HeistConfig m
forall a b. a -> (a -> b) -> b
& (SpliceConfig m -> Identity (SpliceConfig m))
-> HeistConfig m -> Identity (HeistConfig m)
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(SpliceConfig m -> f (SpliceConfig m))
-> HeistConfig m -> f (HeistConfig m)
hcSpliceConfig ((SpliceConfig m -> Identity (SpliceConfig m))
-> HeistConfig m -> Identity (HeistConfig m))
-> SpliceConfig m -> HeistConfig m -> HeistConfig m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SpliceConfig m
forall {m :: * -> *}. SpliceConfig m
sc
HeistConfig m -> (HeistConfig m -> HeistConfig m) -> HeistConfig m
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> HeistConfig m -> Identity (HeistConfig m)
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(Text -> f Text) -> HeistConfig m -> f (HeistConfig m)
hcNamespace ((Text -> Identity Text)
-> HeistConfig m -> Identity (HeistConfig m))
-> Text -> HeistConfig m -> HeistConfig m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
""
HeistConfig m -> (HeistConfig m -> HeistConfig m) -> HeistConfig m
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool)
-> HeistConfig m -> Identity (HeistConfig m)
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(Bool -> f Bool) -> HeistConfig m -> f (HeistConfig m)
hcErrorNotBound ((Bool -> Identity Bool)
-> HeistConfig m -> Identity (HeistConfig m))
-> Bool -> HeistConfig m -> HeistConfig m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
heistInitWorker :: FilePath
-> HeistConfig (Handler b b)
-> Initializer b (Heist b) (Heist b)
heistInitWorker :: forall b.
FilePath
-> HeistConfig (Handler b b) -> Initializer b (Heist b) (Heist b)
heistInitWorker FilePath
templateDir HeistConfig (Handler b b)
initialConfig = do
FilePath
snapletPath <- Initializer b (Heist b) FilePath
forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
m b v FilePath
getSnapletFilePath
let tDir :: FilePath
tDir = FilePath
snapletPath FilePath -> FilePath -> FilePath
</> FilePath
templateDir
TemplateRepo
templates <- IO TemplateRepo -> Initializer b (Heist b) TemplateRepo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TemplateRepo -> Initializer b (Heist b) TemplateRepo)
-> IO TemplateRepo -> Initializer b (Heist b) TemplateRepo
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO (Either [FilePath] TemplateRepo)
loadTemplates FilePath
tDir) IO (Either [FilePath] TemplateRepo)
-> (Either [FilePath] TemplateRepo -> IO TemplateRepo)
-> IO TemplateRepo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
([FilePath] -> IO TemplateRepo)
-> (TemplateRepo -> IO TemplateRepo)
-> Either [FilePath] TemplateRepo
-> IO TemplateRepo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> IO TemplateRepo
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO TemplateRepo)
-> ([FilePath] -> FilePath) -> [FilePath] -> IO TemplateRepo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) TemplateRepo -> IO TemplateRepo
forall (m :: * -> *) a. Monad m => a -> m a
return
Text -> Initializer b (Heist b) ()
forall b v. Text -> Initializer b v ()
printInfo (Text -> Initializer b (Heist b) ())
-> Text -> Initializer b (Heist b) ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords
[ FilePath
"...loaded"
, (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ TemplateRepo -> Int
forall k v. HashMap k v -> Int
Map.size TemplateRepo
templates)
, FilePath
"templates from"
, FilePath
tDir
]
let config :: HeistConfig (Handler b b)
config = HeistConfig (Handler b b)
initialConfig HeistConfig (Handler b b)
-> (HeistConfig (Handler b b) -> HeistConfig (Handler b b))
-> HeistConfig (Handler b b)
forall a b. a -> (a -> b) -> b
& ([IO (Either [FilePath] TemplateRepo)]
-> Identity [IO (Either [FilePath] TemplateRepo)])
-> HeistConfig (Handler b b)
-> Identity (HeistConfig (Handler b b))
forall (f :: * -> *) (m :: * -> *).
Functor f =>
([IO (Either [FilePath] TemplateRepo)]
-> f [IO (Either [FilePath] TemplateRepo)])
-> HeistConfig m -> f (HeistConfig m)
hcTemplateLocations (([IO (Either [FilePath] TemplateRepo)]
-> Identity [IO (Either [FilePath] TemplateRepo)])
-> HeistConfig (Handler b b)
-> Identity (HeistConfig (Handler b b)))
-> ([IO (Either [FilePath] TemplateRepo)]
-> [IO (Either [FilePath] TemplateRepo)])
-> HeistConfig (Handler b b)
-> HeistConfig (Handler b b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
([IO (Either [FilePath] TemplateRepo)]
-> [IO (Either [FilePath] TemplateRepo)]
-> [IO (Either [FilePath] TemplateRepo)]
forall a. Semigroup a => a -> a -> a
<> [FilePath -> IO (Either [FilePath] TemplateRepo)
loadTemplates FilePath
tDir])
HeistConfig (Handler b b)
-> (HeistConfig (Handler b b) -> HeistConfig (Handler b b))
-> HeistConfig (Handler b b)
forall a b. a -> (a -> b) -> b
& ((TPath -> Bool) -> Identity (TPath -> Bool))
-> HeistConfig (Handler b b)
-> Identity (HeistConfig (Handler b b))
forall (f :: * -> *) (m :: * -> *).
Functor f =>
((TPath -> Bool) -> f (TPath -> Bool))
-> HeistConfig m -> f (HeistConfig m)
hcCompiledTemplateFilter (((TPath -> Bool) -> Identity (TPath -> Bool))
-> HeistConfig (Handler b b)
-> Identity (HeistConfig (Handler b b)))
-> ((TPath -> Bool) -> TPath -> Bool)
-> HeistConfig (Handler b b)
-> HeistConfig (Handler b b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
(\TPath -> Bool
f TPath
x -> TPath -> Bool
f TPath
x Bool -> Bool -> Bool
&& TPath -> Bool
nsFilter TPath
x)
IORef (HeistConfig (Handler b b), DefaultMode)
ref <- IO (IORef (HeistConfig (Handler b b), DefaultMode))
-> Initializer
b (Heist b) (IORef (HeistConfig (Handler b b), DefaultMode))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HeistConfig (Handler b b), DefaultMode))
-> Initializer
b (Heist b) (IORef (HeistConfig (Handler b b), DefaultMode)))
-> IO (IORef (HeistConfig (Handler b b), DefaultMode))
-> Initializer
b (Heist b) (IORef (HeistConfig (Handler b b), DefaultMode))
forall a b. (a -> b) -> a -> b
$ (HeistConfig (Handler b b), DefaultMode)
-> IO (IORef (HeistConfig (Handler b b), DefaultMode))
forall a. a -> IO (IORef a)
newIORef (HeistConfig (Handler b b)
config, DefaultMode
Compiled)
(Heist b -> IO (Either Text (Heist b)))
-> Initializer b (Heist b) ()
forall v b. (v -> IO (Either Text v)) -> Initializer b v ()
addPostInitHook Heist b -> IO (Either Text (Heist b))
forall b. Heist b -> IO (Either Text (Heist b))
finalLoadHook
Heist b -> Initializer b (Heist b) (Heist b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Heist b -> Initializer b (Heist b) (Heist b))
-> Heist b -> Initializer b (Heist b) (Heist b)
forall a b. (a -> b) -> a -> b
$ IORef (HeistConfig (Handler b b), DefaultMode) -> Heist b
forall b. IORef (HeistConfig (Handler b b), DefaultMode) -> Heist b
Configuring IORef (HeistConfig (Handler b b), DefaultMode)
ref
where
nsFilter :: TPath -> Bool
nsFilter = Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'_') (Word8 -> Bool) -> (TPath -> Word8) -> TPath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word8
B.head (ByteString -> Word8) -> (TPath -> ByteString) -> TPath -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TPath -> ByteString
forall a. [a] -> a
head
finalLoadHook :: Heist b -> IO (Either Text (Heist b))
finalLoadHook :: forall b. Heist b -> IO (Either Text (Heist b))
finalLoadHook (Configuring IORef (HeistConfig (Handler b b), DefaultMode)
ref) = do
(HeistConfig (Handler b b)
hc,DefaultMode
dm) <- IORef (HeistConfig (Handler b b), DefaultMode)
-> IO (HeistConfig (Handler b b), DefaultMode)
forall a. IORef a -> IO a
readIORef IORef (HeistConfig (Handler b b), DefaultMode)
ref
Either Text (HeistState (Handler b b), CacheTagState)
res <- (Either [FilePath] (HeistState (Handler b b), CacheTagState)
-> Either Text (HeistState (Handler b b), CacheTagState))
-> IO (Either [FilePath] (HeistState (Handler b b), CacheTagState))
-> IO (Either Text (HeistState (Handler b b), CacheTagState))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either [FilePath] (HeistState (Handler b b), CacheTagState)
-> Either Text (HeistState (Handler b b), CacheTagState)
forall {d}. Either [FilePath] d -> Either Text d
toTextErrors (IO (Either [FilePath] (HeistState (Handler b b), CacheTagState))
-> IO (Either Text (HeistState (Handler b b), CacheTagState)))
-> IO (Either [FilePath] (HeistState (Handler b b), CacheTagState))
-> IO (Either Text (HeistState (Handler b b), CacheTagState))
forall a b. (a -> b) -> a -> b
$ HeistConfig (Handler b b)
-> IO (Either [FilePath] (HeistState (Handler b b), CacheTagState))
forall (n :: * -> *).
MonadIO n =>
HeistConfig n
-> IO (Either [FilePath] (HeistState n, CacheTagState))
initHeistWithCacheTag HeistConfig (Handler b b)
hc
Either Text (Heist b) -> IO (Either Text (Heist b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Heist b) -> IO (Either Text (Heist b)))
-> Either Text (Heist b) -> IO (Either Text (Heist b))
forall a b. (a -> b) -> a -> b
$ case Either Text (HeistState (Handler b b), CacheTagState)
res of
Left Text
e -> Text -> Either Text (Heist b)
forall a b. a -> Either a b
Left Text
e
Right (HeistState (Handler b b)
hs,CacheTagState
cts) -> Heist b -> Either Text (Heist b)
forall a b. b -> Either a b
Right (Heist b -> Either Text (Heist b))
-> Heist b -> Either Text (Heist b)
forall a b. (a -> b) -> a -> b
$ HeistConfig (Handler b b)
-> HeistState (Handler b b)
-> CacheTagState
-> DefaultMode
-> Heist b
forall b.
HeistConfig (Handler b b)
-> HeistState (Handler b b)
-> CacheTagState
-> DefaultMode
-> Heist b
Running HeistConfig (Handler b b)
hc HeistState (Handler b b)
hs CacheTagState
cts DefaultMode
dm
where
toTextErrors :: Either [FilePath] d -> Either Text d
toTextErrors = ([FilePath] -> Text)
-> (d -> d) -> Either [FilePath] d -> Either Text d
forall a c b d. (a -> c) -> (b -> d) -> Either a b -> Either c d
mapBoth (FilePath -> Text
T.pack (FilePath -> Text)
-> ([FilePath] -> FilePath) -> [FilePath] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n") d -> d
forall a. a -> a
id
finalLoadHook (Running HeistConfig (Handler b b)
_ HeistState (Handler b b)
_ CacheTagState
_ DefaultMode
_) =
Either Text (Heist b) -> IO (Either Text (Heist b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Heist b) -> IO (Either Text (Heist b)))
-> Either Text (Heist b) -> IO (Either Text (Heist b))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Heist b)
forall a b. a -> Either a b
Left Text
"finalLoadHook called while running"
mapBoth :: (a -> c) -> (b -> d) -> Either a b -> Either c d
mapBoth :: forall a c b d. (a -> c) -> (b -> d) -> Either a b -> Either c d
mapBoth a -> c
f b -> d
_ (Left a
x) = c -> Either c d
forall a b. a -> Either a b
Left (a -> c
f a
x)
mapBoth a -> c
_ b -> d
f (Right b
x) = d -> Either c d
forall a b. b -> Either a b
Right (b -> d
f b
x)
heistReloader :: Handler b (Heist b) ()
heistReloader :: forall b. Handler b (Heist b) ()
heistReloader = do
Heist b
h <- Handler b (Heist b) (Heist b)
forall s (m :: * -> *). MonadState s m => m s
get
Either [FilePath] (HeistState (Handler b b))
ehs <- IO (Either [FilePath] (HeistState (Handler b b)))
-> Handler
b (Heist b) (Either [FilePath] (HeistState (Handler b b)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either [FilePath] (HeistState (Handler b b)))
-> Handler
b (Heist b) (Either [FilePath] (HeistState (Handler b b))))
-> IO (Either [FilePath] (HeistState (Handler b b)))
-> Handler
b (Heist b) (Either [FilePath] (HeistState (Handler b b)))
forall a b. (a -> b) -> a -> b
$ HeistConfig (Handler b b)
-> IO (Either [FilePath] (HeistState (Handler b b)))
forall (n :: * -> *).
Monad n =>
HeistConfig n -> IO (Either [FilePath] (HeistState n))
initHeist (HeistConfig (Handler b b)
-> IO (Either [FilePath] (HeistState (Handler b b))))
-> HeistConfig (Handler b b)
-> IO (Either [FilePath] (HeistState (Handler b b)))
forall a b. (a -> b) -> a -> b
$ Heist b -> HeistConfig (Handler b b)
forall b. Heist b -> HeistConfig (Handler b b)
_masterConfig Heist b
h
([FilePath] -> Handler b (Heist b) ())
-> (HeistState (Handler b b) -> Handler b (Heist b) ())
-> Either [FilePath] (HeistState (Handler b b))
-> Handler b (Heist b) ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Handler b (Heist b) ()
forall (m :: * -> *). MonadSnap m => Text -> m ()
writeText (Text -> Handler b (Heist b) ())
-> ([FilePath] -> Text) -> [FilePath] -> Handler b (Heist b) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text)
-> ([FilePath] -> FilePath) -> [FilePath] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines)
(\HeistState (Handler b b)
hs -> do Text -> Handler b (Heist b) ()
forall (m :: * -> *). MonadSnap m => Text -> m ()
writeText Text
"Heist reloaded."
Heist b -> Handler b (Heist b) ()
forall v b. v -> Handler b v ()
modifyMaster (Heist b -> Handler b (Heist b) ())
-> Heist b -> Handler b (Heist b) ()
forall a b. (a -> b) -> a -> b
$ ASetter
(Heist b)
(Heist b)
(HeistState (Handler b b))
(HeistState (Handler b b))
-> HeistState (Handler b b) -> Heist b -> Heist b
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(Heist b)
(Heist b)
(HeistState (Handler b b))
(HeistState (Handler b b))
forall b. Traversal' (Heist b) (HeistState (Handler b b))
heistState HeistState (Handler b b)
hs Heist b
h)
Either [FilePath] (HeistState (Handler b b))
ehs