{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoMonomorphismRestriction  #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE TypeSynonymInstances       #-}

module Snap.Restful
    (

    -- * Core API
      addResource
    , addResourceRelative
    , initRest

    -- * Splice functions
    , resourceSplices
    , itemSplices
    , resourceCSplices
    , itemCSplices
    , itemCSplice
    , unitLens
    , resourceRouter
    , resourceRoutes

    -- * Types
    , CRUD (..)
    , Resource (..)
    , DBId (..)

    -- * Generating forms and splices
    , HasFormlet (..)
    , PrimSplice (..)
    , iPrimText
    , iPrimShow
    , cPrimShow

    -- * Functions for generating paths
    , rootPath
    , indexPath
    , createPath
    , showPath
    , newPath
    , editPath
    , updatePath
    , destroyPath
    , itemActionPath
    , templatePath

    -- * Misc helpers
    , 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
------------------------------------------------------------------------------



------------------------------------------------------------------------------
-- | Enumeration of all the different types of CRUD routes.
data CRUD = RIndex
          -- ^ An item index
          | RShow
          -- ^ A single item
          | RNew
          -- ^ The form for creating a new item
          | REdit
          -- ^ The form for editing an item
          | RCreate
          -- ^ Create a new item
          | RUpdate
          -- ^ Update an item
          | RDestroy
          -- ^ Delete an item
  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


------------------------------------------------------------------------------
-- | Encapsulates the data necessary to define a resource.
data Resource = Resource {
      Resource -> Text
rName              :: Text
    -- ^ A name for this resource
    , Resource -> Text
rRoot              :: Text
    -- ^ URL root for this resource
    , Resource -> [Text]
rResourceEndpoints :: [Text]
    -- ^ Resource level routing end points
    , Resource -> [Text]
rItemEndpoints     :: [Text]
    -- ^ Item/instance level routing end points
}


instance Default Resource where
    def :: Resource
def = Text -> Text -> [Text] -> [Text] -> Resource
Resource Text
"items" Text
"/items" [] []


------------------------------------------------------------------------------
-- | An initializer for encapsulating RESTful resources as a standalone
-- snaplet.
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


------------------------------------------------------------------------------
-- | Since 'initRest' returns unit, we provide a generic unit lens here for
-- use with nestSnaplet in case you don't want to add a unit field to your
-- application state type.
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)


------------------------------------------------------------------------------
-- We need two addResource functions because we are dealing with paths in two
-- different contexts: routes and splices.  With routes, the addRoutes
-- function automatically makes things relative to the current snaplet root.
-- But that will only take effect when initRest is used, and is therefore
-- inside a nestSnaplet call.
--
-- For paths inside splices, the snaplet addRoute infrastructure is not
-- available because these splices always run in the Handler App App monad and
-- therefore can't have access to the current snaplet root.
------------------------------------------------------------------------------


------------------------------------------------------------------------------
-- | One-stop convenience function to enable RESTful resources in your
-- application.  Call this function from your initializer passing it all of
-- your resources and it will add the routes and splices for you.
addResource :: HasHeist b
            => Resource
            -- ^ Resource definition
            -> [(CRUD, Handler b v ())]
            -- ^ Standard CRUD handlers
            -> [(Text, Handler b v ())]
            -- ^ Additional resource level handlers
            -> [(Text, Handler b v ())]
            -- ^ Additional instance/item level handlers
            -> Snaplet (Heist b)
            -- ^ The Heist snaplet initialized in your app's 'Initializer'
            -> 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


------------------------------------------------------------------------------
-- | Just like 'addResource', but makes the handlers relative to the current
-- snaplet's root.  Use this function if you're writing a snaplet.
addResourceRelative :: HasHeist b
                    => Resource
                    -- ^ Resource definition
                    -> [(CRUD, Handler b v ())]
                    -- ^ Standard CRUD handlers
                    -> [(Text, Handler b v ())]
                    -- ^ Additional resource level handlers
                    -> [(Text, Handler b v ())]
                    -- ^ Additional instance/item level handlers
                    -> Snaplet (Heist b)
                    -- ^ The Heist snaplet initialized in your app's
                    -- 'Initializer'
                    -> 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


-------------------------------------------------------------------------------
-- | Serves the routes for a resource with heist templates.
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


------------------------------------------------------------------------------
-- | Helper function that can be used with resourceRoutes or
-- resourceRoutesRelative.
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


------------------------------------------------------------------------------
-- | See 'addResource' for an explanation of the arguments to this
-- function. The routes returned ARE prefixed with rRoot from
-- Resource.
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)


