{-# LANGUAGE OverloadedStrings #-}

module Snap.Snaplet.CustomAuth.Heist where

import Control.Lens
import Control.Monad.Trans
import qualified Text.XmlHtml as X
import Heist
import qualified Heist.Interpreted as I
import qualified Heist.Compiled as C
import Snap.Snaplet
import Snap.Snaplet.Heist
import Snap.Snaplet.CustomAuth.Handlers
import Snap.Snaplet.CustomAuth.Types
import Snap.Snaplet.CustomAuth.AuthManager
import Data.Map.Syntax

import Snap.Snaplet.CustomAuth.User (currentUser)

addAuthSplices
  :: UserData u
  => Snaplet (Heist b)
  -> SnapletLens b (AuthManager u e b)
  -> Initializer b v ()
addAuthSplices :: Snaplet (Heist b)
-> SnapletLens b (AuthManager u e b) -> Initializer b v ()
addAuthSplices Snaplet (Heist b)
h SnapletLens b (AuthManager u e b)
auth = 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)
sc
  where
    sc :: SpliceConfig (Handler b b)
sc = 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
.~ Splices (Splice (Handler b b))
is
                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
.~ Splices (Splice (Handler b b))
cs
    is :: Splices (Splice (Handler b b))
is = do
      Text
"ifLoggedIn" Text -> Splice (Handler b b) -> Splices (Splice (Handler b b))
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager u e b) -> Splice (Handler b b)
forall u b e.
UserData u =>
SnapletLens b (AuthManager u e b) -> SnapletISplice b
ifLoggedIn SnapletLens b (AuthManager u e b)
auth
      Text
"ifLoggedOut" Text -> Splice (Handler b b) -> Splices (Splice (Handler b b))
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager u e b) -> Splice (Handler b b)
forall u b e.
UserData u =>
SnapletLens b (AuthManager u e b) -> SnapletISplice b
ifLoggedOut SnapletLens b (AuthManager u e b)
auth
      Text
"loggedInUser" Text -> Splice (Handler b b) -> Splices (Splice (Handler b b))
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager u e b) -> Splice (Handler b b)
forall u b e.
UserData u =>
SnapletLens b (AuthManager u e b) -> SnapletISplice b
loggedInUser SnapletLens b (AuthManager u e b)
auth
    cs :: Splices (Splice (Handler b b))
cs = SnapletLens b (AuthManager u e b) -> Splices (Splice (Handler b b))
forall u b e.
UserData u =>
SnapletLens b (AuthManager u e b) -> Splices (SnapletCSplice b)
compiledAuthSplices SnapletLens b (AuthManager u e b)
auth

compiledAuthSplices
  :: UserData u
  => SnapletLens b (AuthManager u e b)
  -> Splices (SnapletCSplice b)
compiledAuthSplices :: SnapletLens b (AuthManager u e b) -> Splices (SnapletCSplice b)
compiledAuthSplices SnapletLens b (AuthManager u e b)
auth = do
    Text
"ifLoggedIn"   Text -> SnapletCSplice b -> Splices (SnapletCSplice b)
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager u e b) -> SnapletCSplice b
forall u b e.
UserData u =>
SnapletLens b (AuthManager u e b) -> SnapletCSplice b
cIfLoggedIn SnapletLens b (AuthManager u e b)
auth
    Text
"ifLoggedOut"  Text -> SnapletCSplice b -> Splices (SnapletCSplice b)
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager u e b) -> SnapletCSplice b
forall u b e.
UserData u =>
SnapletLens b (AuthManager u e b) -> SnapletCSplice b
cIfLoggedOut SnapletLens b (AuthManager u e b)
auth
    Text
"loggedInUser" Text -> SnapletCSplice b -> Splices (SnapletCSplice b)
forall k v. k -> v -> MapSyntax k v
## SnapletLens b (AuthManager u e b) -> SnapletCSplice b
forall u b e.
UserData u =>
SnapletLens b (AuthManager u e b) -> SnapletCSplice b
cLoggedInUser SnapletLens b (AuthManager u e b)
auth

ifLoggedIn
  :: UserData u
  => SnapletLens b (AuthManager u e b)
  -> SnapletISplice b
ifLoggedIn :: SnapletLens b (AuthManager u e b) -> SnapletISplice b
ifLoggedIn SnapletLens b (AuthManager u e b)
auth = do
  Bool
chk <- Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool)
-> Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool
forall a b. (a -> b) -> a -> b
$ SnapletLens b (AuthManager u e b)
-> Handler b (AuthManager u e b) Bool -> Handler b b Bool
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens b v' -> m b v' a -> m b v a
withTop SnapletLens b (AuthManager u e b)
auth Handler b (AuthManager u e b) Bool
forall u b e. UserData u => Handler b (AuthManager u e b) Bool
isLoggedIn
  case Bool
chk of
   Bool
True -> HeistT (Handler b b) (Handler b b) Node
forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
getParamNode HeistT (Handler b b) (Handler b b) Node
-> (Node -> SnapletISplice b) -> SnapletISplice b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Node] -> SnapletISplice b
forall (m :: * -> *) a. Monad m => a -> m a
return ([Node] -> SnapletISplice b)
-> (Node -> [Node]) -> Node -> SnapletISplice b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [Node]
X.childNodes
   Bool
