{-|

This module defines a TemplateDirectory data structure for convenient
interaction with templates within web apps.

-}

module Heist.TemplateDirectory
    ( TemplateDirectory
    , newTemplateDirectory
    , newTemplateDirectory'

    , getDirectoryHS
    , getDirectoryCTS
    , reloadTemplateDirectory
    ) where

------------------------------------------------------------------------------
import           Control.Concurrent
import           Control.Monad
import           Control.Monad.Trans
import           Heist
import           Heist.Internal.Types
import           Heist.Splices.Cache


------------------------------------------------------------------------------
-- | Structure representing a template directory.
data TemplateDirectory n
    = TemplateDirectory
        FilePath
        (HeistConfig n)
        (MVar (HeistState n))
        (MVar CacheTagState)


------------------------------------------------------------------------------
-- | Creates and returns a new 'TemplateDirectory' wrapped in an Either for
-- error handling.
newTemplateDirectory
    :: MonadIO n
    => FilePath
    -> HeistConfig n
    -- namespaced tag.
    -> IO (Either [String] (TemplateDirectory n))
newTemplateDirectory :: forall (n :: * -> *).
MonadIO n =>
FilePath
-> HeistConfig n -> IO (Either [FilePath] (TemplateDirectory n))
newTemplateDirectory FilePath
dir HeistConfig n
hc = do
    let sc :: SpliceConfig n
sc = (forall (m :: * -> *). HeistConfig m -> SpliceConfig m
_hcSpliceConfig HeistConfig n
hc) { _scTemplateLocations :: [TemplateLocation]
_scTemplateLocations = [FilePath -> TemplateLocation
loadTemplates FilePath
dir] }
    let hc' :: HeistConfig n
hc' = HeistConfig n
hc { _hcSpliceConfig :: SpliceConfig n
_hcSpliceConfig = SpliceConfig n
sc }
    Either [FilePath] (HeistState n, CacheTagState)
epair <- forall (n :: * -> *).
MonadIO n =>
HeistConfig n
-> IO (Either [FilePath] (HeistState n, CacheTagState))
initHeistWithCacheTag HeistConfig n
hc'
    case Either [FilePath] (HeistState n, CacheTagState)
epair of
      Left [FilePath]
es -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [FilePath]
es
      Right (HeistState n
hs,CacheTagState
cts) -> do
        MVar (HeistState n)
tsMVar <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar HeistState n
hs
        MVar CacheTagState
ctsMVar <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar CacheTagState
cts
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *).
FilePath
-> HeistConfig n
-> MVar (HeistState n)
-> MVar CacheTagState
-> TemplateDirectory n
TemplateDirectory FilePath
dir HeistConfig n
hc' MVar (HeistState n)
tsMVar MVar CacheTagState
ctsMVar


------------------------------------------------------------------------------
-- | Creates and returns a new 'TemplateDirectory', using the monad's fail
-- function on error.
newTemplateDirectory'
    :: MonadIO n
    => FilePath
    -> HeistConfig n
    -> IO (TemplateDirectory n)
newTemplateDirectory' :: forall (n :: * -> *).
MonadIO n =>
FilePath -> HeistConfig n -> IO (TemplateDirectory n)
newTemplateDirectory' FilePath
dir HeistConfig n
hc = do
    Either [FilePath] (TemplateDirectory n)
res <- forall (n :: * -> *).
MonadIO n =>
FilePath
-> HeistConfig n -> IO (Either [FilePath] (TemplateDirectory n))
newTemplateDirectory FilePath
dir HeistConfig n
hc
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => FilePath -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall (m :: * -> *) a. Monad m => a -> m a
return Either [FilePath] (TemplateDirectory n)
res


------------------------------------------------------------------------------
-- | Gets the 'HeistState' from a TemplateDirectory.
getDirectoryHS :: (MonadIO n)
               => TemplateDirectory n
               -> IO (HeistState n)
getDirectoryHS :: forall (n :: * -> *).
MonadIO n =>
TemplateDirectory n -> IO (HeistState n)
getDirectoryHS (TemplateDirectory FilePath
_ HeistConfig n
_ MVar (HeistState n)
tsMVar MVar CacheTagState
_) =
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar forall a b. (a -> b) -> a -> b
$ MVar (HeistState n)
tsMVar


------------------------------------------------------------------------------
-- | Clears the TemplateDirectory's cache tag state.
getDirectoryCTS :: TemplateDirectory n -> IO CacheTagState
getDirectoryCTS :: forall (n :: * -> *). TemplateDirectory n -> IO CacheTagState
getDirectoryCTS (TemplateDirectory FilePath
_ HeistConfig n
_ MVar (HeistState n)
_ MVar CacheTagState
ctsMVar) = forall a. MVar a -> IO a
readMVar MVar CacheTagState
ctsMVar


------------------------------------------------------------------------------
-- | Clears cached content and reloads templates from disk.
reloadTemplateDirectory :: (MonadIO n)
                        => TemplateDirectory n
                        -> IO (Either String ())
reloadTemplateDirectory :: forall (n :: * -> *).
MonadIO n =>
TemplateDirectory n -> IO (Either FilePath ())
reloadTemplateDirectory (TemplateDirectory FilePath
p HeistConfig n
hc MVar (HeistState n)
tsMVar MVar CacheTagState
ctsMVar) = do
    let sc :: SpliceConfig n
sc = (forall (m :: * -> *). HeistConfig m -> SpliceConfig m
_hcSpliceConfig HeistConfig n
hc) { _scTemplateLocations :: [TemplateLocation]
_scTemplateLocations = [FilePath -> TemplateLocation
loadTemplates FilePath
p] }
    Either [FilePath] (HeistState n, CacheTagState)
ehs <- forall (n :: * -> *).
MonadIO n =>
HeistConfig n
-> IO (Either [FilePath] (HeistState n, CacheTagState))
initHeistWithCacheTag (HeistConfig n
hc { _hcSpliceConfig :: SpliceConfig n
_hcSpliceConfig = SpliceConfig n
sc })
    forall (m :: * -> *) b c.
Monad m =>
Either [FilePath] b -> (b -> m c) -> m (Either FilePath c)
leftPass Either [FilePath] (HeistState n, CacheTagState)
ehs forall a b. (a -> b) -> a -> b
$ \(HeistState n
hs,CacheTagState
cts) -> do
        forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (HeistState n)
tsMVar (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return HeistState n
hs)
        forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar CacheTagState
ctsMVar (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return CacheTagState
cts)


------------------------------------------------------------------------------
-- | Prepends an error onto a Left.
leftPass :: Monad m => Either [String] b -> (b -> m c) -> m (Either String c)
leftPass :: forall (m :: * -> *) b c.
Monad m =>
Either [FilePath] b -> (b -> m c) -> m (Either FilePath c)
leftPass Either [FilePath] b
e b -> m c
m = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
loadError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
                      (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m c
m) Either [FilePath] b
e
  where
    loadError :: FilePath -> FilePath
loadError = forall a. [a] -> [a] -> [a]
(++) (FilePath
"Error loading templates: " :: String)