------------------------------------------------------------------------------
-- | See 'addResource' for an explanation of the arguments to this function.
-- The routes returned are not prefixed with rRoot from Resource.
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


------------------------------------------------------------------------------
-- | Generate a route handler for the routes returned by resourceRoutes.  This
-- function does add the rRoot prefix.
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)


------------------------------------------------------------------------------
-- | Return heist template location for given crud action
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]


------------------------------------------------------------------------------
-- | Generates a path for an item action.
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]


------------------------------------------------------------------------------
-- | Generates the path for the resource index.
indexPath :: Resource -> Text
indexPath :: Resource -> Text
indexPath Resource
r = Resource -> Text
rRoot Resource
r


------------------------------------------------------------------------------
-- | Generates the path for creating a resource.
createPath :: Resource -> Text
createPath :: Resource -> Text
createPath Resource
r = Resource -> Text
rRoot Resource
r


------------------------------------------------------------------------------
-- | Generates the path for a form to a new resource.
newPath :: Resource -> Text
newPath :: Resource -> Text
newPath Resource
r = [Text] -> Text
mkPath [Resource -> Text
rRoot Resource
r, Text
"new"]


------------------------------------------------------------------------------
-- | Same as 'indexPath'.
rootPath :: Resource -> Text
rootPath :: Resource -> Text
rootPath = Resource -> Text
indexPath


------------------------------------------------------------------------------
-- | Generates the path for a form to a new resource.
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"]


------------------------------------------------------------------------------
-- | Generates the path for showing a single resource item.
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]


------------------------------------------------------------------------------
-- | Generates the path for updating a single resource item.
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]


------------------------------------------------------------------------------
-- | Generates the path for deleting a resource item.
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"]


------------------------------------------------------------------------------
-- | Sets the @RESTFormAction@ param.
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) }

------------------------------------------------------------------------------
-- | Gets the @RESTFormAction@ param.
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


-------------------------------------------------------------------------------
-- | Paths at the resource/collection level
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



------------------------------------------------------------------------------
-- | Generates path splices for a resource item.  These splices let you put
-- resource links in your templates in DRY manner.
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


-------------------------------------------------------------------------------
-- | Returns compiled splices for a resource.
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


------------------------------------------------------------------------------
-- | Generates compiled path splices for a resource item.  These splices let
-- you put resource links in your templates in DRY manner.
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


------------------------------------------------------------------------------
-- | A splice that runs its children with all item splices for a resource.
-- This function gets the id from the \"id\" param, which could have come in
-- the request or might have been set up by a route capture string.
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


-------------------------------------------------------------------------------
-- | Splices to generate links for resource item actions.
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


-------------------------------------------------------------------------------
-- | Compiled splices to generate links for resource actions.
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


-------------------------------------------------------------------------------
-- | Compiled splices to generate links for resource item actions.
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)


------------------------------------------------------------------------------
-- | Redirect to given item's default show page
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


------------------------------------------------------------------------------
-- | Type class for automatic formlet generation.
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"


------------------------------------------------------------------------------
--                                 Splices
------------------------------------------------------------------------------


------------------------------------------------------------------------------
-- | Type class for automatic splice generation.
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