False -> [Node] -> SnapletISplice b
forall (m :: * -> *) a. Monad m => a -> m a
return []


cIfLoggedIn
  :: UserData u
  => SnapletLens b (AuthManager u e b)
  -> SnapletCSplice b
cIfLoggedIn :: SnapletLens b (AuthManager u e b) -> SnapletCSplice b
cIfLoggedIn SnapletLens b (AuthManager u e b)
auth = do
    DList (Chunk (Handler b b))
cs <- SnapletCSplice b
forall (n :: * -> *). Monad n => Splice n
C.runChildren
    DList (Chunk (Handler b b)) -> SnapletCSplice b
forall (m :: * -> *) a. Monad m => a -> m a
return (DList (Chunk (Handler b b)) -> SnapletCSplice b)
-> DList (Chunk (Handler b b)) -> SnapletCSplice b
forall a b. (a -> b) -> a -> b
$ RuntimeSplice (Handler b b) Builder -> DList (Chunk (Handler b b))
forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
C.yieldRuntime (RuntimeSplice (Handler b b) Builder
 -> DList (Chunk (Handler b b)))
-> RuntimeSplice (Handler b b) Builder
-> DList (Chunk (Handler b b))
forall a b. (a -> b) -> a -> b
$ do
        Bool
chk <- Handler b b Bool -> RuntimeSplice (Handler b b) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b b Bool -> RuntimeSplice (Handler b b) Bool)
-> Handler b b Bool -> RuntimeSplice (Handler b b) Bool
forall a b. (a -> b) -> a -> b
$ SnapletLens b (AuthManager u e b)
-> Handler b (AuthManager u e b) Bool -> Handler b b Bool
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens b v' -> m b v' a -> m b v a
withTop SnapletLens b (AuthManager u e b)
auth Handler b (AuthManager u e b) Bool
forall u b e. UserData u => Handler b (AuthManager u e b) Bool
isLoggedIn
        case Bool
chk of
          Bool
True -> DList (Chunk (Handler b b)) -> RuntimeSplice (Handler b b) Builder
forall (n :: * -> *).
Monad n =>
DList (Chunk n) -> RuntimeSplice n Builder
C.codeGen DList (Chunk (Handler b b))
cs
          Bool
False -> RuntimeSplice (Handler b b) Builder
forall a. Monoid a => a
mempty

ifLoggedOut
  :: UserData u
  => SnapletLens b (AuthManager u e b)
  -> SnapletISplice b
ifLoggedOut :: SnapletLens b (AuthManager u e b) -> SnapletISplice b
ifLoggedOut SnapletLens b (AuthManager u e b)
auth = do
    Bool
chk <- Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool)
-> Handler b b Bool -> HeistT (Handler b b) (Handler b b) Bool
forall a b. (a -> b) -> a -> b
$ SnapletLens b (AuthManager u e b)
-> Handler b (AuthManager u e b) Bool -> Handler b b Bool
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens b v' -> m b v' a -> m b v a
withTop SnapletLens b (AuthManager u e b)
auth Handler b (AuthManager u e b) Bool
forall u b e. UserData u => Handler b (AuthManager u e b) Bool
isLoggedIn
    case Bool
chk of
      Bool
False -> HeistT (Handler b b) (Handler b b) Node
forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
getParamNode HeistT (Handler b b) (Handler b b) Node
-> (Node -> SnapletISplice b) -> SnapletISplice b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Node] -> SnapletISplice b
forall (m :: * -> *) a. Monad m => a -> m a
return ([Node] -> SnapletISplice b)
-> (Node -> [Node]) -> Node -> SnapletISplice b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [Node]
X.childNodes
      Bool
True -> [Node] -> SnapletISplice b
forall (m :: * -> *) a. Monad m => a -> m a
return []

cIfLoggedOut
  :: UserData u
  => SnapletLens b (AuthManager u e b)
  -> SnapletCSplice b
cIfLoggedOut :: SnapletLens b (AuthManager u e b) -> SnapletCSplice b
cIfLoggedOut SnapletLens b (AuthManager u e b)
auth = do
    DList (Chunk (Handler b b))
cs <- SnapletCSplice b
forall (n :: * -> *). Monad n => Splice n
C.runChildren
    DList (Chunk (Handler b b)) -> SnapletCSplice b
forall (m :: * -> *) a. Monad m => a -> m a
return (DList (Chunk (Handler b b)) -> SnapletCSplice b)
-> DList (Chunk (Handler b b)) -> SnapletCSplice b
forall a b. (a -> b) -> a -> b
$ RuntimeSplice (Handler b b) Builder -> DList (Chunk (Handler b b))
forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
C.yieldRuntime (RuntimeSplice (Handler b b) Builder
 -> DList (Chunk (Handler b b)))
-> RuntimeSplice (Handler b b) Builder
-> DList (Chunk (Handler b b))
forall a b. (a -> b) -> a -> b
$ do
        Bool
