{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Snap.Restful
(
addResource
, addResourceRelative
, initRest
, resourceSplices
, itemSplices
, resourceCSplices
, itemCSplices
, itemCSplice
, unitLens
, resourceRouter
, resourceRoutes
, CRUD (..)
, Resource (..)
, DBId (..)
, HasFormlet (..)
, PrimSplice (..)
, iPrimText
, iPrimShow
, cPrimShow
, rootPath
, indexPath
, createPath
, showPath
, newPath
, editPath
, updatePath
, destroyPath
, itemActionPath
, templatePath
, redirToItem
, relativeRedirect
, setFormAction
, getFormAction
) where
import Blaze.ByteString.Builder
import qualified Blaze.ByteString.Builder.Char8 as Build
import Control.Applicative
import Control.Arrow
import Control.Error hiding (bool)
import Control.Lens
import Control.Monad
import Control.Monad.Trans
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Char (toUpper)
import Data.Default
import Data.Int
import qualified Data.Map as M
import qualified Data.Map.Syntax as MS
import Data.Monoid
import Data.Readable
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time
import qualified Data.Time.Locale.Compat as LC
import Data.Typeable
import Data.Word
import Heist hiding (Error)
import qualified Heist.Compiled as C
import qualified Heist.Interpreted as I
import Snap.Core
import Snap.Extras.CoreUtils
import Snap.Snaplet
import Snap.Snaplet.Heist
import System.Locale
import Text.Digestive
import qualified Text.XmlHtml as X
data CRUD = RIndex
| RShow
| RNew
| REdit
| RCreate
| RUpdate
| RDestroy
deriving (CRUD -> CRUD -> Bool
(CRUD -> CRUD -> Bool) -> (CRUD -> CRUD -> Bool) -> Eq CRUD
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CRUD -> CRUD -> Bool
$c/= :: CRUD -> CRUD -> Bool
== :: CRUD -> CRUD -> Bool
$c== :: CRUD -> CRUD -> Bool
Eq,Int -> CRUD -> ShowS
[CRUD] -> ShowS
CRUD -> String
(Int -> CRUD -> ShowS)
-> (CRUD -> String) -> ([CRUD] -> ShowS) -> Show CRUD
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CRUD] -> ShowS
$cshowList :: [CRUD] -> ShowS
show :: CRUD -> String
$cshow :: CRUD -> String
showsPrec :: Int -> CRUD -> ShowS
$cshowsPrec :: Int -> CRUD -> ShowS
Show,ReadPrec [CRUD]
ReadPrec CRUD
Int -> ReadS CRUD
ReadS [CRUD]
(Int -> ReadS CRUD)
-> ReadS [CRUD] -> ReadPrec CRUD -> ReadPrec [CRUD] -> Read CRUD
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CRUD]
$creadListPrec :: ReadPrec [CRUD]
readPrec :: ReadPrec CRUD
$creadPrec :: ReadPrec CRUD
readList :: ReadS [CRUD]
$creadList :: ReadS [CRUD]
readsPrec :: Int -> ReadS CRUD
$creadsPrec :: Int -> ReadS CRUD
Read,Eq CRUD
Eq CRUD
-> (CRUD -> CRUD -> Ordering)
-> (CRUD -> CRUD -> Bool)
-> (CRUD -> CRUD -> Bool)
-> (CRUD -> CRUD -> Bool)
-> (CRUD -> CRUD -> Bool)
-> (CRUD -> CRUD -> CRUD)
-> (CRUD -> CRUD -> CRUD)
-> Ord CRUD
CRUD -> CRUD -> Bool
CRUD -> CRUD -> Ordering
CRUD -> CRUD -> CRUD
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CRUD -> CRUD -> CRUD
$cmin :: CRUD -> CRUD -> CRUD
max :: CRUD -> CRUD -> CRUD
$cmax :: CRUD -> CRUD -> CRUD
>= :: CRUD -> CRUD -> Bool
$c>= :: CRUD -> CRUD -> Bool
> :: CRUD -> CRUD -> Bool
$c> :: CRUD -> CRUD -> Bool
<= :: CRUD -> CRUD -> Bool
$c<= :: CRUD -> CRUD -> Bool
< :: CRUD -> CRUD -> Bool
$c< :: CRUD -> CRUD -> Bool
compare :: CRUD -> CRUD -> Ordering
$ccompare :: CRUD -> CRUD -> Ordering
$cp1Ord :: Eq CRUD
Ord)
newtype DBId = DBId { DBId -> Word64
unDBId :: Word64 }
deriving (DBId -> DBId -> Bool
(DBId -> DBId -> Bool) -> (DBId -> DBId -> Bool) -> Eq DBId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DBId -> DBId -> Bool
$c/= :: DBId -> DBId -> Bool
== :: DBId -> DBId -> Bool
$c== :: DBId -> DBId -> Bool
Eq,Int -> DBId -> ShowS
[DBId] -> ShowS
DBId -> String
(Int -> DBId -> ShowS)
-> (DBId -> String) -> ([DBId] -> ShowS) -> Show DBId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DBId] -> ShowS
$cshowList :: [DBId] -> ShowS
show :: DBId -> String
$cshow :: DBId -> String
showsPrec :: Int -> DBId -> ShowS
$cshowsPrec :: Int -> DBId -> ShowS
Show,ReadPrec [DBId]
ReadPrec DBId
Int -> ReadS DBId
ReadS [DBId]
(Int -> ReadS DBId)
-> ReadS [DBId] -> ReadPrec DBId -> ReadPrec [DBId] -> Read DBId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DBId]
$creadListPrec :: ReadPrec [DBId]
readPrec :: ReadPrec DBId
$creadPrec :: ReadPrec DBId
readList :: ReadS [DBId]
$creadList :: ReadS [DBId]
readsPrec :: Int -> ReadS DBId
$creadsPrec :: Int -> ReadS DBId
Read,Eq DBId
Eq DBId
-> (DBId -> DBId -> Ordering)
-> (DBId -> DBId -> Bool)
-> (DBId -> DBId -> Bool)
-> (DBId -> DBId -> Bool)
-> (DBId -> DBId -> Bool)
-> (DBId -> DBId -> DBId)
-> (DBId -> DBId -> DBId)
-> Ord DBId
DBId -> DBId -> Bool
DBId -> DBId -> Ordering
DBId -> DBId -> DBId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DBId -> DBId -> DBId
$cmin :: DBId -> DBId -> DBId
max :: DBId -> DBId -> DBId
$cmax :: DBId -> DBId -> DBId
>= :: DBId -> DBId -> Bool
$c>= :: DBId -> DBId -> Bool
> :: DBId -> DBId -> Bool
$c> :: DBId -> DBId -> Bool
<= :: DBId -> DBId -> Bool
$c<= :: DBId -> DBId -> Bool
< :: DBId -> DBId -> Bool
$c< :: DBId -> DBId -> Bool
compare :: DBId -> DBId -> Ordering
$ccompare :: DBId -> DBId -> Ordering
$cp1Ord :: Eq DBId
Ord,Integer -> DBId
DBId -> DBId
DBId -> DBId -> DBId
(DBId -> DBId -> DBId)
-> (DBId -> DBId -> DBId)
-> (DBId -> DBId -> DBId)
-> (DBId -> DBId)
-> (DBId -> DBId)
-> (DBId -> DBId)
-> (Integer -> DBId)
-> Num DBId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> DBId
$cfromInteger :: Integer -> DBId
signum :: DBId -> DBId
$csignum :: DBId -> DBId
abs :: DBId -> DBId
$cabs :: DBId -> DBId
negate :: DBId -> DBId
$cnegate :: DBId -> DBId
* :: DBId -> DBId -> DBId
$c* :: DBId -> DBId -> DBId
- :: DBId -> DBId -> DBId
$c- :: DBId -> DBId -> DBId
+ :: DBId -> DBId -> DBId
$c+ :: DBId -> DBId -> DBId
Num,Typeable)
instance Default DBId where
def :: DBId
def = Word64 -> DBId
DBId Word64
0
instance Readable DBId where fromText :: Text -> m DBId
fromText = DBId -> m DBId
forall (m :: * -> *) a. Monad m => a -> m a
return (DBId -> m DBId) -> (Word64 -> DBId) -> Word64 -> m DBId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> DBId
DBId (Word64 -> m DBId) -> (Text -> m Word64) -> Text -> m DBId
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> m Word64
forall a (m :: * -> *). (Readable a, MonadPlus m) => Text -> m a
fromText
data Resource = Resource {
Resource -> Text
rName :: Text
, Resource -> Text
rRoot :: Text
, Resource -> [Text]
rResourceEndpoints :: [Text]
, Resource -> [Text]
rItemEndpoints :: [Text]
}
instance Default Resource where
def :: Resource
def = Text -> Text -> [Text] -> [Text] -> Resource
Resource Text
"items" Text
"/items" [] []
initRest :: HasHeist b
=> Resource
-> [(CRUD, Handler b () ())]
-> [(Text, Handler b () ())]
-> [(Text, Handler b () ())]
-> Snaplet (Heist b)
-> SnapletInit b ()
initRest :: Resource
-> [(CRUD, Handler b () ())]
-> [(Text, Handler b () ())]
-> [(Text, Handler b () ())]
-> Snaplet (Heist b)
-> SnapletInit b ()
initRest Resource
res [(CRUD, Handler b () ())]
rHandlers [(Text, Handler b () ())]
rResourceActions [(Text, Handler b () ())]
rItemActions Snaplet (Heist b)
h =
Text
-> Text
-> Maybe (IO String)
-> Initializer b () ()
-> SnapletInit b ()
forall b v.
Text
-> Text
-> Maybe (IO String)
-> Initializer b v v
-> SnapletInit b v
makeSnaplet ([Text] -> Text
T.concat [Resource -> Text
rName Resource
res, Text
"-resource"])
([Text] -> Text
T.concat [Text
"RESTful resource for ", Resource -> Text
rName Resource
res])
Maybe (IO String)
forall a. Maybe a
Nothing (Initializer b () () -> SnapletInit b ())
-> Initializer b () () -> SnapletInit b ()
forall a b. (a -> b) -> a -> b
$ (Resource
-> [(CRUD, Handler b () ())]
-> [(Text, Handler b () ())]
-> [(Text, Handler b () ())]
-> [(ByteString, Handler b () ())])
-> Resource
-> [(CRUD, Handler b () ())]
-> [(Text, Handler b () ())]
-> [(Text, Handler b () ())]
-> Snaplet (Heist b)
-> Initializer b () ()
forall r s t b v.
(Resource -> r -> s -> t -> [(ByteString, Handler b v ())])
-> Resource
-> r
-> s
-> t
-> Snaplet (Heist b)
-> Initializer b v ()
addResource' Resource
-> [(CRUD, Handler b () ())]
-> [(Text, Handler b () ())]
-> [(Text, Handler b () ())]
-> [(ByteString, Handler b () ())]
forall (m :: * -> *) a.
MonadSnap m =>
Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> [(ByteString, m a)]
resourceRoutesRelative Resource
res
[(CRUD, Handler b () ())]
rHandlers [(Text, Handler b () ())]
rResourceActions [(Text, Handler b () ())]
rItemActions Snaplet (Heist b)
h
unitLens :: Lens' b ()
unitLens :: (() -> f ()) -> b -> f b
unitLens = (b -> ()) -> (b -> () -> b) -> Lens b b () ()
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (() -> b -> ()
forall a b. a -> b -> a
const ()) (\b
a () -> b
a)
addResource :: HasHeist b
=> Resource
-> [(CRUD, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(Text, Handler b v ())]
-> Snaplet (Heist b)
-> Initializer b v ()
addResource :: Resource
-> [(CRUD, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(Text, Handler b v ())]
-> Snaplet (Heist b)
-> Initializer b v ()
addResource Resource
res [(CRUD, Handler b v ())]
rHandlers [(Text, Handler b v ())]
rResourceActions [(Text, Handler b v ())]
rItemActions Snaplet (Heist b)
h = do
[(ByteString, Handler b v ())] -> Initializer b v ()
forall b v. [(ByteString, Handler b v ())] -> Initializer b v ()
addRoutes ([(ByteString, Handler b v ())] -> Initializer b v ())
-> [(ByteString, Handler b v ())] -> Initializer b v ()
forall a b. (a -> b) -> a -> b
$ [((Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Resource -> Text
rRoot Resource
res) ByteString -> ByteString -> ByteString
-/- ByteString
":id/:action", Resource -> Handler b v ()
forall b v. HasHeist b => Resource -> Handler b v ()
restfulHeistServe Resource
res)]
(Resource
-> [(CRUD, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(ByteString, Handler b v ())])
-> Resource
-> [(CRUD, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(Text, Handler b v ())]
-> Snaplet (Heist b)
-> Initializer b v ()
forall r s t b v.
(Resource -> r -> s -> t -> [(ByteString, Handler b v ())])
-> Resource
-> r
-> s
-> t
-> Snaplet (Heist b)
-> Initializer b v ()
addResource' Resource
-> [(CRUD, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(ByteString, Handler b v ())]
forall (m :: * -> *) a.
MonadSnap m =>
Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> [(ByteString, m a)]
resourceRoutes Resource
res [(CRUD, Handler b v ())]
rHandlers [(Text, Handler b v ())]
rResourceActions [(Text, Handler b v ())]
rItemActions Snaplet (Heist b)
h
addResourceRelative :: HasHeist b
=> Resource
-> [(CRUD, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(Text, Handler b v ())]
-> Snaplet (Heist b)
-> Initializer b v ()
addResourceRelative :: Resource
-> [(CRUD, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(Text, Handler b v ())]
-> Snaplet (Heist b)
-> Initializer b v ()
addResourceRelative Resource
res [(CRUD, Handler b v ())]
rHandlers [(Text, Handler b v ())]
rResourceActions [(Text, Handler b v ())]
rItemActions Snaplet (Heist b)
h = do
[(ByteString, Handler b v ())] -> Initializer b v ()
forall b v. [(ByteString, Handler b v ())] -> Initializer b v ()
addRoutes ([(ByteString, Handler b v ())] -> Initializer b v ())
-> [(ByteString, Handler b v ())] -> Initializer b v ()
forall a b. (a -> b) -> a -> b
$ [(ByteString
":id/:action", Resource -> Handler b v ()
forall b v. HasHeist b => Resource -> Handler b v ()
restfulHeistServe Resource
res)]
(Resource
-> [(CRUD, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(ByteString, Handler b v ())])
-> Resource
-> [(CRUD, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(Text, Handler b v ())]
-> Snaplet (Heist b)
-> Initializer b v ()
forall r s t b v.
(Resource -> r -> s -> t -> [(ByteString, Handler b v ())])
-> Resource
-> r
-> s
-> t
-> Snaplet (Heist b)
-> Initializer b v ()
addResource' Resource
-> [(CRUD, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(Text, Handler b v ())]
-> [(ByteString, Handler b v ())]
forall (m :: * -> *) a.
MonadSnap m =>
Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> [(ByteString, m a)]
resourceRoutesRelative Resource
res [(CRUD, Handler b v ())]
rHandlers [(Text, Handler b v ())]
rResourceActions [(Text, Handler b v ())]
rItemActions Snaplet (Heist b)
h
restfulHeistServe :: HasHeist b => Resource -> Handler b v ()
restfulHeistServe :: Resource -> Handler b v ()
restfulHeistServe Resource
res = do
Maybe ()
x <- MaybeT (Handler b v) () -> Handler b v (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (Handler b v) () -> Handler b v (Maybe ()))
-> MaybeT (Handler b v) () -> Handler b v (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
ByteString
action <- Handler b v (Maybe ByteString) -> MaybeT (Handler b v) ByteString
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Handler b v (Maybe ByteString) -> MaybeT (Handler b v) ByteString)
-> Handler b v (Maybe ByteString)
-> MaybeT (Handler b v) ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Handler b v (Maybe ByteString)
forall (m :: * -> *).
MonadSnap m =>
ByteString -> m (Maybe ByteString)
getParam ByteString
"action"
Handler b v () -> MaybeT (Handler b v) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b v () -> MaybeT (Handler b v) ())
-> Handler b v () -> MaybeT (Handler b v) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Handler b v ()
forall b v. HasHeist b => ByteString -> Handler b v ()
render (ByteString -> Handler b v ()) -> ByteString -> Handler b v ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
mkPathB [Text -> ByteString
T.encodeUtf8 (Resource -> Text
rRoot Resource
res), ByteString
action]
Handler b v ()
-> (() -> Handler b v ()) -> Maybe () -> Handler b v ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Handler b v ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero () -> Handler b v ()
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ()
x
addResource' :: (Resource -> r -> s -> t -> [(ByteString, Handler b v ())])
-> Resource
-> r
-> s
-> t
-> Snaplet (Heist b)
-> Initializer b v ()
addResource' :: (Resource -> r -> s -> t -> [(ByteString, Handler b v ())])
-> Resource
-> r
-> s
-> t
-> Snaplet (Heist b)
-> Initializer b v ()
addResource' Resource -> r -> s -> t -> [(ByteString, Handler b v ())]
f Resource
res r
rHandlers s
rResourceActions t
rItemActions Snaplet (Heist b)
h = do
[(ByteString, Handler b v ())] -> Initializer b v ()
forall b v. [(ByteString, Handler b v ())] -> Initializer b v ()
addRoutes ([(ByteString, Handler b v ())] -> Initializer b v ())
-> [(ByteString, Handler b v ())] -> Initializer b v ()
forall a b. (a -> b) -> a -> b
$ Resource -> r -> s -> t -> [(ByteString, Handler b v ())]
f Resource
res r
rHandlers s
rResourceActions t
rItemActions
Snaplet (Heist b)
-> SpliceConfig (Handler b b) -> Initializer b v ()
forall b v.
Snaplet (Heist b)
-> SpliceConfig (Handler b b) -> Initializer b v ()
addConfig Snaplet (Heist b)
h (SpliceConfig (Handler b b) -> Initializer b v ())
-> SpliceConfig (Handler b b) -> Initializer b v ()
forall a b. (a -> b) -> a -> b
$ SpliceConfig (Handler b b)
forall a. Monoid a => a
mempty SpliceConfig (Handler b b)
-> (SpliceConfig (Handler b b) -> SpliceConfig (Handler b b))
-> SpliceConfig (Handler b b)
forall a b. a -> (a -> b) -> b
& (Splices (Splice (Handler b b))
-> Identity (Splices (Splice (Handler b b))))
-> SpliceConfig (Handler b b)
-> Identity (SpliceConfig (Handler b b))
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(Splices (Splice m) -> f (Splices (Splice m)))
-> SpliceConfig m -> f (SpliceConfig m)
scInterpretedSplices ((Splices (Splice (Handler b b))
-> Identity (Splices (Splice (Handler b b))))
-> SpliceConfig (Handler b b)
-> Identity (SpliceConfig (Handler b b)))
-> Splices (Splice (Handler b b))
-> SpliceConfig (Handler b b)
-> SpliceConfig (Handler b b)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Resource -> Splices (Splice (Handler b b))
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Resource -> Splices (HeistT n m Template)
resourceSplices Resource
res
SpliceConfig (Handler b b)
-> (SpliceConfig (Handler b b) -> SpliceConfig (Handler b b))
-> SpliceConfig (Handler b b)
forall a b. a -> (a -> b) -> b
& (Splices (Splice (Handler b b))
-> Identity (Splices (Splice (Handler b b))))
-> SpliceConfig (Handler b b)
-> Identity (SpliceConfig (Handler b b))
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(Splices (Splice m) -> f (Splices (Splice m)))
-> SpliceConfig m -> f (SpliceConfig m)
scCompiledSplices ((Splices (Splice (Handler b b))
-> Identity (Splices (Splice (Handler b b))))
-> SpliceConfig (Handler b b)
-> Identity (SpliceConfig (Handler b b)))
-> Splices (Splice (Handler b b))
-> SpliceConfig (Handler b b)
-> SpliceConfig (Handler b b)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Resource -> Splices (Splice (Handler b b))
forall (m :: * -> *). MonadSnap m => Resource -> Splices (Splice m)
resourceCSplices Resource
res
resourceRoutes
:: MonadSnap m
=> Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> [(ByteString, m a)]
resourceRoutes :: Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> [(ByteString, m a)]
resourceRoutes Resource
r [(CRUD, m a)]
rHandlers [(Text, m a)]
rResourceActions [(Text, m a)]
rItemActions =
((ByteString, m a) -> (ByteString, m a))
-> [(ByteString, m a)] -> [(ByteString, m a)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> ByteString)
-> (ByteString, m a) -> (ByteString, m a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((ByteString -> ByteString)
-> (ByteString, m a) -> (ByteString, m a))
-> (ByteString -> ByteString)
-> (ByteString, m a)
-> (ByteString, m a)
forall a b. (a -> b) -> a -> b
$ (Text -> ByteString
T.encodeUtf8 (Resource -> Text
rRoot Resource
r) ByteString -> ByteString -> ByteString
-/-))
(Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> [(ByteString, m a)]
forall (m :: * -> *) a.
MonadSnap m =>
Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> [(ByteString, m a)]
resourceRoutesRelative Resource
r [(CRUD, m a)]
rHandlers [(Text, m a)]
rResourceActions [(Text, m a)]
rItemActions)
resourceRoutesRelative
:: MonadSnap m
=> Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> [(ByteString, m a)]
resourceRoutesRelative :: Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> [(ByteString, m a)]
resourceRoutesRelative Resource
r [(CRUD, m a)]
rHandlers [(Text, m a)]
rResourceActions [(Text, m a)]
rItemActions =
((CRUD, m a) -> (ByteString, m a))
-> [(CRUD, m a)] -> [(ByteString, m a)]
forall a b. (a -> b) -> [a] -> [b]
map (Resource -> (CRUD, m a) -> (ByteString, m a)
forall (m :: * -> *) a.
MonadSnap m =>
Resource -> (CRUD, m a) -> (ByteString, m a)
mkCrudRoute Resource
r) [(CRUD, m a)]
rHandlers [(ByteString, m a)] -> [(ByteString, m a)] -> [(ByteString, m a)]
forall a. [a] -> [a] -> [a]
++
((Text, m a) -> (ByteString, m a))
-> [(Text, m a)] -> [(ByteString, m a)]
forall a b. (a -> b) -> [a] -> [b]
map (Resource -> (Text, m a) -> (ByteString, m a)
forall t3. Resource -> (Text, t3) -> (ByteString, t3)
mkResourceRoute Resource
r) [(Text, m a)]
rResourceActions [(ByteString, m a)] -> [(ByteString, m a)] -> [(ByteString, m a)]
forall a. [a] -> [a] -> [a]
++
((Text, m a) -> (ByteString, m a))
-> [(Text, m a)] -> [(ByteString, m a)]
forall a b. (a -> b) -> [a] -> [b]
map (Resource -> (Text, m a) -> (ByteString, m a)
forall t3. Resource -> (Text, t3) -> (ByteString, t3)
mkItemRoute Resource
r) [(Text, m a)]
rItemActions
resourceRouter :: MonadSnap m
=> Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> m a
resourceRouter :: Resource -> [(CRUD, m a)] -> [(Text, m a)] -> [(Text, m a)] -> m a
resourceRouter Resource
r [(CRUD, m a)]
as [(Text, m a)]
bs [(Text, m a)]
cs = [(ByteString, m a)] -> m a
forall (m :: * -> *) a. MonadSnap m => [(ByteString, m a)] -> m a
route ([(ByteString, m a)] -> m a) -> [(ByteString, m a)] -> m a
forall a b. (a -> b) -> a -> b
$ Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> [(ByteString, m a)]
forall (m :: * -> *) a.
MonadSnap m =>
Resource
-> [(CRUD, m a)]
-> [(Text, m a)]
-> [(Text, m a)]
-> [(ByteString, m a)]
resourceRoutes Resource
r [(CRUD, m a)]
as [(Text, m a)]
bs [(Text, m a)]
cs
mkPath :: [Text] -> Text
mkPath :: [Text] -> Text
mkPath = Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
mkPathB :: [ByteString] -> ByteString
mkPathB :: [ByteString] -> ByteString
mkPathB = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"/" ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
mkItemRoute :: Resource -> (Text, t3) -> (ByteString, t3)
mkItemRoute :: Resource -> (Text, t3) -> (ByteString, t3)
mkItemRoute Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} (Text
actionName, t3
h) =
(Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
mkPath [Text
":id", Text
actionName], t3
h)
mkResourceRoute :: Resource -> (Text, t3) -> (ByteString, t3)
mkResourceRoute :: Resource -> (Text, t3) -> (ByteString, t3)
mkResourceRoute Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} (Text
actionName, t3
h) =
(Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
mkPath [Text
actionName], t3
h)
mkCrudRoute :: MonadSnap m
=> Resource -> (CRUD, m a) -> (ByteString, m a)
mkCrudRoute :: Resource -> (CRUD, m a) -> (ByteString, m a)
mkCrudRoute r :: Resource
r@Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} (CRUD
crud, m a
h) =
case CRUD
crud of
CRUD
RIndex -> (ByteString
"", m a -> m a
forall (m :: * -> *) a. MonadSnap m => m a -> m a
ifTop (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Method -> m a -> m a
forall (m :: * -> *) a. MonadSnap m => Method -> m a -> m a
method Method
GET m a
h)
CRUD
RCreate -> ( ByteString
"", m a -> m a
forall (m :: * -> *) a. MonadSnap m => m a -> m a
ifTop (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Method -> m a -> m a
forall (m :: * -> *) a. MonadSnap m => Method -> m a -> m a
method Method
POST (m a -> m a
forall (m :: * -> *) a. MonadSnap m => m a -> m a
setCreateAction m a
h))
CRUD
RShow -> ( ByteString
":id", m a -> m a
forall (m :: * -> *) a. MonadSnap m => m a -> m a
ifTop (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Method -> m a -> m a
forall (m :: * -> *) a. MonadSnap m => Method -> m a -> m a
method Method
GET m a
h)
CRUD
RNew -> ( ByteString
"new", m a -> m a
forall (m :: * -> *) a. MonadSnap m => m a -> m a
ifTop (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Method -> m a -> m a
forall (m :: * -> *) a. MonadSnap m => Method -> m a -> m a
method Method
GET (m a -> m a
forall (m :: * -> *) a. MonadSnap m => m a -> m a
setCreateAction m a
h))
CRUD
REdit -> ( Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
mkPath [Text
":id", Text
"edit"]
, m a -> m a
forall (m :: * -> *) a. MonadSnap m => m a -> m a
ifTop (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Method -> m a -> m a
forall (m :: * -> *) a. MonadSnap m => Method -> m a -> m a
method Method
GET (m a -> m a
forall (m :: * -> *) a. MonadSnap m => m a -> m a
setEditAction m a
h))
CRUD
RUpdate -> ( Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
mkPath [Text
":id"]
, m a -> m a
forall (m :: * -> *) a. MonadSnap m => m a -> m a
ifTop (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Method -> m a -> m a
forall (m :: * -> *) a. MonadSnap m => Method -> m a -> m a
method Method
POST (m a -> m a
forall (m :: * -> *) a. MonadSnap m => m a -> m a
setEditAction m a
h))
CRUD
RDestroy -> ( Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
mkPath [Text
":id", Text
"destroy"]
, m a -> m a
forall (m :: * -> *) a. MonadSnap m => m a -> m a
ifTop (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Method -> m a -> m a
forall (m :: * -> *) a. MonadSnap m => Method -> m a -> m a
method Method
POST m a
h)
where
setCreateAction :: m a -> m a
setCreateAction m a
h2 = Text -> m a -> m a
forall (m :: * -> *) a. MonadSnap m => Text -> m a -> m a
setFormAction (Resource -> Text
createPath Resource
r) m a
h2
setEditAction :: m b -> m b
setEditAction m b
h2 = do
Maybe ByteString
_id <- ByteString -> m (Maybe ByteString)
forall (m :: * -> *).
MonadSnap m =>
ByteString -> m (Maybe ByteString)
getParam ByteString
"id"
m b -> (Word64 -> m b) -> Maybe Word64 -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m b
h2 (\Word64
i -> Text -> m b -> m b
forall (m :: * -> *) a. MonadSnap m => Text -> m a -> m a
setFormAction (Resource -> DBId -> Text
updatePath Resource
r (Word64 -> DBId
DBId Word64
i)) m b
h2) (ByteString -> Maybe Word64
forall a (m :: * -> *).
(Readable a, MonadPlus m) =>
ByteString -> m a
fromBS (ByteString -> Maybe Word64) -> Maybe ByteString -> Maybe Word64
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<Maybe ByteString
_id)
templatePath :: Resource -> CRUD -> ByteString
templatePath :: Resource -> CRUD -> ByteString
templatePath Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} CRUD
crud =
case CRUD
crud of
CRUD
RIndex -> [ByteString] -> ByteString
mkPathB [ByteString
r, ByteString
"index"]
CRUD
RCreate -> String -> ByteString
forall a. HasCallStack => String -> a
error String
"Create action does not get a template."
CRUD
RShow -> [ByteString] -> ByteString
mkPathB [ByteString
r, ByteString
"show"]
CRUD
RNew -> [ByteString] -> ByteString
mkPathB [ByteString
r, ByteString
"new"]
CRUD
REdit -> [ByteString] -> ByteString
mkPathB [ByteString
r, ByteString
"edit"]
CRUD
RUpdate -> String -> ByteString
forall a. HasCallStack => String -> a
error String
"Update action does not get a template."
CRUD
RDestroy -> String -> ByteString
forall a. HasCallStack => String -> a
error String
"Destroy action does not get a template."
where
r :: ByteString
r = Text -> ByteString
T.encodeUtf8 Text
rRoot
resourceActionPath :: Resource -> Text -> Text
resourceActionPath :: Resource -> Text -> Text
resourceActionPath Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} Text
t = [Text] -> Text
mkPath [Text
rRoot, Text
t]
itemActionPath :: Resource -> Text -> DBId -> Text
itemActionPath :: Resource -> Text -> DBId -> Text
itemActionPath Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} Text
t DBId{Word64
unDBId :: Word64
unDBId :: DBId -> Word64
..} =
[Text] -> Text
mkPath [Text
rRoot, Word64 -> Text
forall a. Show a => a -> Text
showT Word64
unDBId, Text
t]
indexPath :: Resource -> Text
indexPath :: Resource -> Text
indexPath Resource
r = Resource -> Text
rRoot Resource
r
createPath :: Resource -> Text
createPath :: Resource -> Text
createPath Resource
r = Resource -> Text
rRoot Resource
r
newPath :: Resource -> Text
newPath :: Resource -> Text
newPath Resource
r = [Text] -> Text
mkPath [Resource -> Text
rRoot Resource
r, Text
"new"]
rootPath :: Resource -> Text
rootPath :: Resource -> Text
rootPath = Resource -> Text
indexPath
editPath :: Resource -> DBId -> Text
editPath :: Resource -> DBId -> Text
editPath Resource
r (DBId Word64
_id) = [Text] -> Text
mkPath [Resource -> Text
rRoot Resource
r, Word64 -> Text
forall a. Show a => a -> Text
showT Word64
_id, Text
"edit"]
showPath :: Resource -> DBId -> Text
showPath :: Resource -> DBId -> Text
showPath Resource
r (DBId Word64
_id) = [Text] -> Text
mkPath [Resource -> Text
rRoot Resource
r, Word64 -> Text
forall a. Show a => a -> Text
showT Word64
_id]
updatePath :: Resource -> DBId -> Text
updatePath :: Resource -> DBId -> Text
updatePath Resource
r (DBId Word64
_id) = [Text] -> Text
mkPath [Resource -> Text
rRoot Resource
r, Word64 -> Text
forall a. Show a => a -> Text
showT Word64
_id]
destroyPath :: Resource -> DBId -> Text
destroyPath :: Resource -> DBId -> Text
destroyPath Resource
r (DBId Word64
_id) = [Text] -> Text
mkPath [Resource -> Text
rRoot Resource
r, Word64 -> Text
forall a. Show a => a -> Text
showT Word64
_id, Text
"destroy"]
setFormAction :: MonadSnap m => Text -> m a -> m a
setFormAction :: Text -> m a -> m a
setFormAction Text
a = (Request -> Request) -> m a -> m a
forall (m :: * -> *) a.
MonadSnap m =>
(Request -> Request) -> m a -> m a
localRequest Request -> Request
f
where
f :: Request -> Request
f Request
req = Request
req { rqParams :: Params
rqParams = ByteString -> [ByteString] -> Params -> Params
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ByteString
"RESTFormAction" [Text -> ByteString
T.encodeUtf8 Text
a]
(Request -> Params
rqParams Request
req) }
getFormAction :: MonadSnap m => HeistT n m [X.Node]
getFormAction :: HeistT n m Template
getFormAction = do
Maybe ByteString
p <- m (Maybe ByteString) -> HeistT n m (Maybe ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe ByteString) -> HeistT n m (Maybe ByteString))
-> m (Maybe ByteString) -> HeistT n m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> m (Maybe ByteString)
forall (m :: * -> *).
MonadSnap m =>
ByteString -> m (Maybe ByteString)
getParam ByteString
"RESTFormAction"
HeistT n m Template
-> (ByteString -> HeistT n m Template)
-> Maybe ByteString
-> HeistT n m Template
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Template -> HeistT n m Template
forall (m :: * -> *) a. Monad m => a -> m a
return []) (Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template)
-> (ByteString -> Text) -> ByteString -> HeistT n m Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8) Maybe ByteString
p
resourceSplices :: Monad m => Resource -> Splices (HeistT n m Template)
resourceSplices :: Resource -> Splices (HeistT n m Template)
resourceSplices r :: Resource
r@Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} =
[Splices (HeistT n m Template)] -> Splices (HeistT n m Template)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ((Text -> Splices (HeistT n m Template))
-> [Text] -> [Splices (HeistT n m Template)]
forall a b. (a -> b) -> [a] -> [b]
map (Resource -> Text -> Splices (HeistT n m Template)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Resource -> Text -> Splices (HeistT n m Template)
mkResourceActionSplice Resource
r) [Text]
rResourceEndpoints) Splices (HeistT n m Template)
-> Splices (HeistT n m Template) -> Splices (HeistT n m Template)
forall a. Monoid a => a -> a -> a
`mappend` Splices (HeistT n m Template)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
MapSyntaxM Text (HeistT n m Template) ()
a
where
a :: MapSyntaxM Text (HeistT n m Template) ()
a = do
[Text] -> Text
T.concat [Text
rName, Text
"NewPath"] Text
-> HeistT n m Template -> MapSyntaxM Text (HeistT n m Template) ()
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> Text
newPath Resource
r
[Text] -> Text
T.concat [Text
rName, Text
"IndexPath"] Text
-> HeistT n m Template -> MapSyntaxM Text (HeistT n m Template) ()
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> Text
indexPath Resource
r
[Text] -> Text
T.concat [Text
rName, Text
"CreatePath"] Text
-> HeistT n m Template -> MapSyntaxM Text (HeistT n m Template) ()
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> Text
createPath Resource
r
[Text] -> Text
T.concat [Text
rName, Text
"Path"] Text
-> HeistT n m Template -> MapSyntaxM Text (HeistT n m Template) ()
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> Text
rootPath Resource
r
itemSplices :: Monad m => Resource -> DBId -> Splices (I.Splice m)
itemSplices :: Resource -> DBId -> Splices (Splice m)
itemSplices r :: Resource
r@Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} DBId
dbid =
[Splices (Splice m)] -> Splices (Splice m)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ((Text -> Splices (Splice m)) -> [Text] -> [Splices (Splice m)]
forall a b. (a -> b) -> [a] -> [b]
map (Resource -> DBId -> Text -> Splices (Splice m)
forall (m :: * -> *).
Monad m =>
Resource -> DBId -> Text -> Splices (Splice m)
mkItemActionSplice Resource
r DBId
dbid) [Text]
rItemEndpoints) Splices (Splice m) -> Splices (Splice m) -> Splices (Splice m)
forall a. Monoid a => a -> a -> a
`mappend` Splices (Splice m)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
MapSyntaxM Text (HeistT n m Template) ()
a
where
a :: MapSyntaxM Text (HeistT n m Template) ()
a = do
[Text] -> Text
T.concat [Text
rName, Text
"ItemEditPath"] Text
-> HeistT n m Template -> MapSyntaxM Text (HeistT n m Template) ()
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> DBId -> Text
editPath Resource
r DBId
dbid
[Text] -> Text
T.concat [Text
rName, Text
"ItemShowPath"] Text
-> HeistT n m Template -> MapSyntaxM Text (HeistT n m Template) ()
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> DBId -> Text
showPath Resource
r DBId
dbid
[Text] -> Text
T.concat [Text
rName, Text
"ItemUpdatePath"] Text
-> HeistT n m Template -> MapSyntaxM Text (HeistT n m Template) ()
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> DBId -> Text
updatePath Resource
r DBId
dbid
[Text] -> Text
T.concat [Text
rName, Text
"ItemDestroyPath"] Text
-> HeistT n m Template -> MapSyntaxM Text (HeistT n m Template) ()
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> DBId -> Text
destroyPath Resource
r DBId
dbid
[Text] -> Text
T.concat [Text
rName, Text
"ItemNewPath"] Text
-> HeistT n m Template -> MapSyntaxM Text (HeistT n m Template) ()
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> Text
newPath Resource
r
[Text] -> Text
T.concat [Text
rName, Text
"ItemIndexPath"] Text
-> HeistT n m Template -> MapSyntaxM Text (HeistT n m Template) ()
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> Text
indexPath Resource
r
[Text] -> Text
T.concat [Text
rName, Text
"ItemCreatePath"] Text
-> HeistT n m Template -> MapSyntaxM Text (HeistT n m Template) ()
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> Text
createPath Resource
r
resourceCSplices :: MonadSnap m => Resource -> Splices (C.Splice m)
resourceCSplices :: Resource -> Splices (Splice m)
resourceCSplices Resource
r = (HeistT m IO Template -> Splice m)
-> MapSyntaxM Text (HeistT m IO Template) () -> Splices (Splice m)
forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
MS.mapV (Template -> Splice m
forall (n :: * -> *). Monad n => Template -> Splice n
C.runNodeList (Template -> Splice m) -> HeistT m IO Template -> Splice m
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (MapSyntaxM Text (HeistT m IO Template) () -> Splices (Splice m))
-> MapSyntaxM Text (HeistT m IO Template) () -> Splices (Splice m)
forall a b. (a -> b) -> a -> b
$ Resource -> MapSyntaxM Text (HeistT m IO Template) ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Resource -> Splices (HeistT n m Template)
resourceSplices Resource
r
itemCSplices :: Resource -> Splices (Maybe DBId -> Text)
itemCSplices :: Resource -> Splices (Maybe DBId -> Text)
itemCSplices r :: Resource
r@Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} = Splices (Maybe DBId -> Text)
a Splices (Maybe DBId -> Text)
-> Splices (Maybe DBId -> Text) -> Splices (Maybe DBId -> Text)
forall a. Monoid a => a -> a -> a
`mappend` Splices (Maybe DBId -> Text)
forall b. MapSyntax Text (b -> Text)
b Splices (Maybe DBId -> Text)
-> Splices (Maybe DBId -> Text) -> Splices (Maybe DBId -> Text)
forall a. Monoid a => a -> a -> a
`mappend` Splices (Maybe DBId -> Text)
c
where
a :: Splices (Maybe DBId -> Text)
a = do
[Text] -> Text
T.concat [Text
rName, Text
"ItemEditPath"] Text -> (Maybe DBId -> Text) -> Splices (Maybe DBId -> Text)
forall k v. k -> v -> MapSyntax k v
MS.## Text -> (DBId -> Text) -> Maybe DBId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Resource -> DBId -> Text
editPath Resource
r)
[Text] -> Text
T.concat [Text
rName, Text
"ItemShowPath"] Text -> (Maybe DBId -> Text) -> Splices (Maybe DBId -> Text)
forall k v. k -> v -> MapSyntax k v
MS.## Text -> (DBId -> Text) -> Maybe DBId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Resource -> DBId -> Text
showPath Resource
r)
[Text] -> Text
T.concat [Text
rName, Text
"ItemUpdatePath"] Text -> (Maybe DBId -> Text) -> Splices (Maybe DBId -> Text)
forall k v. k -> v -> MapSyntax k v
MS.## Text -> (DBId -> Text) -> Maybe DBId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Resource -> DBId -> Text
updatePath Resource
r)
[Text] -> Text
T.concat [Text
rName, Text
"ItemDestroyPath"] Text -> (Maybe DBId -> Text) -> Splices (Maybe DBId -> Text)
forall k v. k -> v -> MapSyntax k v
MS.## Text -> (DBId -> Text) -> Maybe DBId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Resource -> DBId -> Text
destroyPath Resource
r)
b :: MapSyntax Text (b -> Text)
b = (Text -> b -> Text)
-> MapSyntaxM Text Text () -> MapSyntax Text (b -> Text)
forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
MS.mapV Text -> b -> Text
forall a b. a -> b -> a
const (MapSyntaxM Text Text () -> MapSyntax Text (b -> Text))
-> MapSyntaxM Text Text () -> MapSyntax Text (b -> Text)
forall a b. (a -> b) -> a -> b
$ do
[Text] -> Text
T.concat [Text
rName, Text
"ItemNewPath"] Text -> Text -> MapSyntaxM Text Text ()
forall k v. k -> v -> MapSyntax k v
MS.## Resource -> Text
newPath Resource
r
[Text] -> Text
T.concat [Text
rName, Text
"ItemIndexPath"] Text -> Text -> MapSyntaxM Text Text ()
forall k v. k -> v -> MapSyntax k v
MS.## Resource -> Text
indexPath Resource
r
[Text] -> Text
T.concat [Text
rName, Text
"ItemCreatePath"] Text -> Text -> MapSyntaxM Text Text ()
forall k v. k -> v -> MapSyntax k v
MS.## Resource -> Text
createPath Resource
r
c :: Splices (Maybe DBId -> Text)
c = [Splices (Maybe DBId -> Text)] -> Splices (Maybe DBId -> Text)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Splices (Maybe DBId -> Text)] -> Splices (Maybe DBId -> Text))
-> [Splices (Maybe DBId -> Text)] -> Splices (Maybe DBId -> Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Splices (Maybe DBId -> Text))
-> [Text] -> [Splices (Maybe DBId -> Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Resource -> Text -> Splices (Maybe DBId -> Text)
mkItemActionCSplice Resource
r) [Text]
rItemEndpoints
itemCSplice :: Resource -> Splice n
itemCSplice Resource
r =
Splice n
-> Splices (RuntimeSplice n (Maybe DBId) -> Splice n)
-> RuntimeSplice n (Maybe DBId)
-> Splice n
forall (n :: * -> *) a.
Monad n =>
Splice n
-> Splices (RuntimeSplice n a -> Splice n)
-> RuntimeSplice n a
-> Splice n
C.withSplices Splice n
forall (n :: * -> *). Monad n => Splice n
C.runChildren (((Maybe DBId -> Text) -> RuntimeSplice n (Maybe DBId) -> Splice n)
-> Splices (Maybe DBId -> Text)
-> Splices (RuntimeSplice n (Maybe DBId) -> Splice n)
forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
MS.mapV ((Maybe DBId -> Builder) -> RuntimeSplice n (Maybe DBId) -> Splice n
forall (n :: * -> *) a.
Monad n =>
(a -> Builder) -> RuntimeSplice n a -> Splice n
C.pureSplice ((Maybe DBId -> Builder)
-> RuntimeSplice n (Maybe DBId) -> Splice n)
-> ((Maybe DBId -> Text) -> Maybe DBId -> Builder)
-> (Maybe DBId -> Text)
-> RuntimeSplice n (Maybe DBId)
-> Splice n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe DBId -> Text) -> Maybe DBId -> Builder
forall a. (a -> Text) -> a -> Builder
C.textSplice) (Splices (Maybe DBId -> Text)
-> Splices (RuntimeSplice n (Maybe DBId) -> Splice n))
-> Splices (Maybe DBId -> Text)
-> Splices (RuntimeSplice n (Maybe DBId) -> Splice n)
forall a b. (a -> b) -> a -> b
$ Resource -> Splices (Maybe DBId -> Text)
itemCSplices Resource
r) (RuntimeSplice n (Maybe DBId) -> Splice n)
-> RuntimeSplice n (Maybe DBId) -> Splice n
forall a b. (a -> b) -> a -> b
$ do
Maybe ByteString
mid <- n (Maybe ByteString) -> RuntimeSplice n (Maybe ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n (Maybe ByteString) -> RuntimeSplice n (Maybe ByteString))
-> n (Maybe ByteString) -> RuntimeSplice n (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> n (Maybe ByteString)
forall (m :: * -> *).
MonadSnap m =>
ByteString -> m (Maybe ByteString)
getParam ByteString
"id"
Maybe DBId -> RuntimeSplice n (Maybe DBId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DBId -> RuntimeSplice n (Maybe DBId))
-> Maybe DBId -> RuntimeSplice n (Maybe DBId)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe DBId
forall a (m :: * -> *).
(Readable a, MonadPlus m) =>
ByteString -> m a
fromBS (ByteString -> Maybe DBId) -> Maybe ByteString -> Maybe DBId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ByteString
mid
mkItemActionSplice :: Monad m
=> Resource -> DBId -> Text -> Splices (I.Splice m)
mkItemActionSplice :: Resource -> DBId -> Text -> Splices (Splice m)
mkItemActionSplice r :: Resource
r@Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} DBId
dbid Text
t =
[Text] -> Text
T.concat [Text
rName, Text
"Item", Text -> Text
cap Text
t, Text
"Path"] Text -> Splice m -> Splices (Splice m)
forall k v. k -> v -> MapSyntax k v
MS.## Text -> Splice m
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> Splice m) -> Text -> Splice m
forall a b. (a -> b) -> a -> b
$ Resource -> Text -> DBId -> Text
itemActionPath Resource
r Text
t DBId
dbid
mkResourceActionSplice :: Monad m => Resource -> Text -> Splices (HeistT n m Template)
mkResourceActionSplice :: Resource -> Text -> Splices (HeistT n m Template)
mkResourceActionSplice r :: Resource
r@Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} Text
t =
[Text] -> Text
T.concat [Text
rName, Text -> Text
cap Text
t, Text
"Path"] Text -> HeistT n m Template -> Splices (HeistT n m Template)
forall k v. k -> v -> MapSyntax k v
MS.## Text -> HeistT n m Template
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m Template
I.textSplice (Text -> HeistT n m Template) -> Text -> HeistT n m Template
forall a b. (a -> b) -> a -> b
$ Resource -> Text -> Text
resourceActionPath Resource
r Text
t
mkItemActionCSplice :: Resource -> Text -> Splices (Maybe DBId -> Text)
mkItemActionCSplice :: Resource -> Text -> Splices (Maybe DBId -> Text)
mkItemActionCSplice r :: Resource
r@Resource{[Text]
Text
rItemEndpoints :: [Text]
rResourceEndpoints :: [Text]
rRoot :: Text
rName :: Text
rItemEndpoints :: Resource -> [Text]
rResourceEndpoints :: Resource -> [Text]
rRoot :: Resource -> Text
rName :: Resource -> Text
..} Text
t =
[Text] -> Text
T.concat [Text
rName, Text
"Item", Text -> Text
cap Text
t, Text
"Path"] Text -> (Maybe DBId -> Text) -> Splices (Maybe DBId -> Text)
forall k v. k -> v -> MapSyntax k v
MS.## Text -> (DBId -> Text) -> Maybe DBId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (Resource -> Text -> DBId -> Text
itemActionPath Resource
r Text
t)
redirToItem :: MonadSnap m => Resource -> DBId -> m a
redirToItem :: Resource -> DBId -> m a
redirToItem Resource
r DBId
dbid = ByteString -> m a
forall (m :: * -> *) a. MonadSnap m => ByteString -> m a
redirect (ByteString -> m a) -> (Text -> ByteString) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Resource -> DBId -> Text
showPath Resource
r DBId
dbid
showT :: Show a => a -> Text
showT :: a -> Text
showT = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
cap :: Text -> Text
cap :: Text -> Text
cap Text
t =
case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
h, Text
rest) -> Char -> Text -> Text
T.cons (Char -> Char
toUpper Char
h) Text
rest
Maybe (Char, Text)
Nothing -> Text
t
relativeRedirect :: MonadSnap m => B.ByteString -> m b
relativeRedirect :: ByteString -> m b
relativeRedirect ByteString
_path = do
ByteString
root <- (Request -> m ByteString) -> m ByteString
forall (m :: * -> *) a. MonadSnap m => (Request -> m a) -> m a
withRequest (ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString)
-> (Request -> ByteString) -> Request -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
rqContextPath)
ByteString -> m b
forall (m :: * -> *) a. MonadSnap m => ByteString -> m a
redirect (ByteString -> m b) -> ByteString -> m b
forall a b. (a -> b) -> a -> b
$ ByteString
root ByteString -> ByteString -> ByteString
`B.append` ByteString
_path
class HasFormlet a where
formlet :: Monad m => Formlet Text m a
instance HasFormlet String where formlet :: Formlet Text m String
formlet = Formlet Text m String
forall (m :: * -> *) v. (Monad m, Monoid v) => Formlet v m String
string
instance HasFormlet Text where formlet :: Formlet Text m Text
formlet = Formlet Text m Text
forall (m :: * -> *) v. (Monad m, Monoid v) => Formlet v m Text
text
instance HasFormlet Int where formlet :: Formlet Text m Int
formlet = Text -> Formlet Text m Int
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be an integer"
instance HasFormlet Integer where formlet :: Formlet Text m Integer
formlet = Text -> Formlet Text m Integer
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be an integer"
instance HasFormlet Float where formlet :: Formlet Text m Float
formlet = Text -> Formlet Text m Float
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be a float"
instance HasFormlet Double where formlet :: Formlet Text m Double
formlet = Text -> Formlet Text m Double
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be a double"
instance HasFormlet Bool where formlet :: Formlet Text m Bool
formlet = Formlet Text m Bool
forall (m :: * -> *) v. (Monad m, Monoid v) => Formlet v m Bool
bool
instance HasFormlet ByteString where
formlet :: Formlet Text m ByteString
formlet Maybe ByteString
v = (Text -> Result Text ByteString)
-> Form Text m Text -> Form Text m ByteString
forall (m :: * -> *) v a b.
(Monad m, Monoid v) =>
(a -> Result v b) -> Form v m a -> Form v m b
validate (ByteString -> Result Text ByteString
forall v a. a -> Result v a
Success (ByteString -> Result Text ByteString)
-> (Text -> ByteString) -> Text -> Result Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8) (Form Text m Text -> Form Text m ByteString)
-> Form Text m Text -> Form Text m ByteString
forall a b. (a -> b) -> a -> b
$ Formlet Text m Text
forall (m :: * -> *) v. (Monad m, Monoid v) => Formlet v m Text
text (ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
v)
instance HasFormlet Int8 where
formlet :: Formlet Text m Int8
formlet = Text -> Formlet Text m Int8
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be an integer"
instance HasFormlet Int16 where
formlet :: Formlet Text m Int16
formlet = Text -> Formlet Text m Int16
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be an integer"
instance HasFormlet Int32 where
formlet :: Formlet Text m Int32
formlet = Text -> Formlet Text m Int32
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be an integer"
instance HasFormlet Int64 where
formlet :: Formlet Text m Int64
formlet = Text -> Formlet Text m Int64
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be an integer"
instance HasFormlet Word8 where
formlet :: Formlet Text m Word8
formlet = Text -> Formlet Text m Word8
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be a positive integer"
instance HasFormlet Word16 where
formlet :: Formlet Text m Word16
formlet = Text -> Formlet Text m Word16
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be a positive integer"
instance HasFormlet Word32 where
formlet :: Formlet Text m Word32
formlet = Text -> Formlet Text m Word32
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be a positive integer"
instance HasFormlet Word64 where
formlet :: Formlet Text m Word64
formlet = Text -> Formlet Text m Word64
forall (m :: * -> *) v a.
(Monad m, Monoid v, Read a, Show a) =>
v -> Formlet v m a
stringRead Text
"must be a positive integer"
validDate :: Text -> Result Text Day
validDate :: Text -> Result Text Day
validDate = Result Text Day
-> (Day -> Result Text Day) -> Maybe Day -> Result Text Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Result Text Day
forall v a. v -> Result v a
Error Text
"invalid date") Day -> Result Text Day
forall v a. a -> Result v a
Success (Maybe Day -> Result Text Day)
-> (Text -> Maybe Day) -> Text -> Result Text Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
TimeLocale -> String -> String -> Maybe Day
forall t. ParseTime t => TimeLocale -> String -> String -> Maybe t
parseTime TimeLocale
LC.defaultTimeLocale String
"%F" (String -> Maybe Day) -> (Text -> String) -> Text -> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
dayText :: Day -> Text
dayText :: Day -> Text
dayText = String -> Text
T.pack (String -> Text) -> (Day -> String) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
LC.defaultTimeLocale String
"%F"
class PrimSplice a where
iPrimSplice :: Monad m => a -> m [X.Node]
cPrimSplice :: a -> Builder
iPrimText :: Monad m => Text -> m [X.Node]
iPrimText :: Text -> m Template
iPrimText Text
t = Template -> m Template
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Node
X.TextNode Text
t]
iPrimShow :: (Monad m, Show a) => a -> m [X.Node]
iPrimShow :: a -> m Template
iPrimShow = Text -> m Template
forall (m :: * -> *). Monad m => Text -> m Template
iPrimText (Text -> m Template) -> (a -> Text) -> a -> m Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
cPrimShow :: Show a => a -> Builder
cPrimShow :: a -> Builder
cPrimShow a
x = String -> Builder
Build.fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x
instance PrimSplice String where
iPrimSplice :: String -> m Template
iPrimSplice String
x = Text -> m Template
forall (m :: * -> *). Monad m => Text -> m Template
iPrimText (Text -> m Template) -> Text -> m Template
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
cPrimSplice :: String -> Builder
cPrimSplice String
x = Text -> Builder
Build.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
instance PrimSplice Text where
iPrimSplice :: Text -> m Template
iPrimSplice Text
x = Text -> m Template
forall (m :: * -> *). Monad m => Text -> m Template
iPrimText Text
x
cPrimSplice :: Text -> Builder
cPrimSplice Text
x = Text -> Builder
Build.fromText Text
x
instance PrimSplice Int where
iPrimSplice :: Int -> m Template
iPrimSplice Int
x = Int -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Int
x
cPrimSplice :: Int -> Builder
cPrimSplice = Int -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Integer where
iPrimSplice :: Integer -> m Template
iPrimSplice Integer
x = Integer -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Integer
x
cPrimSplice :: Integer -> Builder
cPrimSplice = Integer -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Float where
iPrimSplice :: Float -> m Template
iPrimSplice Float
x = Float -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Float
x
cPrimSplice :: Float -> Builder
cPrimSplice = Float -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Double where
iPrimSplice :: Double -> m Template
iPrimSplice Double
x = Double -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Double
x
cPrimSplice :: Double -> Builder
cPrimSplice = Double -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Bool where
iPrimSplice :: Bool -> m Template
iPrimSplice Bool
x = Bool -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Bool
x
cPrimSplice :: Bool -> Builder
cPrimSplice = Bool -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Int8 where
iPrimSplice :: Int8 -> m Template
iPrimSplice Int8
x = Int8 -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Int8
x
cPrimSplice :: Int8 -> Builder
cPrimSplice = Int8 -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Int16 where
iPrimSplice :: Int16 -> m Template
iPrimSplice Int16
x = Int16 -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Int16
x
cPrimSplice :: Int16 -> Builder
cPrimSplice = Int16 -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Int32 where
iPrimSplice :: Int32 -> m Template
iPrimSplice Int32
x = Int32 -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Int32
x
cPrimSplice :: Int32 -> Builder
cPrimSplice = Int32 -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Int64 where
iPrimSplice :: Int64 -> m Template
iPrimSplice Int64
x = Int64 -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Int64
x
cPrimSplice :: Int64 -> Builder
cPrimSplice = Int64 -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Word8 where
iPrimSplice :: Word8 -> m Template
iPrimSplice Word8
x = Word8 -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Word8
x
cPrimSplice :: Word8 -> Builder
cPrimSplice = Word8 -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Word16 where
iPrimSplice :: Word16 -> m Template
iPrimSplice Word16
x = Word16 -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Word16
x
cPrimSplice :: Word16 -> Builder
cPrimSplice = Word16 -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Word32 where
iPrimSplice :: Word32 -> m Template
iPrimSplice Word32
x = Word32 -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Word32
x
cPrimSplice :: Word32 -> Builder
cPrimSplice = Word32 -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Word64 where
iPrimSplice :: Word64 -> m Template
iPrimSplice Word64
x = Word64 -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow Word64
x
cPrimSplice :: Word64 -> Builder
cPrimSplice = Word64 -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice Day where
iPrimSplice :: Day -> m Template
iPrimSplice = Text -> m Template
forall a (m :: * -> *). (PrimSplice a, Monad m) => a -> m Template
iPrimSplice (Text -> m Template) -> (Day -> Text) -> Day -> m Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text
dayText
cPrimSplice :: Day -> Builder
cPrimSplice = Text -> Builder
forall a. PrimSplice a => a -> Builder
cPrimSplice (Text -> Builder) -> (Day -> Text) -> Day -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text
dayText
instance PrimSplice UTCTime where
iPrimSplice :: UTCTime -> m Template
iPrimSplice = UTCTime -> m Template
forall (m :: * -> *) a. (Monad m, Show a) => a -> m Template
iPrimShow
cPrimSplice :: UTCTime -> Builder
cPrimSplice = UTCTime -> Builder
forall a. Show a => a -> Builder
cPrimShow
instance PrimSplice a => PrimSplice (Maybe a) where
iPrimSplice :: Maybe a -> m Template
iPrimSplice Maybe a
Nothing = Text -> m Template
forall (m :: * -> *). Monad m => Text -> m Template
iPrimText Text
""
iPrimSplice (Just a
x) = a -> m Template
forall a (m :: * -> *). (PrimSplice a, Monad m) => a -> m Template
iPrimSplice a
x
cPrimSplice :: Maybe a -> Builder
cPrimSplice Maybe a
Nothing = Builder
forall a. Monoid a => a
mempty
cPrimSplice (Just a
x) = a -> Builder
forall a. PrimSplice a => a -> Builder
cPrimSplice a
x