Skip to content
Browse files

Make heistInit in the Compiled module serve compiled templates

Also did general cleanup and code reorganization.
  • Loading branch information...
1 parent bde4a8a commit ce65c1c5f0dd967a814a515da84ef27b4623cb94 @mightybyte mightybyte committed Jun 21, 2013
View
16 src/Snap/Snaplet/Heist/Compiled.hs
@@ -14,8 +14,9 @@ module Snap.Snaplet.Heist.Compiled
-- * Initializer Functions
-- $initializerSection
- , H.heistInit
+ , heistInit
, H.heistInit'
+ , H.heistReloader
, H.addTemplates
, H.addTemplatesAt
, H.addConfig
@@ -34,7 +35,20 @@ module Snap.Snaplet.Heist.Compiled
import Data.ByteString (ByteString)
import Snap.Snaplet
+import Snap.Snaplet.Heist.Internal
import qualified Snap.Snaplet.Heist as H
+import qualified Snap.Snaplet.HeistNoClass as HNC
+
+
+------------------------------------------------------------------------------
+-- | The 'Initializer' for 'Heist'. This function is a convenience wrapper
+-- around `heistInit'` that uses defaultHeistState and sets up routes for all
+-- the templates. It sets up a \"heistReload\" route that reloads the heist
+-- templates when you request it from localhost.
+heistInit :: FilePath
+ -- ^ Path to templates
+ -> SnapletInit b (Heist b)
+heistInit = gHeistInit HNC.cHeistServe
------------------------------------------------------------------------------
View
2 src/Snap/Snaplet/Heist/Generic.hs
@@ -15,8 +15,6 @@ module Snap.Snaplet.Heist.Generic
-- * Initializer Functions
-- $initializerSection
- , heistInit
- , heistInit'
, addTemplates
, addTemplatesAt
, addConfig
View
86 src/Snap/Snaplet/Heist/Internal.hs
@@ -1,12 +1,21 @@
{-# LANGUAGE TemplateHaskell #-}
module Snap.Snaplet.Heist.Internal where
-import Prelude hiding ((.), id)
+import Prelude
+import Control.Error
import Control.Lens
+import Control.Monad.State
+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
@@ -29,3 +38,78 @@ data Heist b = Configuring
}
makeLenses ''Heist
+
+
+------------------------------------------------------------------------------
+-- | Generic initializer function that allows compiled/interpreted template
+-- serving to be specified by the caller.
+gHeistInit :: Handler b (Heist b) ()
+ -> FilePath
+ -> SnapletInit b (Heist b)
+gHeistInit serve templateDir = do
+ makeSnaplet "heist" "" Nothing $ do
+ hs <- heistInitWorker templateDir defaultConfig
+ addRoutes [ ("", serve)
+ , ("heistReload", failIfNotLocal heistReloader)
+ ]
+ return hs
+ where
+ defaultConfig = mempty { hcLoadTimeSplices = defaultLoadTimeSplices }
+
+
+------------------------------------------------------------------------------
+-- | Internal worker function used by variants of heistInit. This is
+-- necessary because of the divide between SnapletInit and Initializer.
+heistInitWorker :: FilePath
+ -> HeistConfig (Handler b b)
+ -> Initializer b (Heist b) (Heist b)
+heistInitWorker templateDir initialConfig = do
+ snapletPath <- getSnapletFilePath
+ let tDir = snapletPath </> templateDir
+ templates <- liftIO $ runEitherT (loadTemplates tDir) >>=
+ either (error . concat) return
+ printInfo $ T.pack $ unwords
+ [ "...loaded"
+ , (show $ Map.size templates)
+ , "templates from"
+ , tDir
+ ]
+ let config = initialConfig `mappend`
+ mempty { hcTemplateLocations = [loadTemplates tDir] }
+ ref <- liftIO $ newIORef (config, Compiled)
+
+ -- FIXME This runs after all the initializers, but before post init
+ -- hooks registered by other snaplets.
+ addPostInitHook finalLoadHook
+ return $ Configuring ref
+
+
+------------------------------------------------------------------------------
+-- | Hook that converts the Heist type from Configuring to Running at the end
+-- of initialization.
+finalLoadHook :: Heist b -> EitherT Text IO (Heist b)
+finalLoadHook (Configuring ref) = do
+ (hc,dm) <- lift $ readIORef ref
+ (hs,cts) <- toTextErrors $ initHeistWithCacheTag hc
+ return $ Running hc hs cts dm
+ where
+ toTextErrors = bimapEitherT (T.pack . intercalate "\n") id
+finalLoadHook (Running _ _ _ _) = left "finalLoadHook called while running"
+
+
+------------------------------------------------------------------------------
+-- | Handler that triggers a template reload. For large sites, this can be
+-- desireable because it may be much quicker than the full site reload
+-- provided at the /admin/reload route. This allows you to reload only the
+-- heist templates This handler is automatically set up by heistInit, but if
+-- you use heistInit', then you can create your own route with it.
+heistReloader :: Handler b (Heist b) ()
+heistReloader = do
+ h <- get
+ ehs <- liftIO $ runEitherT $ initHeist $ _masterConfig h
+ either (writeText . T.pack . unlines)
+ (\hs -> do writeText "Heist reloaded."
+ modifyMaster $ set heistState hs h)
+ ehs
+
+
View
68 src/Snap/Snaplet/HeistNoClass.hs
@@ -71,9 +71,7 @@ import qualified Data.ByteString.Char8 as B
import Data.DList (DList)
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 Data.Text.Encoding
import System.FilePath.Posix
@@ -105,22 +103,6 @@ clearHeistCache :: Heist b -> IO ()
clearHeistCache = clearCacheTagState . _heistCTS
-------------------------------------------------------------------------------
--- | Handler that triggers a template reload. For large sites, this can be
--- desireable because it may be much quicker than the full site reload
--- provided at the /admin/reload route. This allows you to reload only the
--- heist templates This handler is automatically set up by heistInit, but if
--- you use heistInit', then you can create your own route with it.
-heistReloader :: Handler b (Heist b) ()
-heistReloader = do
- h <- get
- ehs <- liftIO $ runEitherT $ initHeist $ _masterConfig h
- either (writeText . T.pack . unlines)
- (\hs -> do writeText "Heist reloaded."
- modifyMaster $ set heistState hs h)
- ehs
-
-
-----------------------------
-- SnapletSplice functions --
-----------------------------
@@ -150,15 +132,7 @@ type SnapletISplice b = SnapletHeist b (Handler b b) Template
heistInit :: FilePath
-- ^ Path to templates
-> SnapletInit b (Heist b)
-heistInit templateDir = do
- makeSnaplet "heist" "" Nothing $ do
- hs <- heistInitWorker templateDir defaultConfig
- addRoutes [ ("", heistServe)
- , ("heistReload", failIfNotLocal heistReloader)
- ]
- return hs
- where
- defaultConfig = mempty { hcLoadTimeSplices = defaultLoadTimeSplices }
+heistInit = gHeistInit heistServe
------------------------------------------------------------------------------
@@ -175,33 +149,6 @@ heistInit' templateDir initialConfig =
------------------------------------------------------------------------------
--- | Internal worker function used by variants of heistInit. This is
--- necessary because of the divide between SnapletInit and Initializer.
-heistInitWorker :: FilePath
- -> HeistConfig (Handler b b)
- -> Initializer b (Heist b) (Heist b)
-heistInitWorker templateDir initialConfig = do
- snapletPath <- getSnapletFilePath
- let tDir = snapletPath </> templateDir
- templates <- liftIO $ runEitherT (loadTemplates tDir) >>=
- either (error . concat) return
- printInfo $ T.pack $ unwords
- [ "...loaded"
- , (show $ Map.size templates)
- , "templates from"
- , tDir
- ]
- let config = initialConfig `mappend`
- mempty { hcTemplateLocations = [loadTemplates tDir] }
- ref <- liftIO $ newIORef (config, Compiled)
-
- -- FIXME This runs after all the initializers, but before post init
- -- hooks registered by other snaplets.
- addPostInitHook finalLoadHook
- return $ Configuring ref
-
-
-------------------------------------------------------------------------------
-- | Sets the snaplet to default to interpreted mode. Initially, the
-- initializer sets the value to compiled mode. This function allows you to
-- override that setting. Note that this is just a default. It only has an
@@ -216,19 +163,6 @@ setInterpreted h =
------------------------------------------------------------------------------
--- | Hook that converts the Heist type from Configuring to Running at the end
--- of initialization.
-finalLoadHook :: Heist b -> EitherT Text IO (Heist b)
-finalLoadHook (Configuring ref) = do
- (hc,dm) <- lift $ readIORef ref
- (hs,cts) <- toTextErrors $ initHeistWithCacheTag hc
- return $ Running hc hs cts dm
- where
- toTextErrors = bimapEitherT (T.pack . intercalate "\n") id
-finalLoadHook (Running _ _ _ _) = left "finalLoadHook called while running"
-
-
-------------------------------------------------------------------------------
-- | Adds templates to the Heist HeistConfig. Other snaplets should use
-- this function to add their own templates. The templates are automatically
-- read from the templates directory in the current snaplet's filesystem root.

0 comments on commit ce65c1c

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