Skip to content
Browse files

Moved TemplateDirectory to Heist.

  • Loading branch information...
1 parent eba3be2 commit 1081d0b0e8a9ae2ba2a2a4d626acda3003cf8e0e @mightybyte mightybyte committed Jun 18, 2010
View
2 project_template/default/foo.cabal
@@ -21,7 +21,7 @@ Executable projname
bytestring >= 0.9.1 && <0.10,
snap-core >= 0.2 && <0.3,
snap-server >= 0.2 && <0.3,
- heist >= 0.1 && <0.3,
+ heist >= 0.2.2 && <0.3,
hexpat == 0.16,
xhtml-combinators,
unix,
View
9 project_template/default/src/Glue.hs
@@ -1,13 +1,11 @@
{-# LANGUAGE OverloadedStrings #-}
module Glue
( templateHandler
- , newTemplateDirectory'
, defaultReloadHandler
, templateServe
, render
- , bindSplices
- , withSplices
) where
+
import Control.Applicative
import Control.Monad
import Data.ByteString.Char8 (ByteString)
@@ -16,15 +14,14 @@ import Prelude hiding (catch)
import Snap.Types hiding (dir)
import Snap.Util.FileServe
import Text.Templating.Heist
-
-import TemplateDirectory
+import Text.Templating.Heist.TemplateDirectory
templateHandler :: TemplateDirectory Snap
-> (TemplateDirectory Snap -> Snap ())
-> (TemplateState Snap -> Snap ())
-> Snap ()
-templateHandler td reload f = reload td <|> (f =<< getTemplateState td)
+templateHandler td reload f = reload td <|> (f =<< getDirectoryTS td)
defaultReloadHandler :: TemplateDirectory Snap -> Snap ()
View
1 project_template/default/src/Main.hs
@@ -5,6 +5,7 @@ import Control.Applicative
import Snap.Types
import Snap.Util.FileServe
import Text.Templating.Heist
+import Text.Templating.Heist.TemplateDirectory
import Glue
import Server
View
78 project_template/default/src/TemplateDirectory.hs
@@ -1,78 +0,0 @@
-module TemplateDirectory
- ( TemplateDirectory
- , newTemplateDirectory
- , newTemplateDirectory'
-
- , getTemplateState
- , reloadTemplateDirectory
-
- , bindSplices
- , withSplices
- ) where
-import Control.Concurrent
-import Control.Monad
-import Control.Monad.Trans
-import Data.ByteString.Char8 (ByteString)
-import Text.Templating.Heist
-import Text.Templating.Heist.Splices.Static
-
-
-data TemplateDirectory m
- = TemplateDirectory
- FilePath
- (TemplateState m)
- (MVar (TemplateState m))
- StaticTagState
-
-
-newTemplateDirectory :: (MonadIO m, MonadIO n)
- => FilePath
- -> TemplateState m
- -> n (Either String (TemplateDirectory m))
-newTemplateDirectory dir templateState = liftIO $ do
- (origTs,sts) <- bindStaticTag templateState
- ets <- loadTemplates dir origTs
- leftPass ets $ \ts -> do
- tsMVar <- newMVar $ ts
- return $ TemplateDirectory dir origTs tsMVar sts
-
-
-newTemplateDirectory' :: (MonadIO m, MonadIO n)
- => FilePath
- -> TemplateState m
- -> n (TemplateDirectory m)
-newTemplateDirectory' = ((either fail return =<<) .) . newTemplateDirectory
-
-
-getTemplateState :: (Monad m, MonadIO n)
- => TemplateDirectory m
- -> n (TemplateState m)
-getTemplateState (TemplateDirectory _ _ tsMVar _) = liftIO $ readMVar $ tsMVar
-
-
-reloadTemplateDirectory :: (MonadIO m, MonadIO n)
- => TemplateDirectory m
- -> n (Either String ())
-reloadTemplateDirectory (TemplateDirectory p origTs tsMVar sts) = liftIO $ do
- clearStaticTagCache sts
- ets <- loadTemplates p origTs
- leftPass ets $ \ts -> modifyMVar_ tsMVar (const $ return ts)
-
-
-bindSplices :: Monad m
- => [(ByteString, Splice m)]
- -> TemplateState m
- -> TemplateState m
-bindSplices = flip $ foldr (uncurry bindSplice)
-
-
-withSplices :: MonadIO m
- => [(ByteString, Splice m)]
- -> TemplateState m
-withSplices = foldr (uncurry bindSplice) emptyTemplateState
-
-
-leftPass :: Monad m => Either String b -> (b -> m c) -> m (Either String c)
-leftPass e m = either (return . Left . loadError) (liftM Right . m) e
- where
- loadError = (++) "Error loading templates: "

0 comments on commit 1081d0b

Please sign in to comment.
Something went wrong with that request. Please try again.