<commit_before>{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE TypeSynonymInstances       #-}
module Snap.Snaplet.HeistNoClass
  ( Heist
  , heistInit
  , heistInit'
  , clearHeistCache

  , addTemplates
  , addTemplatesAt
  , modifyHeistTS
  , modifyHeistTS'
  , withHeistTS
  , withHeistTS'
  , addSplices
  , addSplices'
  , render
  , renderAs
  , heistServe
  , heistServeSingle
  , heistLocal
  , withSplices
  , renderWithSplices
  , heistLocal'
  , withSplices'
  , renderWithSplices'

  , SnapletHeist
  , SnapletSplice
  , runSnapletSplice
  , liftHeist
  , liftWith
  , liftHandler
  , liftAppHandler
  , bindSnapletSplices
  ) where

import           Prelude hiding ((.), id)
import           Control.Arrow
import           Control.Applicative
import           Control.Category
import           Control.Monad.CatchIO (MonadCatchIO)
import           Control.Monad.Reader
import           Control.Monad.State
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.UTF8 as U
import           Data.Maybe
import           Data.Monoid
import           Data.Lens.Lazy
import           Data.Text (Text)
import qualified Data.Text as T
import           System.FilePath.Posix
import           Text.Templating.Heist
import           Text.Templating.Heist.Splices.Cache

import           Snap.Snaplet
import           Snap.Core
import           Snap.Util.FileServe


------------------------------------------------------------------------------
-- | The state for the Heist snaplet.  To use the Heist snaplet in your app
-- include this in your application state and use 'heistInit' to initialize
-- it.  The type parameter b will typically be the base state type for your
-- application.
--
data Heist b = Heist
    { _heistTS       :: HeistState (Handler b b)
    , _heistCTS      :: CacheTagState
    }


------------------------------------------------------------------------------
changeTS :: (HeistState (Handler a a) -> HeistState (Handler a a))
         -> Heist a
         -> Heist a
changeTS f (Heist ts cts) = Heist (f ts) cts


------------------------------------------------------------------------------
-- | Clears data stored by the cache tag.  The cache tag automatically reloads
-- its data when the specified TTL expires, but sometimes you may want to
-- trigger a manual reload.  This function lets you do that.
--
clearHeistCache :: Heist b -> IO ()
clearHeistCache = clearCacheTagState . _heistCTS


                         -----------------------------
                         -- SnapletSplice functions --
                         -----------------------------

------------------------------------------------------------------------------
-- | This instance is here because we don't want the heist package to depend
-- on anything from snap packages.
--
instance MonadSnap m => MonadSnap (HeistT m) where
    liftSnap = lift . liftSnap


------------------------------------------------------------------------------
-- | Monad for working with Heist's API from within a snaplet.
--
newtype SnapletHeist b v a = SnapletHeist
    (ReaderT (Lens (Snaplet b) (Snaplet v)) (HeistT (Handler b b)) a)
  deriving ( Monad
           , Functor
           , Applicative
           , Alternative
           , MonadIO
           , MonadPlus
           , MonadReader (Lens (Snaplet b) (Snaplet v))
           , MonadCatchIO
           , MonadSnap
           )


------------------------------------------------------------------------------
-- | Type alias for convenience.
--
type SnapletSplice b v = SnapletHeist b v Template


------------------------------------------------------------------------------
-- | Runs the SnapletSplice.
--
runSnapletSplice :: (Lens (Snaplet b) (Snaplet v))
                 -> SnapletHeist b v a
                 -> HeistT (Handler b b) a
runSnapletSplice l (SnapletHeist m) = runReaderT m l


------------------------------------------------------------------------------
withSS :: (Lens (Snaplet b) (Snaplet v) -> Lens (Snaplet b) (Snaplet v'))
       -> SnapletHeist b v' a
       -> SnapletHeist b v a
withSS f (SnapletHeist m) = SnapletHeist $ withReaderT f m


------------------------------------------------------------------------------
-- | Lifts a HeistT action into SnapletHeist.  Use this with all the functions
-- from the Heist API.
--
liftHeist :: HeistT (Handler b b) a -> SnapletHeist b v a
liftHeist = SnapletHeist . lift


------------------------------------------------------------------------------
-- | Common idiom for the combination of liftHandler and withTop.
--
liftWith :: (Lens (Snaplet b) (Snaplet v'))
         -> Handler b v' a
         -> SnapletHeist b v a
liftWith l = liftHeist . lift . withTop' l


------------------------------------------------------------------------------
-- | Lifts a Handler into SnapletHeist.
--
liftHandler :: Handler b v a -> SnapletHeist b v a
liftHandler m = do
    l <- ask
    liftWith l m


------------------------------------------------------------------------------
-- | Lifts a (Handler b b) into SnapletHeist.
--
liftAppHandler :: Handler b b a -> SnapletHeist b v a
liftAppHandler = liftHeist . lift


------------------------------------------------------------------------------
instance MonadState v (SnapletHeist b v) where
    get = do
        l <- ask
        b <- liftAppHandler getSnapletState
        return $ getL (snapletValue . l) b
    put s = do
        l <- ask
        b <- liftAppHandler getSnapletState
        liftAppHandler $ putSnapletState $ setL (snapletValue . l) s b


------------------------------------------------------------------------------
-- | MonadSnaplet instance gives us access to the snaplet infrastructure.
--
instance MonadSnaplet SnapletHeist where
    getLens = ask
    with' l = withSS (l .)
    withTop' l = withSS (const id) . with' l
    getOpaqueConfig = do
        l <- ask
        b <- liftAppHandler getSnapletState
        return $ getL (snapletConfig . l) b


------------------------------------------------------------------------------
-- | SnapletSplices version of bindSplices.
--
bindSnapletSplices :: (Lens (Snaplet b) (Snaplet v))
                   -> [(Text, SnapletSplice b v)]
                   -> HeistState (Handler b b)
                   -> HeistState (Handler b b)
bindSnapletSplices l splices =
    bindSplices $ map (second $ runSnapletSplice l) splices


                          ---------------------------
                          -- Initializer functions --
                          ---------------------------

------------------------------------------------------------------------------
-- | The 'Initializer' for 'Heist'. This function is a convenience wrapper
-- around `heistInit'` that uses the default `mempty` HeistState and sets up
-- routes for all the templates.
--
heistInit :: FilePath                 -- ^ Path to templates
          -> SnapletInit b (Heist b)
heistInit templateDir = do
    makeSnaplet "heist" "" Nothing $ do
        hs <- heistInitWorker templateDir defaultHeistState
        addRoutes [ ("", heistServe) ]
        return hs


------------------------------------------------------------------------------
-- | A lower level 'Initializer' for 'Heist'.  This initializer requires you
-- to specify the initial HeistState.  It also does not add any routes for
-- templates, allowing you complete control over which templates get routed.
--
heistInit' :: FilePath
           -- ^ Path to templates
           -> HeistState (Handler b b)
           -- ^ Initial HeistState<commit_msg>Haddock fix<commit_after>{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE TypeSynonymInstances       #-}
module Snap.Snaplet.HeistNoClass
  ( Heist
  , heistInit
  , heistInit'
  , clearHeistCache

  , addTemplates
  , addTemplatesAt
  , modifyHeistTS
  , modifyHeistTS'
  , withHeistTS
  , withHeistTS'
  , addSplices
  , addSplices'
  , render
  , renderAs
  , heistServe
  , heistServeSingle
  , heistLocal
  , withSplices
  , renderWithSplices
  , heistLocal'
  , withSplices'
  , renderWithSplices'

  , SnapletHeist
  , SnapletSplice
  , runSnapletSplice
  , liftHeist
  , liftWith
  , liftHandler
  , liftAppHandler
  , bindSnapletSplices
  ) where

import           Prelude hiding ((.), id)
import           Control.Arrow
import           Control.Applicative
import           Control.Category
import           Control.Monad.CatchIO (MonadCatchIO)
import           Control.Monad.Reader
import           Control.Monad.State
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.UTF8 as U
import           Data.Maybe
import           Data.Monoid
import           Data.Lens.Lazy
import           Data.Text (Text)
import qualified Data.Text as T
import           System.FilePath.Posix
import           Text.Templating.Heist
import           Text.Templating.Heist.Splices.Cache

import           Snap.Snaplet
import           Snap.Core
import           Snap.Util.FileServe


------------------------------------------------------------------------------
-- | The state for the Heist snaplet.  To use the Heist snaplet in your app
-- include this in your application state and use 'heistInit' to initialize
-- it.  The type parameter b will typically be the base state type for your
-- application.
--
data Heist b = Heist
    { _heistTS       :: HeistState (Handler b b)
    , _heistCTS      :: CacheTagState
    }


------------------------------------------------------------------------------
changeTS :: (HeistState (Handler a a) -> HeistState (Handler a a))
         -> Heist a
         -> Heist a
changeTS f (Heist ts cts) = Heist (f ts) cts


------------------------------------------------------------------------------
-- | Clears data stored by the cache tag.  The cache tag automatically reloads
-- its data when the specified TTL expires, but sometimes you may want to
-- trigger a manual reload.  This function lets you do that.
--
clearHeistCache :: Heist b -> IO ()
clearHeistCache = clearCacheTagState . _heistCTS


                         -----------------------------
                         -- SnapletSplice functions --
                         -----------------------------

------------------------------------------------------------------------------
-- | This instance is here because we don't want the heist package to depend
-- on anything from snap packages.
--
instance MonadSnap m => MonadSnap (HeistT m) where
    liftSnap = lift . liftSnap


------------------------------------------------------------------------------
-- | Monad for working with Heist's API from within a snaplet.
--
newtype SnapletHeist b v a = SnapletHeist
    (ReaderT (Lens (Snaplet b) (Snaplet v)) (HeistT (Handler b b)) a)
  deriving ( Monad
           , Functor
           , Applicative
           , Alternative
           , MonadIO
           , MonadPlus
           , MonadReader (Lens (Snaplet b) (Snaplet v))
           , MonadCatchIO
           , MonadSnap
           )


------------------------------------------------------------------------------
-- | Type alias for convenience.
--
type SnapletSplice b v = SnapletHeist b v Template


------------------------------------------------------------------------------
-- | Runs the SnapletSplice.
--
runSnapletSplice :: (Lens (Snaplet b) (Snaplet v))
                 -> SnapletHeist b v a
                 -> HeistT (Handler b b) a
runSnapletSplice l (SnapletHeist m) = runReaderT m l


------------------------------------------------------------------------------
withSS :: (Lens (Snaplet b) (Snaplet v) -> Lens (Snaplet b) (Snaplet v'))
       -> SnapletHeist b v' a
       -> SnapletHeist b v a
withSS f (SnapletHeist m) = SnapletHeist $ withReaderT f m


------------------------------------------------------------------------------
-- | Lifts a HeistT action into SnapletHeist.  Use this with all the functions
-- from the Heist API.
--
liftHeist :: HeistT (Handler b b) a -> SnapletHeist b v a
liftHeist = SnapletHeist . lift


------------------------------------------------------------------------------
-- | Common idiom for the combination of liftHandler and withTop.
--
liftWith :: (Lens (Snaplet b) (Snaplet v'))
         -> Handler b v' a
         -> SnapletHeist b v a
liftWith l = liftHeist . lift . withTop' l


------------------------------------------------------------------------------
-- | Lifts a Handler into SnapletHeist.
--
liftHandler :: Handler b v a -> SnapletHeist b v a
liftHandler m = do
    l <- ask
    liftWith l m


------------------------------------------------------------------------------
-- | Lifts a (Handler b b) into SnapletHeist.
--
liftAppHandler :: Handler b b a -> SnapletHeist b v a
liftAppHandler = liftHeist . lift


------------------------------------------------------------------------------
instance MonadState v (SnapletHeist b v) where
    get = do
        l <- ask
        b <- liftAppHandler getSnapletState
        return $ getL (snapletValue . l) b
    put s = do
        l <- ask
        b <- liftAppHandler getSnapletState
        liftAppHandler $ putSnapletState $ setL (snapletValue . l) s b


------------------------------------------------------------------------------
-- | MonadSnaplet instance gives us access to the snaplet infrastructure.
--
instance MonadSnaplet SnapletHeist where
    getLens = ask
    with' l = withSS (l .)
    withTop' l = withSS (const id) . with' l
    getOpaqueConfig = do
        l <- ask
        b <- liftAppHandler getSnapletState
        return $ getL (snapletConfig . l) b


------------------------------------------------------------------------------
-- | SnapletSplices version of bindSplices.
--
bindSnapletSplices :: (Lens (Snaplet b) (Snaplet v))
                   -> [(Text, SnapletSplice b v)]
                   -> HeistState (Handler b b)
                   -> HeistState (Handler b b)
bindSnapletSplices l splices =
    bindSplices $ map (second $ runSnapletSplice l) splices


                          ---------------------------
                          -- Initializer functions --
                          ---------------------------

------------------------------------------------------------------------------
-- | The 'Initializer' for 'Heist'. This function is a convenience wrapper
-- around `heistInit'` that uses defaultHeistState and sets up routes for all
-- the templates.
--
heistInit :: FilePath                 -- ^ Path to templates
          -> SnapletInit b (Heist b)
heistInit templateDir = do
    makeSnaplet "heist" "" Nothing $ do
        hs <- heistInitWorker templateDir defaultHeistState
        addRoutes [ ("", heistServe) ]
        return hs


------------------------------------------------------------------------------
-- | A lower level 'Initializer' for 'Heist'.  This initializer requires you
-- to specify the initial HeistState.  It also does not add any routes for
-- templates, allowing you complete control over which templates get routed.
--
heistInit' :: FilePath
           -- ^ Path to templates
           -> HeistState (Handler b b)
           -- ^ Initial HeistState
{'fraction_non_alphanumeric': 0.25257334019557387, 'fraction_numerical': 0.0002573340195573855, 'mean_word_length': 1.2460627077011992, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 43, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7465141', 'n_tokens_mistral': 4181, 'n_tokens_neox': 3964, 'n_words': 1299}