chk <- Handler b b Bool -> RuntimeSplice (Handler b b) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b b Bool -> RuntimeSplice (Handler b b) Bool)
-> Handler b b Bool -> RuntimeSplice (Handler b b) Bool
forall a b. (a -> b) -> a -> b
$ SnapletLens b (AuthManager u e b)
-> Handler b (AuthManager u e b) Bool -> Handler b b Bool
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens b v' -> m b v' a -> m b v a
withTop SnapletLens b (AuthManager u e b)
auth Handler b (AuthManager u e b) Bool
forall u b e. UserData u => Handler b (AuthManager u e b) Bool
isLoggedIn
        case Bool
chk of
          Bool
False -> DList (Chunk (Handler b b)) -> RuntimeSplice (Handler b b) Builder
forall (n :: * -> *).
Monad n =>
DList (Chunk n) -> RuntimeSplice n Builder
C.codeGen DList (Chunk (Handler b b))
cs
          Bool
True -> RuntimeSplice (Handler b b) Builder
forall a. Monoid a => a
mempty

loggedInUser
  :: UserData u
  => SnapletLens b (AuthManager u e b)
  -> SnapletISplice b
loggedInUser :: SnapletLens b (AuthManager u e b) -> SnapletISplice b
loggedInUser SnapletLens b (AuthManager u e b)
auth = do
    Maybe u
u <- Handler b b (Maybe u)
-> HeistT (Handler b b) (Handler b b) (Maybe u)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b b (Maybe u)
 -> HeistT (Handler b b) (Handler b b) (Maybe u))
-> Handler b b (Maybe u)
-> HeistT (Handler b b) (Handler b b) (Maybe u)
forall a b. (a -> b) -> a -> b
$ SnapletLens b (AuthManager u e b)
-> Handler b (AuthManager u e b) (Maybe u) -> Handler b b (Maybe u)
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens b v' -> m b v' a -> m b v a
withTop SnapletLens b (AuthManager u e b)
auth Handler b (AuthManager u e b) (Maybe u)
forall u b e. UserData u => Handler b (AuthManager u e b) (Maybe u)
currentUser
    SnapletISplice b
-> (u -> SnapletISplice b) -> Maybe u -> SnapletISplice b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Node] -> SnapletISplice b
forall (m :: * -> *) a. Monad m => a -> m a
return []) (Text -> SnapletISplice b
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m [Node]
I.textSplice (Text -> SnapletISplice b) -> (u -> Text) -> u -> SnapletISplice b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthUser -> Text
name (AuthUser -> Text) -> (u -> AuthUser) -> u -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> AuthUser
forall a. UserData a => a -> AuthUser
extractUser) (Maybe u -> SnapletISplice b) -> Maybe u -> SnapletISplice b
forall a b. (a -> b) -> a -> b
$ Maybe u
u

cLoggedInUser
  :: UserData u
  => SnapletLens b (AuthManager u e b)
  -> SnapletCSplice b
cLoggedInUser :: SnapletLens b (AuthManager u e b) -> SnapletCSplice b
cLoggedInUser SnapletLens b (AuthManager u e b)
auth =
    DList (Chunk (Handler b b)) -> SnapletCSplice b
forall (m :: * -> *) a. Monad m => a -> m a
return (DList (Chunk (Handler b b)) -> SnapletCSplice b)
-> DList (Chunk (Handler b b)) -> SnapletCSplice b
forall a b. (a -> b) -> a -> b
$ RuntimeSplice (Handler b b) Text -> DList (Chunk (Handler b b))
forall (n :: * -> *).
Monad n =>
RuntimeSplice n Text -> DList (Chunk n)
C.yieldRuntimeText (RuntimeSplice (Handler b b) Text -> DList (Chunk (Handler b b)))
-> RuntimeSplice (Handler b b) Text -> DList (Chunk (Handler b b))
forall a b. (a -> b) -> a -> b
$ do
        Maybe u
u <- Handler b b (Maybe u) -> RuntimeSplice (Handler b b) (Maybe u)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler b b (Maybe u) -> RuntimeSplice (Handler b b) (Maybe u))
-> Handler b b (Maybe u) -> RuntimeSplice (Handler b b) (Maybe u)
forall a b. (a -> b) -> a -> b
$ SnapletLens b (AuthManager u e b)
-> Handler b (AuthManager u e b) (Maybe u) -> Handler b b (Maybe u)
forall (m :: * -> * -> * -> *) b v' a v.
MonadSnaplet m =>
SnapletLens b v' -> m b v' a -> m b v a
withTop SnapletLens b (AuthManager u e b)
auth Handler b (AuthManager u e b) (Maybe u)
forall u b e. UserData u => Handler b (AuthManager u e b) (Maybe u)
currentUser
        Text -> RuntimeSplice (Handler b b) Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> RuntimeSplice (Handler b b) Text)
-> Text -> RuntimeSplice (Handler b b) Text
forall a b. (a -> b) -> a -> b
$ Text -> (u -> Text) -> Maybe u -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (AuthUser -> Text
name (AuthUser -> Text) -> (u -> AuthUser) -> u -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> AuthUser
forall a. UserData a => a -> AuthUser
extractUser) Maybe u
u