{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
#ifndef MIN_VERSION_comonad
#define MIN_VERSION_comonad(x,y,z) 1
#endif
module Snap.Snaplet.Internal.Types where
import Control.Applicative (Alternative)
import Control.Lens (ALens', makeLenses, set)
import Control.Monad (MonadPlus, liftM)
import Control.Monad.Base (MonadBase (..))
import Control.Monad.Fail (MonadFail)
import Control.Monad.Reader (MonadIO (..), MonadReader (ask, local))
import Control.Monad.State.Class (MonadState (get, put), gets)
import Control.Monad.Trans.Control (MonadBaseControl (..))
import Control.Monad.Trans.Writer (WriterT)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B (dropWhile, intercalate, null, reverse)
import Data.Configurator.Types (Config)
import Data.IORef (IORef)
import Data.Text (Text)
import Snap.Core (MonadSnap, Request (rqClientAddr), Snap, bracketSnap, getRequest, pass, writeText)
import qualified Snap.Snaplet.Internal.Lensed as L (Lensed (..), runLensed, with, withTop)
import qualified Snap.Snaplet.Internal.LensT as LT (LensT, getBase, with, withTop)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative)
import Data.Monoid (Monoid (mappend, mempty))
#endif
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
data SnapletConfig = SnapletConfig
{ SnapletConfig -> [Text]
_scAncestry :: [Text]
, SnapletConfig -> FilePath
_scFilePath :: FilePath
, SnapletConfig -> Maybe Text
_scId :: Maybe Text
, SnapletConfig -> Text
_scDescription :: Text
, SnapletConfig -> Config
_scUserConfig :: Config
, SnapletConfig -> [ByteString]
_scRouteContext :: [ByteString]
, SnapletConfig -> Maybe ByteString
_scRoutePattern :: Maybe ByteString
, SnapletConfig -> IO (Either Text Text)
_reloader :: IO (Either Text Text)
}
makeLenses ''SnapletConfig
buildPath :: [ByteString] -> ByteString
buildPath :: [ByteString] -> ByteString
buildPath [ByteString]
ps = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"/" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
B.null) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
ps
getRootURL :: SnapletConfig -> ByteString
getRootURL :: SnapletConfig -> ByteString
getRootURL SnapletConfig
sc = [ByteString] -> ByteString
buildPath ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ SnapletConfig -> [ByteString]
_scRouteContext SnapletConfig
sc
data Snaplet s = Snaplet
{ forall s. Snaplet s -> SnapletConfig
_snapletConfig :: SnapletConfig
, forall s. Snaplet s -> s -> IO ()
_snapletModifier :: s -> IO ()
, forall s. Snaplet s -> s
_snapletValue :: s
}
makeLenses ''Snaplet
type SnapletLens s a = ALens' s (Snaplet a)
subSnaplet :: SnapletLens a b
-> SnapletLens (Snaplet a) b
subSnaplet :: forall a b. SnapletLens a b -> SnapletLens (Snaplet a) b
subSnaplet SnapletLens a b
l = (a -> Pretext (->) (Snaplet b) (Snaplet b) a)
-> Snaplet a -> Pretext (->) (Snaplet b) (Snaplet b) (Snaplet a)
forall s (f :: * -> *).
Functor f =>
(s -> f s) -> Snaplet s -> f (Snaplet s)
snapletValue ((a -> Pretext (->) (Snaplet b) (Snaplet b) a)
-> Snaplet a -> Pretext (->) (Snaplet b) (Snaplet b) (Snaplet a))
-> SnapletLens a b
-> (Snaplet b -> Pretext (->) (Snaplet b) (Snaplet b) (Snaplet b))
-> Snaplet a
-> Pretext (->) (Snaplet b) (Snaplet b) (Snaplet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapletLens a b
l
class MonadSnaplet m where
with :: SnapletLens v v'
-> m b v' a
-> m b v a
with SnapletLens v v'
l = SnapletLens (Snaplet v) v' -> m b v' a -> m b v a
forall v v' b a. SnapletLens (Snaplet v) v' -> m b v' a -> m b v a
forall (m :: * -> * -> * -> *) v v' b a.
MonadSnaplet m =>
SnapletLens (Snaplet v) v' -> m b v' a -> m b v a
with' (SnapletLens v v' -> SnapletLens (Snaplet v) v'
forall a b. SnapletLens a b -> SnapletLens (Snaplet a) b
subSnaplet SnapletLens v v'
l)
withTop :: SnapletLens b v'
-> m b v' a
-> m b v a
withTop SnapletLens b v'
l = SnapletLens (Snaplet b) v' -> m b v' a -> m b v a
forall b v' a v. SnapletLens (Snaplet b) v' -> m b v' a -> m b v a
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens (Snaplet b) v' -> m b v' a -> m b v a
withTop' (SnapletLens b v' -> SnapletLens (Snaplet b) v'
forall a b. SnapletLens a b -> SnapletLens (Snaplet a) b
subSnaplet SnapletLens b v'
l)
with' :: SnapletLens (Snaplet v) v'
-> m b v' a -> m b v a
withTop' :: SnapletLens (Snaplet b) v'
-> m b v' a -> m b v a
getLens :: m b v (SnapletLens (Snaplet b) v)
getOpaqueConfig :: m b v SnapletConfig
getSnapletAncestry :: (Monad (m b v), MonadSnaplet m) => m b v [Text]
getSnapletAncestry :: forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
m b v [Text]
getSnapletAncestry = [Text] -> m b v [Text]
forall a. a -> m b v a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> m b v [Text])
-> (SnapletConfig -> [Text]) -> SnapletConfig -> m b v [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapletConfig -> [Text]
_scAncestry (SnapletConfig -> m b v [Text])
-> m b v SnapletConfig -> m b v [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m b v SnapletConfig
forall b v. m b v SnapletConfig
forall (m :: * -> * -> * -> *) b v.
MonadSnaplet m =>
m b v SnapletConfig
getOpaqueConfig
getSnapletFilePath :: (Monad (m b v), MonadSnaplet m) => m b v FilePath
getSnapletFilePath :: forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
m b v FilePath
getSnapletFilePath = FilePath -> m b v FilePath
forall a. a -> m b v a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> m b v FilePath)
-> (SnapletConfig -> FilePath) -> SnapletConfig -> m b v FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapletConfig -> FilePath
_scFilePath (SnapletConfig -> m b v FilePath)
-> m b v SnapletConfig -> m b v FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m b v SnapletConfig
forall b v. m b v SnapletConfig
forall (m :: * -> * -> * -> *) b v.
MonadSnaplet m =>
m b v SnapletConfig
getOpaqueConfig
getSnapletName :: (Monad (m b v), MonadSnaplet m) => m b v (Maybe Text)
getSnapletName :: forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
m b v (Maybe Text)
getSnapletName = Maybe Text -> m b v (Maybe Text)
forall a. a -> m b v a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> m b v (Maybe Text))
-> (SnapletConfig -> Maybe Text)
-> SnapletConfig
-> m b v (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapletConfig -> Maybe Text
_scId (SnapletConfig -> m b v (Maybe Text))
-> m b v SnapletConfig -> m b v (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m b v SnapletConfig
forall b v. m b v SnapletConfig
forall (m :: * -> * -> * -> *) b v.
MonadSnaplet m =>
m b v SnapletConfig
getOpaqueConfig
getSnapletDescription :: (Monad (m b v), MonadSnaplet m) => m b v Text
getSnapletDescription :: forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
m b v Text
getSnapletDescription = Text -> m b v Text
forall a. a -> m b v a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m b v Text)
-> (SnapletConfig -> Text) -> SnapletConfig -> m b v Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapletConfig -> Text
_scDescription (SnapletConfig -> m b v Text) -> m b v SnapletConfig -> m b v Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m b v SnapletConfig
forall b v. m b v SnapletConfig
forall (m :: * -> * -> * -> *) b v.
MonadSnaplet m =>
m b v SnapletConfig
getOpaqueConfig
getSnapletUserConfig :: (Monad (m b v), MonadSnaplet m) => m b v Config
getSnapletUserConfig :: forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
m b v Config
getSnapletUserConfig = Config -> m b v Config
forall a. a -> m b v a
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> m b v Config)
-> (SnapletConfig -> Config) -> SnapletConfig -> m b v Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapletConfig -> Config
_scUserConfig (SnapletConfig -> m b v Config)
-> m b v SnapletConfig -> m b v Config
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m b v SnapletConfig
forall b v. m b v SnapletConfig
forall (m :: * -> * -> * -> *) b v.
MonadSnaplet m =>
m b v SnapletConfig
getOpaqueConfig
getSnapletRootURL :: (Monad (m b v), MonadSnaplet m) => m b v ByteString
getSnapletRootURL :: forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
m b v ByteString
getSnapletRootURL = (SnapletConfig -> ByteString)
-> m b v SnapletConfig -> m b v ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM SnapletConfig -> ByteString
getRootURL m b v SnapletConfig
forall b v. m b v SnapletConfig
forall (m :: * -> * -> * -> *) b v.
MonadSnaplet m =>
m b v SnapletConfig
getOpaqueConfig
snapletURL :: (Monad (m b v), MonadSnaplet m)
=> ByteString -> m b v ByteString
snapletURL :: forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
ByteString -> m b v ByteString
snapletURL ByteString
suffix = do
SnapletConfig
cfg <- m b v SnapletConfig
forall b v. m b v SnapletConfig
forall (m :: * -> * -> * -> *) b v.
MonadSnaplet m =>
m b v SnapletConfig
getOpaqueConfig
ByteString -> m b v ByteString
forall a. a -> m b v a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m b v ByteString) -> ByteString -> m b v ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
buildPath (ByteString
cleanSuffix ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: SnapletConfig -> [ByteString]
_scRouteContext SnapletConfig
cfg)
where
dropSlash :: ByteString -> ByteString
dropSlash = (Char -> Bool) -> ByteString -> ByteString
B.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/')
cleanSuffix :: ByteString
cleanSuffix = ByteString -> ByteString
B.reverse (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
dropSlash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.reverse (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
dropSlash ByteString
suffix
newtype Handler b v a =
Handler { forall b v a.
Handler b v a -> Lensed (Snaplet b) (Snaplet v) Snap a
_unHandler :: L.Lensed (Snaplet b) (Snaplet v) Snap a }
deriving ( Applicative (Handler b v)
Applicative (Handler b v)
-> (forall a b.
Handler b v a -> (a -> Handler b v b) -> Handler b v b)
-> (forall a b. Handler b v a -> Handler b v b -> Handler b v b)
-> (forall a. a -> Handler b v a)
-> Monad (Handler b v)
forall a. a -> Handler b v a
forall {b} {v}. Applicative (Handler b v)
forall a b. Handler b v a -> Handler b v b -> Handler b v b
forall a b. Handler b v a -> (a -> Handler b v b) -> Handler b v b
forall b v a. a -> Handler b v a
forall b v a b. Handler b v a -> Handler b v b -> Handler b v b
forall b v a b.
Handler b v a -> (a -> Handler b v b) -> Handler b v b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall b v a b.
Handler b v a -> (a -> Handler b v b) -> Handler b v b
>>= :: forall a b. Handler b v a -> (a -> Handler b v b) -> Handler b v b
$c>> :: forall b v a b. Handler b v a -> Handler b v b -> Handler b v b
>> :: forall a b. Handler b v a -> Handler b v b -> Handler b v b
$creturn :: forall b v a. a -> Handler b v a
return :: forall a. a -> Handler b v a
Monad
, (forall a b. (a -> b) -> Handler b v a -> Handler b v b)
-> (forall a b. a -> Handler b v b -> Handler b v a)
-> Functor (Handler b v)
forall a b. a -> Handler b v b -> Handler b v a
forall a b. (a -> b) -> Handler b v a -> Handler b v b
forall b v a b. a -> Handler b v b -> Handler b v a
forall b v a b. (a -> b) -> Handler b v a -> Handler b v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall b v a b. (a -> b) -> Handler b v a -> Handler b v b
fmap :: forall a b. (a -> b) -> Handler b v a -> Handler b v b
$c<$ :: forall b v a b. a -> Handler b v b -> Handler b v a
<$ :: forall a b. a -> Handler b v b -> Handler b v a
Functor
, Functor (Handler b v)
Functor (Handler b v)
-> (forall a. a -> Handler b v a)
-> (forall a b.
Handler b v (a -> b) -> Handler b v a -> Handler b v b)
-> (forall a b c.
(a -> b -> c) -> Handler b v a -> Handler b v b -> Handler b v c)
-> (forall a b. Handler b v a -> Handler b v b -> Handler b v b)
-> (forall a b. Handler b v a -> Handler b v b -> Handler b v a)
-> Applicative (Handler b v)
forall a. a -> Handler b v a
forall b v. Functor (Handler b v)
forall a b. Handler b v a -> Handler b v b -> Handler b v a
forall a b. Handler b v a -> Handler b v b -> Handler b v b
forall a b. Handler b v (a -> b) -> Handler b v a -> Handler b v b
forall b v a. a -> Handler b v a
forall a b c.
(a -> b -> c) -> Handler b v a -> Handler b v b -> Handler b v c
forall b v a b. Handler b v a -> Handler b v b -> Handler b v a
forall b v a b. Handler b v a -> Handler b v b -> Handler b v b
forall b v a b.
Handler b v (a -> b) -> Handler b v a -> Handler b v b
forall b v a b c.
(a -> b -> c) -> Handler b v a -> Handler b v b -> Handler b v c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall b v a. a -> Handler b v a
pure :: forall a. a -> Handler b v a
$c<*> :: forall b v a b.
Handler b v (a -> b) -> Handler b v a -> Handler b v b
<*> :: forall a b. Handler b v (a -> b) -> Handler b v a -> Handler b v b
$cliftA2 :: forall b v a b c.
(a -> b -> c) -> Handler b v a -> Handler b v b -> Handler b v c
liftA2 :: forall a b c.
(a -> b -> c) -> Handler b v a -> Handler b v b -> Handler b v c
$c*> :: forall b v a b. Handler b v a -> Handler b v b -> Handler b v b
*> :: forall a b. Handler b v a -> Handler b v b -> Handler b v b
$c<* :: forall b v a b. Handler b v a -> Handler b v b -> Handler b v a
<* :: forall a b. Handler b v a -> Handler b v b -> Handler b v a
Applicative
, Monad (Handler b v)
Monad (Handler b v)
-> (forall a. FilePath -> Handler b v a) -> MonadFail (Handler b v)
forall a. FilePath -> Handler b v a
forall b v. Monad (Handler b v)
forall b v a. FilePath -> Handler b v a
forall (m :: * -> *).
Monad m -> (forall a. FilePath -> m a) -> MonadFail m
$cfail :: forall b v a. FilePath -> Handler b v a
fail :: forall a. FilePath -> Handler b v a
MonadFail
, Monad (Handler b v)
Monad (Handler b v)
-> (forall a. IO a -> Handler b v a) -> MonadIO (Handler b v)
forall a. IO a -> Handler b v a
forall b v. Monad (Handler b v)
forall b v a. IO a -> Handler b v a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall b v a. IO a -> Handler b v a
liftIO :: forall a. IO a -> Handler b v a
MonadIO
, Monad (Handler b v)
Alternative (Handler b v)
Alternative (Handler b v)
-> Monad (Handler b v)
-> (forall a. Handler b v a)
-> (forall a. Handler b v a -> Handler b v a -> Handler b v a)
-> MonadPlus (Handler b v)
forall a. Handler b v a
forall a. Handler b v a -> Handler b v a -> Handler b v a
forall b v. Monad (Handler b v)
forall {b} {v}. Alternative (Handler b v)
forall b v a. Handler b v a
forall b v a. Handler b v a -> Handler b v a -> Handler b v a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
$cmzero :: forall b v a. Handler b v a
mzero :: forall a. Handler b v a
$cmplus :: forall b v a. Handler b v a -> Handler b v a -> Handler b v a
mplus :: forall a. Handler b v a -> Handler b v a -> Handler b v a
MonadPlus
, Applicative (Handler b v)
Applicative (Handler b v)
-> (forall a. Handler b v a)
-> (forall a. Handler b v a -> Handler b v a -> Handler b v a)
-> (forall a. Handler b v a -> Handler b v [a])
-> (forall a. Handler b v a -> Handler b v [a])
-> Alternative (Handler b v)
forall a. Handler b v a
forall a. Handler b v a -> Handler b v [a]
forall a. Handler b v a -> Handler b v a -> Handler b v a
forall {b} {v}. Applicative (Handler b v)
forall b v a. Handler b v a
forall b v a. Handler b v a -> Handler b v [a]
forall b v a. Handler b v a -> Handler b v a -> Handler b v a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
$cempty :: forall b v a. Handler b v a
empty :: forall a. Handler b v a
$c<|> :: forall b v a. Handler b v a -> Handler b v a -> Handler b v a
<|> :: forall a. Handler b v a -> Handler b v a -> Handler b v a
$csome :: forall b v a. Handler b v a -> Handler b v [a]
some :: forall a. Handler b v a -> Handler b v [a]
$cmany :: forall b v a. Handler b v a -> Handler b v [a]
many :: forall a. Handler b v a -> Handler b v [a]
Alternative
, Monad (Handler b v)
Functor (Handler b v)
Applicative (Handler b v)
MonadPlus (Handler b v)
Alternative (Handler b v)
MonadIO (Handler b v)
MonadBaseControl IO (Handler b v)
Monad (Handler b v)
-> MonadIO (Handler b v)
-> MonadBaseControl IO (Handler b v)
-> MonadPlus (Handler b v)
-> Functor (Handler b v)
-> Applicative (Handler b v)
-> Alternative (Handler b v)
-> (forall a. Snap a -> Handler b v a)
-> MonadSnap (Handler b v)
forall a. Snap a -> Handler b v a
forall b v. Monad (Handler b v)
forall b v. Functor (Handler b v)
forall {b} {v}. Applicative (Handler b v)
forall b v. MonadPlus (Handler b v)
forall {b} {v}. Alternative (Handler b v)
forall b v. MonadIO (Handler b v)
forall {b} {v}. MonadBaseControl IO (Handler b v)
forall b v a. Snap a -> Handler b v a
forall (m :: * -> *).
Monad m
-> MonadIO m
-> MonadBaseControl IO m
-> MonadPlus m
-> Functor m
-> Applicative m
-> Alternative m
-> (forall a. Snap a -> m a)
-> MonadSnap m
$cliftSnap :: forall b v a. Snap a -> Handler b v a
liftSnap :: forall a. Snap a -> Handler b v a
MonadSnap)
instance MonadBase IO (Handler b v) where
liftBase :: forall α. IO α -> Handler b v α
liftBase = IO α -> Handler b v α
forall α. IO α -> Handler b v α
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
newtype StMHandler b v a = StMHandler {
forall b v a.
StMHandler b v a -> StM (Lensed (Snaplet b) (Snaplet v) Snap) a
unStMHandler :: StM (L.Lensed (Snaplet b) (Snaplet v) Snap) a
}
instance MonadBaseControl IO (Handler b v) where
type StM (Handler b v) a = StMHandler b v a
liftBaseWith :: forall a. (RunInBase (Handler b v) IO -> IO a) -> Handler b v a
liftBaseWith RunInBase (Handler b v) IO -> IO a
f = Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
forall b v a.
Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
Handler
(Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a)
-> Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
forall a b. (a -> b) -> a -> b
$ (RunInBase (Lensed (Snaplet b) (Snaplet v) Snap) IO -> IO a)
-> Lensed (Snaplet b) (Snaplet v) Snap a
forall a.
(RunInBase (Lensed (Snaplet b) (Snaplet v) Snap) IO -> IO a)
-> Lensed (Snaplet b) (Snaplet v) Snap a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith
((RunInBase (Lensed (Snaplet b) (Snaplet v) Snap) IO -> IO a)
-> Lensed (Snaplet b) (Snaplet v) Snap a)
-> (RunInBase (Lensed (Snaplet b) (Snaplet v) Snap) IO -> IO a)
-> Lensed (Snaplet b) (Snaplet v) Snap a
forall a b. (a -> b) -> a -> b
$ \RunInBase (Lensed (Snaplet b) (Snaplet v) Snap) IO
g' -> RunInBase (Handler b v) IO -> IO a
f
(RunInBase (Handler b v) IO -> IO a)
-> RunInBase (Handler b v) IO -> IO a
forall a b. (a -> b) -> a -> b
$ \Handler b v a
m -> (StM (Lensed (Snaplet b) (Snaplet v) Snap) a -> StMHandler b v a)
-> IO (StM (Lensed (Snaplet b) (Snaplet v) Snap) a)
-> IO (StMHandler b v a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM StM (Lensed (Snaplet b) (Snaplet v) Snap) a -> StMHandler b v a
forall b v a.
StM (Lensed (Snaplet b) (Snaplet v) Snap) a -> StMHandler b v a
StMHandler
(IO (StM (Lensed (Snaplet b) (Snaplet v) Snap) a)
-> IO (StMHandler b v a))
-> IO (StM (Lensed (Snaplet b) (Snaplet v) Snap) a)
-> IO (StMHandler b v a)
forall a b. (a -> b) -> a -> b
$ Lensed (Snaplet b) (Snaplet v) Snap a
-> IO (StM (Lensed (Snaplet b) (Snaplet v) Snap) a)
RunInBase (Lensed (Snaplet b) (Snaplet v) Snap) IO
g' (Lensed (Snaplet b) (Snaplet v) Snap a
-> IO (StM (Lensed (Snaplet b) (Snaplet v) Snap) a))
-> Lensed (Snaplet b) (Snaplet v) Snap a
-> IO (StM (Lensed (Snaplet b) (Snaplet v) Snap) a)
forall a b. (a -> b) -> a -> b
$ Handler b v a -> Lensed (Snaplet b) (Snaplet v) Snap a
forall b v a.
Handler b v a -> Lensed (Snaplet b) (Snaplet v) Snap a
_unHandler Handler b v a
m
restoreM :: forall a. StM (Handler b v) a -> Handler b v a
restoreM = Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
forall b v a.
Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
Handler (Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a)
-> (StMHandler b v a -> Lensed (Snaplet b) (Snaplet v) Snap a)
-> StMHandler b v a
-> Handler b v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM (Lensed (Snaplet b) (Snaplet v) Snap) a
-> Lensed (Snaplet b) (Snaplet v) Snap a
forall a.
StM (Lensed (Snaplet b) (Snaplet v) Snap) a
-> Lensed (Snaplet b) (Snaplet v) Snap a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM (StM (Lensed (Snaplet b) (Snaplet v) Snap) a
-> Lensed (Snaplet b) (Snaplet v) Snap a)
-> (StMHandler b v a
-> StM (Lensed (Snaplet b) (Snaplet v) Snap) a)
-> StMHandler b v a
-> Lensed (Snaplet b) (Snaplet v) Snap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StMHandler b v a -> StM (Lensed (Snaplet b) (Snaplet v) Snap) a
forall b v a.
StMHandler b v a -> StM (Lensed (Snaplet b) (Snaplet v) Snap) a
unStMHandler
getSnapletState :: Handler b v (Snaplet v)
getSnapletState :: forall b v. Handler b v (Snaplet v)
getSnapletState = Lensed (Snaplet b) (Snaplet v) Snap (Snaplet v)
-> Handler b v (Snaplet v)
forall b v a.
Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
Handler Lensed (Snaplet b) (Snaplet v) Snap (Snaplet v)
forall s (m :: * -> *). MonadState s m => m s
get
putSnapletState :: Snaplet v -> Handler b v ()
putSnapletState :: forall v b. Snaplet v -> Handler b v ()
putSnapletState = Lensed (Snaplet b) (Snaplet v) Snap () -> Handler b v ()
forall b v a.
Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
Handler (Lensed (Snaplet b) (Snaplet v) Snap () -> Handler b v ())
-> (Snaplet v -> Lensed (Snaplet b) (Snaplet v) Snap ())
-> Snaplet v
-> Handler b v ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Snaplet v -> Lensed (Snaplet b) (Snaplet v) Snap ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
modifySnapletState :: (Snaplet v -> Snaplet v) -> Handler b v ()
modifySnapletState :: forall v b. (Snaplet v -> Snaplet v) -> Handler b v ()
modifySnapletState Snaplet v -> Snaplet v
f = do
Snaplet v
s <- Handler b v (Snaplet v)
forall b v. Handler b v (Snaplet v)
getSnapletState
Snaplet v -> Handler b v ()
forall v b. Snaplet v -> Handler b v ()
putSnapletState (Snaplet v -> Snaplet v
f Snaplet v
s)
getsSnapletState :: (Snaplet v -> b) -> Handler b1 v b
getsSnapletState :: forall v b b1. (Snaplet v -> b) -> Handler b1 v b
getsSnapletState Snaplet v -> b
f = do
Snaplet v
s <- Handler b1 v (Snaplet v)
forall b v. Handler b v (Snaplet v)
getSnapletState
b -> Handler b1 v b
forall a. a -> Handler b1 v a
forall (m :: * -> *) a. Monad m => a -> m a
return (Snaplet v -> b
f Snaplet v
s)
instance MonadState v (Handler b v) where
get :: Handler b v v
get = (Snaplet v -> v) -> Handler b v v
forall v b b1. (Snaplet v -> b) -> Handler b1 v b
getsSnapletState Snaplet v -> v
forall s. Snaplet s -> s
_snapletValue
put :: v -> Handler b v ()
put v
v = (Snaplet v -> Snaplet v) -> Handler b v ()
forall v b. (Snaplet v -> Snaplet v) -> Handler b v ()
modifySnapletState (ASetter (Snaplet v) (Snaplet v) v v -> v -> Snaplet v -> Snaplet v
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Snaplet v) (Snaplet v) v v
forall s (f :: * -> *).
Functor f =>
(s -> f s) -> Snaplet s -> f (Snaplet s)
snapletValue v
v)
instance MonadReader v (Handler b v) where
ask :: Handler b v v
ask = (Snaplet v -> v) -> Handler b v v
forall v b b1. (Snaplet v -> b) -> Handler b1 v b
getsSnapletState Snaplet v -> v
forall s. Snaplet s -> s
_snapletValue
local :: forall a. (v -> v) -> Handler b v a -> Handler b v a
local v -> v
f Handler b v a
m = do
v
cur <- Handler b v v
forall r (m :: * -> *). MonadReader r m => m r
ask
v -> Handler b v ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (v -> v
f v
cur)
a
res <- Handler b v a
m
v -> Handler b v ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put v
cur
a -> Handler b v a
forall a. a -> Handler b v a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
instance MonadSnaplet Handler where
getLens :: forall b v. Handler b v (SnapletLens (Snaplet b) v)
getLens = Lensed (Snaplet b) (Snaplet v) Snap (SnapletLens (Snaplet b) v)
-> Handler b v (SnapletLens (Snaplet b) v)
forall b v a.
Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
Handler Lensed (Snaplet b) (Snaplet v) Snap (SnapletLens (Snaplet b) v)
forall r (m :: * -> *). MonadReader r m => m r
ask
with' :: forall v v' b a.
SnapletLens (Snaplet v) v' -> Handler b v' a -> Handler b v a
with' !SnapletLens (Snaplet v) v'
l (Handler !Lensed (Snaplet b) (Snaplet v') Snap a
m) = Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
forall b v a.
Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
Handler (Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a)
-> Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
forall a b. (a -> b) -> a -> b
$ SnapletLens (Snaplet v) v'
-> Lensed (Snaplet b) (Snaplet v') Snap a
-> Lensed (Snaplet b) (Snaplet v) Snap a
forall (m :: * -> *) v v' b a.
Monad m =>
ALens' v v' -> Lensed b v' m a -> Lensed b v m a
L.with SnapletLens (Snaplet v) v'
l Lensed (Snaplet b) (Snaplet v') Snap a
m
withTop' :: forall b v' a v.
SnapletLens (Snaplet b) v' -> Handler b v' a -> Handler b v a
withTop' !SnapletLens (Snaplet b) v'
l (Handler Lensed (Snaplet b) (Snaplet v') Snap a
m) = Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
forall b v a.
Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
Handler (Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a)
-> Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
forall a b. (a -> b) -> a -> b
$ SnapletLens (Snaplet b) v'
-> Lensed (Snaplet b) (Snaplet v') Snap a
-> Lensed (Snaplet b) (Snaplet v) Snap a
forall (m :: * -> *) b v' a v.
Monad m =>
ALens' b v' -> Lensed b v' m a -> Lensed b v m a
L.withTop SnapletLens (Snaplet b) v'
l Lensed (Snaplet b) (Snaplet v') Snap a
m
getOpaqueConfig :: forall b v. Handler b v SnapletConfig
getOpaqueConfig = Lensed (Snaplet b) (Snaplet v) Snap SnapletConfig
-> Handler b v SnapletConfig
forall b v a.
Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
Handler (Lensed (Snaplet b) (Snaplet v) Snap SnapletConfig
-> Handler b v SnapletConfig)
-> Lensed (Snaplet b) (Snaplet v) Snap SnapletConfig
-> Handler b v SnapletConfig
forall a b. (a -> b) -> a -> b
$ (Snaplet v -> SnapletConfig)
-> Lensed (Snaplet b) (Snaplet v) Snap SnapletConfig
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Snaplet v -> SnapletConfig
forall s. Snaplet s -> SnapletConfig
_snapletConfig
runPureBase :: Handler b b a -> Snaplet b -> Snap a
runPureBase :: forall b a. Handler b b a -> Snaplet b -> Snap a
runPureBase (Handler Lensed (Snaplet b) (Snaplet b) Snap a
m) Snaplet b
b = do
(!a
a, Snaplet b
_) <- Lensed (Snaplet b) (Snaplet b) Snap a
-> ALens' (Snaplet b) (Snaplet b)
-> Snaplet b
-> Snap (a, Snaplet b)
forall (m :: * -> *) t1 b t.
Monad m =>
Lensed t1 b m t -> ALens' t1 b -> t1 -> m (t, t1)
L.runLensed Lensed (Snaplet b) (Snaplet b) Snap a
m ALens' (Snaplet b) (Snaplet b)
forall a. a -> a
id Snaplet b
b
a -> Snap a
forall a. a -> Snap a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Snap a) -> a -> Snap a
forall a b. (a -> b) -> a -> b
$! a
a
getRoutePattern :: Handler b v (Maybe ByteString)
getRoutePattern :: forall b v. Handler b v (Maybe ByteString)
getRoutePattern =
SnapletLens (Snaplet b) b
-> Handler b b (Maybe ByteString) -> Handler b v (Maybe ByteString)
forall b v' a v.
SnapletLens (Snaplet b) v' -> Handler b v' a -> Handler b v a
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens (Snaplet b) v' -> m b v' a -> m b v a
withTop' SnapletLens (Snaplet b) b
forall a. a -> a
id (Handler b b (Maybe ByteString) -> Handler b v (Maybe ByteString))
-> Handler b b (Maybe ByteString) -> Handler b v (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (SnapletConfig -> Maybe ByteString)
-> Handler b b SnapletConfig -> Handler b b (Maybe ByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM SnapletConfig -> Maybe ByteString
_scRoutePattern Handler b b SnapletConfig
forall b v. Handler b v SnapletConfig
forall (m :: * -> * -> * -> *) b v.
MonadSnaplet m =>
m b v SnapletConfig
getOpaqueConfig
setRoutePattern :: ByteString -> Handler b v ()
setRoutePattern :: forall b v. ByteString -> Handler b v ()
setRoutePattern ByteString
p = SnapletLens (Snaplet b) b -> Handler b b () -> Handler b v ()
forall b v' a v.
SnapletLens (Snaplet b) v' -> Handler b v' a -> Handler b v a
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens (Snaplet b) v' -> m b v' a -> m b v a
withTop' SnapletLens (Snaplet b) b
forall a. a -> a
id (Handler b b () -> Handler b v ())
-> Handler b b () -> Handler b v ()
forall a b. (a -> b) -> a -> b
$
(Snaplet b -> Snaplet b) -> Handler b b ()
forall v b. (Snaplet v -> Snaplet v) -> Handler b v ()
modifySnapletState (ASetter
(Snaplet b) (Snaplet b) (Maybe ByteString) (Maybe ByteString)
-> Maybe ByteString -> Snaplet b -> Snaplet b
forall s t a b. ASetter s t a b -> b -> s -> t
set ((SnapletConfig -> Identity SnapletConfig)
-> Snaplet b -> Identity (Snaplet b)
forall s (f :: * -> *).
Functor f =>
(SnapletConfig -> f SnapletConfig) -> Snaplet s -> f (Snaplet s)
snapletConfig ((SnapletConfig -> Identity SnapletConfig)
-> Snaplet b -> Identity (Snaplet b))
-> ((Maybe ByteString -> Identity (Maybe ByteString))
-> SnapletConfig -> Identity SnapletConfig)
-> ASetter
(Snaplet b) (Snaplet b) (Maybe ByteString) (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> Identity (Maybe ByteString))
-> SnapletConfig -> Identity SnapletConfig
Lens' SnapletConfig (Maybe ByteString)
scRoutePattern) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
p))
isLocalhost :: MonadSnap m => m Bool
isLocalhost :: forall (m :: * -> *). MonadSnap m => m Bool
isLocalhost = do
ByteString
rip <- (Request -> ByteString) -> m Request -> m ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Request -> ByteString
rqClientAddr m Request
forall (m :: * -> *). MonadSnap m => m Request
getRequest
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ByteString
rip [ ByteString
"127.0.0.1"
, ByteString
"localhost"
, ByteString
"::1" ]
failIfNotLocal :: MonadSnap m => m b -> m b
failIfNotLocal :: forall (m :: * -> *) b. MonadSnap m => m b -> m b
failIfNotLocal m b
m = do
Bool
isLocal <- m Bool
forall (m :: * -> *). MonadSnap m => m Bool
isLocalhost
if Bool
isLocal then m b
m else m b
forall (m :: * -> *) a. MonadSnap m => m a
pass
reloadSite :: Handler b v ()
reloadSite :: forall b v. Handler b v ()
reloadSite = Handler b v () -> Handler b v ()
forall (m :: * -> *) b. MonadSnap m => m b -> m b
failIfNotLocal (Handler b v () -> Handler b v ())
-> Handler b v () -> Handler b v ()
forall a b. (a -> b) -> a -> b
$ do
SnapletConfig
cfg <- Handler b v SnapletConfig
forall b v. Handler b v SnapletConfig
forall (m :: * -> * -> * -> *) b v.
MonadSnaplet m =>
m b v SnapletConfig
getOpaqueConfig
!Either Text Text
res <- IO (Either Text Text) -> Handler b v (Either Text Text)
forall a. IO a -> Handler b v a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Text Text) -> Handler b v (Either Text Text))
-> IO (Either Text Text) -> Handler b v (Either Text Text)
forall a b. (a -> b) -> a -> b
$ SnapletConfig -> IO (Either Text Text)
_reloader SnapletConfig
cfg
(Text -> Handler b v ())
-> (Text -> Handler b v ()) -> Either Text Text -> Handler b v ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Handler b v ()
forall {m :: * -> *}. MonadSnap m => Text -> m ()
bad Text -> Handler b v ()
forall {m :: * -> *}. MonadSnap m => Text -> m ()
good Either Text Text
res
where
bad :: Text -> m ()
bad Text
msg = do
Text -> m ()
forall {m :: * -> *}. MonadSnap m => Text -> m ()
writeText (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Error reloading site!\n\n"
Text -> m ()
forall {m :: * -> *}. MonadSnap m => Text -> m ()
writeText Text
msg
good :: Text -> m ()
good Text
msg = do
Text -> m ()
forall {m :: * -> *}. MonadSnap m => Text -> m ()
writeText Text
msg
Text -> m ()
forall {m :: * -> *}. MonadSnap m => Text -> m ()
writeText (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Site successfully reloaded.\n"
bracketHandler :: IO a -> (a -> IO x) -> (a -> Handler b v c) -> Handler b v c
bracketHandler :: forall a x b v c.
IO a -> (a -> IO x) -> (a -> Handler b v c) -> Handler b v c
bracketHandler IO a
begin a -> IO x
end a -> Handler b v c
f = Lensed (Snaplet b) (Snaplet v) Snap c -> Handler b v c
forall b v a.
Lensed (Snaplet b) (Snaplet v) Snap a -> Handler b v a
Handler (Lensed (Snaplet b) (Snaplet v) Snap c -> Handler b v c)
-> ((ALens' (Snaplet b) (Snaplet v)
-> Snaplet v -> Snaplet b -> Snap (c, Snaplet v, Snaplet b))
-> Lensed (Snaplet b) (Snaplet v) Snap c)
-> (ALens' (Snaplet b) (Snaplet v)
-> Snaplet v -> Snaplet b -> Snap (c, Snaplet v, Snaplet b))
-> Handler b v c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ALens' (Snaplet b) (Snaplet v)
-> Snaplet v -> Snaplet b -> Snap (c, Snaplet v, Snaplet b))
-> Lensed (Snaplet b) (Snaplet v) Snap c
forall b v (m :: * -> *) a.
(ALens' b v -> v -> b -> m (a, v, b)) -> Lensed b v m a
L.Lensed ((ALens' (Snaplet b) (Snaplet v)
-> Snaplet v -> Snaplet b -> Snap (c, Snaplet v, Snaplet b))
-> Handler b v c)
-> (ALens' (Snaplet b) (Snaplet v)
-> Snaplet v -> Snaplet b -> Snap (c, Snaplet v, Snaplet b))
-> Handler b v c
forall a b. (a -> b) -> a -> b
$ \ALens' (Snaplet b) (Snaplet v)
l Snaplet v
v Snaplet b
b -> do
IO a
-> (a -> IO x)
-> (a -> Snap (c, Snaplet v, Snaplet b))
-> Snap (c, Snaplet v, Snaplet b)
forall a b c. IO a -> (a -> IO b) -> (a -> Snap c) -> Snap c
bracketSnap IO a
begin a -> IO x
end ((a -> Snap (c, Snaplet v, Snaplet b))
-> Snap (c, Snaplet v, Snaplet b))
-> (a -> Snap (c, Snaplet v, Snaplet b))
-> Snap (c, Snaplet v, Snaplet b)
forall a b. (a -> b) -> a -> b
$ \a
a -> case a -> Handler b v c
f a
a of Handler Lensed (Snaplet b) (Snaplet v) Snap c
m -> Lensed (Snaplet b) (Snaplet v) Snap c
-> ALens' (Snaplet b) (Snaplet v)
-> Snaplet v
-> Snaplet b
-> Snap (c, Snaplet v, Snaplet b)
forall b v (m :: * -> *) a.
Lensed b v m a -> ALens' b v -> v -> b -> m (a, v, b)
L.unlensed Lensed (Snaplet b) (Snaplet v) Snap c
m ALens' (Snaplet b) (Snaplet v)
l Snaplet v
v Snaplet b
b
data InitializerState b = InitializerState
{ forall b. InitializerState b -> Bool
_isTopLevel :: Bool
, forall b. InitializerState b -> IORef (IO ())
_cleanup :: IORef (IO ())
, forall b. InitializerState b -> [(ByteString, Handler b b ())]
_handlers :: [(ByteString, Handler b b ())]
, forall b. InitializerState b -> Handler b b () -> Handler b b ()
_hFilter :: Handler b b () -> Handler b b ()
, forall b. InitializerState b -> SnapletConfig
_curConfig :: SnapletConfig
, forall b. InitializerState b -> IORef Text
_initMessages :: IORef Text
, forall b. InitializerState b -> FilePath
_environment :: String
, forall b. InitializerState b -> (Snaplet b -> Snaplet b) -> IO ()
masterReloader :: (Snaplet b -> Snaplet b) -> IO ()
}
newtype Hook a = Hook (Snaplet a -> IO (Either Text (Snaplet a)))
instance Semigroup (Hook a) where
Hook Snaplet a -> IO (Either Text (Snaplet a))
a <> :: Hook a -> Hook a -> Hook a
<> Hook Snaplet a -> IO (Either Text (Snaplet a))
b = (Snaplet a -> IO (Either Text (Snaplet a))) -> Hook a
forall a. (Snaplet a -> IO (Either Text (Snaplet a))) -> Hook a
Hook ((Snaplet a -> IO (Either Text (Snaplet a))) -> Hook a)
-> (Snaplet a -> IO (Either Text (Snaplet a))) -> Hook a
forall a b. (a -> b) -> a -> b
$ \Snaplet a
s -> do
Either Text (Snaplet a)
ea <- Snaplet a -> IO (Either Text (Snaplet a))
a Snaplet a
s
case Either Text (Snaplet a)
ea of
Left Text
e -> Either Text (Snaplet a) -> IO (Either Text (Snaplet a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Snaplet a) -> IO (Either Text (Snaplet a)))
-> Either Text (Snaplet a) -> IO (Either Text (Snaplet a))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Snaplet a)
forall a b. a -> Either a b
Left Text
e
Right Snaplet a
ares -> do
Either Text (Snaplet a)
eb <- Snaplet a -> IO (Either Text (Snaplet a))
b Snaplet a
ares
case Either Text (Snaplet a)
eb of
Left Text
e -> Either Text (Snaplet a) -> IO (Either Text (Snaplet a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Snaplet a) -> IO (Either Text (Snaplet a)))
-> Either Text (Snaplet a) -> IO (Either Text (Snaplet a))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Snaplet a)
forall a b. a -> Either a b
Left Text
e
Right Snaplet a
bres -> Either Text (Snaplet a) -> IO (Either Text (Snaplet a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Snaplet a) -> IO (Either Text (Snaplet a)))
-> Either Text (Snaplet a) -> IO (Either Text (Snaplet a))
forall a b. (a -> b) -> a -> b
$ Snaplet a -> Either Text (Snaplet a)
forall a b. b -> Either a b
Right Snaplet a
bres
instance Monoid (Hook a) where
mempty :: Hook a
mempty = (Snaplet a -> IO (Either Text (Snaplet a))) -> Hook a
forall a. (Snaplet a -> IO (Either Text (Snaplet a))) -> Hook a
Hook (Either Text (Snaplet a) -> IO (Either Text (Snaplet a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Snaplet a) -> IO (Either Text (Snaplet a)))
-> (Snaplet a -> Either Text (Snaplet a))
-> Snaplet a
-> IO (Either Text (Snaplet a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Snaplet a -> Either Text (Snaplet a)
forall a b. b -> Either a b
Right)
#if !MIN_VERSION_base(4,11,0)
mappend = (<>)
#endif
newtype Initializer b v a =
Initializer (LT.LensT (Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a)
deriving (Functor (Initializer b v)
Functor (Initializer b v)
-> (forall a. a -> Initializer b v a)
-> (forall a b.
Initializer b v (a -> b) -> Initializer b v a -> Initializer b v b)
-> (forall a b c.
(a -> b -> c)
-> Initializer b v a -> Initializer b v b -> Initializer b v c)
-> (forall a b.
Initializer b v a -> Initializer b v b -> Initializer b v b)
-> (forall a b.
Initializer b v a -> Initializer b v b -> Initializer b v a)
-> Applicative (Initializer b v)
forall a. a -> Initializer b v a
forall {b} {v}. Functor (Initializer b v)
forall a b.
Initializer b v a -> Initializer b v b -> Initializer b v a
forall a b.
Initializer b v a -> Initializer b v b -> Initializer b v b
forall a b.
Initializer b v (a -> b) -> Initializer b v a -> Initializer b v b
forall b v a. a -> Initializer b v a
forall a b c.
(a -> b -> c)
-> Initializer b v a -> Initializer b v b -> Initializer b v c
forall b v a b.
Initializer b v a -> Initializer b v b -> Initializer b v a
forall b v a b.
Initializer b v a -> Initializer b v b -> Initializer b v b
forall b v a b.
Initializer b v (a -> b) -> Initializer b v a -> Initializer b v b
forall b v a b c.
(a -> b -> c)
-> Initializer b v a -> Initializer b v b -> Initializer b v c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall b v a. a -> Initializer b v a
pure :: forall a. a -> Initializer b v a
$c<*> :: forall b v a b.
Initializer b v (a -> b) -> Initializer b v a -> Initializer b v b
<*> :: forall a b.
Initializer b v (a -> b) -> Initializer b v a -> Initializer b v b
$cliftA2 :: forall b v a b c.
(a -> b -> c)
-> Initializer b v a -> Initializer b v b -> Initializer b v c
liftA2 :: forall a b c.
(a -> b -> c)
-> Initializer b v a -> Initializer b v b -> Initializer b v c
$c*> :: forall b v a b.
Initializer b v a -> Initializer b v b -> Initializer b v b
*> :: forall a b.
Initializer b v a -> Initializer b v b -> Initializer b v b
$c<* :: forall b v a b.
Initializer b v a -> Initializer b v b -> Initializer b v a
<* :: forall a b.
Initializer b v a -> Initializer b v b -> Initializer b v a
Applicative, (forall a b. (a -> b) -> Initializer b v a -> Initializer b v b)
-> (forall a b. a -> Initializer b v b -> Initializer b v a)
-> Functor (Initializer b v)
forall a b. a -> Initializer b v b -> Initializer b v a
forall a b. (a -> b) -> Initializer b v a -> Initializer b v b
forall b v a b. a -> Initializer b v b -> Initializer b v a
forall b v a b. (a -> b) -> Initializer b v a -> Initializer b v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall b v a b. (a -> b) -> Initializer b v a -> Initializer b v b
fmap :: forall a b. (a -> b) -> Initializer b v a -> Initializer b v b
$c<$ :: forall b v a b. a -> Initializer b v b -> Initializer b v a
<$ :: forall a b. a -> Initializer b v b -> Initializer b v a
Functor, Applicative (Initializer b v)
Applicative (Initializer b v)
-> (forall a b.
Initializer b v a -> (a -> Initializer b v b) -> Initializer b v b)
-> (forall a b.
Initializer b v a -> Initializer b v b -> Initializer b v b)
-> (forall a. a -> Initializer b v a)
-> Monad (Initializer b v)
forall a. a -> Initializer b v a
forall b v. Applicative (Initializer b v)
forall a b.
Initializer b v a -> Initializer b v b -> Initializer b v b
forall a b.
Initializer b v a -> (a -> Initializer b v b) -> Initializer b v b
forall b v a. a -> Initializer b v a
forall b v a b.
Initializer b v a -> Initializer b v b -> Initializer b v b
forall b v a b.
Initializer b v a -> (a -> Initializer b v b) -> Initializer b v b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall b v a b.
Initializer b v a -> (a -> Initializer b v b) -> Initializer b v b
>>= :: forall a b.
Initializer b v a -> (a -> Initializer b v b) -> Initializer b v b
$c>> :: forall b v a b.
Initializer b v a -> Initializer b v b -> Initializer b v b
>> :: forall a b.
Initializer b v a -> Initializer b v b -> Initializer b v b
$creturn :: forall b v a. a -> Initializer b v a
return :: forall a. a -> Initializer b v a
Monad, Monad (Initializer b v)
Monad (Initializer b v)
-> (forall a. IO a -> Initializer b v a)
-> MonadIO (Initializer b v)
forall a. IO a -> Initializer b v a
forall b v. Monad (Initializer b v)
forall b v a. IO a -> Initializer b v a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall b v a. IO a -> Initializer b v a
liftIO :: forall a. IO a -> Initializer b v a
MonadIO)
makeLenses ''InitializerState
instance MonadSnaplet Initializer where
getLens :: forall b v. Initializer b v (SnapletLens (Snaplet b) v)
getLens = LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
(SnapletLens (Snaplet b) v)
-> Initializer b v (SnapletLens (Snaplet b) v)
forall b v a.
LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
-> Initializer b v a
Initializer LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
(SnapletLens (Snaplet b) v)
forall r (m :: * -> *). MonadReader r m => m r
ask
with' :: forall v v' b a.
SnapletLens (Snaplet v) v'
-> Initializer b v' a -> Initializer b v a
with' !SnapletLens (Snaplet v) v'
l (Initializer !LensT
(Snaplet b)
(Snaplet v')
(InitializerState b)
(WriterT (Hook b) IO)
a
m) = LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
-> Initializer b v a
forall b v a.
LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
-> Initializer b v a
Initializer (LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
-> Initializer b v a)
-> LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
-> Initializer b v a
forall a b. (a -> b) -> a -> b
$ SnapletLens (Snaplet v) v'
-> LensT
(Snaplet b)
(Snaplet v')
(InitializerState b)
(WriterT (Hook b) IO)
a
-> LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
forall (m :: * -> *) v v' b s a.
Monad m =>
ALens' v v' -> LensT b v' s m a -> LensT b v s m a
LT.with SnapletLens (Snaplet v) v'
l LensT
(Snaplet b)
(Snaplet v')
(InitializerState b)
(WriterT (Hook b) IO)
a
m
withTop' :: forall b v' a v.
SnapletLens (Snaplet b) v'
-> Initializer b v' a -> Initializer b v a
withTop' !SnapletLens (Snaplet b) v'
l (Initializer LensT
(Snaplet b)
(Snaplet v')
(InitializerState b)
(WriterT (Hook b) IO)
a
m) = LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
-> Initializer b v a
forall b v a.
LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
-> Initializer b v a
Initializer (LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
-> Initializer b v a)
-> LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
-> Initializer b v a
forall a b. (a -> b) -> a -> b
$ SnapletLens (Snaplet b) v'
-> LensT
(Snaplet b)
(Snaplet v')
(InitializerState b)
(WriterT (Hook b) IO)
a
-> LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
forall (m :: * -> *) b v' s a v.
Monad m =>
ALens' b v' -> LensT b v' s m a -> LensT b v s m a
LT.withTop SnapletLens (Snaplet b) v'
l LensT
(Snaplet b)
(Snaplet v')
(InitializerState b)
(WriterT (Hook b) IO)
a
m
getOpaqueConfig :: forall b v. Initializer b v SnapletConfig
getOpaqueConfig = LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
SnapletConfig
-> Initializer b v SnapletConfig
forall b v a.
LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
a
-> Initializer b v a
Initializer (LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
SnapletConfig
-> Initializer b v SnapletConfig)
-> LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
SnapletConfig
-> Initializer b v SnapletConfig
forall a b. (a -> b) -> a -> b
$ (InitializerState b -> SnapletConfig)
-> LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
(InitializerState b)
-> LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
SnapletConfig
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM InitializerState b -> SnapletConfig
forall b. InitializerState b -> SnapletConfig
_curConfig LensT
(Snaplet b)
(Snaplet v)
(InitializerState b)
(WriterT (Hook b) IO)
(InitializerState b)
forall (m :: * -> *) b v s. Monad m => LensT b v s m s
LT.getBase
newtype SnapletInit b v = SnapletInit (Initializer b v (Snaplet v))