{-# LANGUAGE
GADTs
, PolyKinds
, TypeFamilies
, BangPatterns
, TypeOperators
, TupleSections
, DoAndIfThenElse
, ConstraintKinds
, FlexibleContexts
, OverloadedStrings
, ScopedTypeVariables
, NamedFieldPuns
#-}
module Web.Routes.Nested
(
match
, matchHere
, matchAny
, matchGroup
, auth
,
route
, routeAuth
,
extractMatch
, extractMatchAny
, extractAuthSym
, extractAuth
, extractNearestVia
,
SecurityToken (..)
, AuthScope (..)
, Match
, MatchGroup
,
module Web.Routes.Nested.Match
, module Web.Routes.Nested.Types
, module Network.Wai.Middleware.Verbs
, module Network.Wai.Middleware.ContentType
) where
import Web.Routes.Nested.Match (UrlChunks, origin_)
import Web.Routes.Nested.Match
import Web.Routes.Nested.Types (RouterT, execRouterT, Tries (..), ExtrudeSoundly)
import Web.Routes.Nested.Types
import Network.Wai (Request, pathInfo)
import Network.Wai.Trans (MiddlewareT)
import Network.Wai.Middleware.Verbs
import Network.Wai.Middleware.ContentType hiding (responseStatus, responseHeaders, responseData)
import Data.Trie.Pred.Base (RootedPredTrie (..), PredTrie (..))
import Data.Trie.Pred.Base.Step (PredStep (..), Pred (..))
import qualified Data.Trie.Pred.Interface as Interface
import Data.Trie.Pred.Interface.Types (Singleton (..), Extrude (..), CatMaybes)
import Data.Trie.HashMap (HashMapStep (..), HashMapChildren (..))
import Data.List.NonEmpty (NonEmpty (..), fromList)
import qualified Data.Text as T
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM
import Data.Monoid ((<>), First (..))
import Data.Function.Poly (ArityTypeListIso)
import Data.Bifunctor (bimap)
import qualified Control.Monad.State as S
import Control.Monad.Catch (MonadThrow)
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.IO.Class (MonadIO (..))
import Control.Arrow (first)
import Control.Monad.ST (stToIO)
type Match xs' xs childContent resultContent =
( xs' ~ CatMaybes xs
, Singleton (UrlChunks xs) childContent (RootedPredTrie T.Text resultContent)
, ArityTypeListIso childContent xs' resultContent
)
type MatchGroup xs' xs childContent resultContent childSec resultSec =
( ExtrudeSoundly xs' xs childContent resultContent
, ExtrudeSoundly xs' xs childSec resultSec
)
match :: Monad m
=> Match xs' xs childContent resultContent
=> UrlChunks xs
-> childContent
-> RouterT resultContent sec m ()
match :: forall (m :: * -> *) (xs' :: [*]) (xs :: [Maybe (*)]) childContent
resultContent sec.
(Monad m, Match xs' xs childContent resultContent) =>
UrlChunks xs -> childContent -> RouterT resultContent sec m ()
match !UrlChunks xs
ts !childContent
vl =
forall w (m :: * -> *). (Monoid w, MonadState w m) => w -> m ()
tell' forall a b. (a -> b) -> a -> b
$ forall x s.
RootedPredTrie Text x
-> RootedPredTrie Text x -> RootedPredTrie Text s -> Tries x s
Tries (forall chunks a trie.
Singleton chunks a trie =>
chunks -> a -> trie
singleton UrlChunks xs
ts childContent
vl)
forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
{-# INLINEABLE match #-}
matchHere :: Monad m
=> childContent
-> RouterT childContent sec m ()
matchHere :: forall (m :: * -> *) childContent sec.
Monad m =>
childContent -> RouterT childContent sec m ()
matchHere = forall (m :: * -> *) (xs' :: [*]) (xs :: [Maybe (*)]) childContent
resultContent sec.
(Monad m, Match xs' xs childContent resultContent) =>
UrlChunks xs -> childContent -> RouterT resultContent sec m ()
match UrlChunks '[]
origin_
{-# INLINEABLE matchHere #-}
matchAny :: Monad m
=> childContent
-> RouterT childContent sec m ()
matchAny :: forall (m :: * -> *) childContent sec.
Monad m =>
childContent -> RouterT childContent sec m ()
matchAny !childContent
vl =
forall w (m :: * -> *). (Monoid w, MonadState w m) => w -> m ()
tell' forall a b. (a -> b) -> a -> b
$ forall x s.
RootedPredTrie Text x
-> RootedPredTrie Text x -> RootedPredTrie Text s -> Tries x s
Tries forall a. Monoid a => a
mempty
(forall chunks a trie.
Singleton chunks a trie =>
chunks -> a -> trie
singleton UrlChunks '[]
origin_ childContent
vl)
forall a. Monoid a => a
mempty
{-# INLINEABLE matchAny #-}
matchGroup :: Monad m
=> MatchGroup xs' xs childContent resultContent childSec resultSec
=> UrlChunks xs
-> RouterT childContent childSec m ()
-> RouterT resultContent resultSec m ()
matchGroup :: forall (m :: * -> *) (xs' :: [*]) (xs :: [Maybe (*)]) childContent
resultContent childSec resultSec.
(Monad m,
MatchGroup xs' xs childContent resultContent childSec resultSec) =>
UrlChunks xs
-> RouterT childContent childSec m ()
-> RouterT resultContent resultSec m ()
matchGroup !UrlChunks xs
ts RouterT childContent childSec m ()
cs = do
(Tries RootedPredTrie Text childContent
trieContent' RootedPredTrie Text childContent
trieNotFound RootedPredTrie Text childSec
trieSec) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) x sec a.
Monad m =>
RouterT x sec m a -> m (Tries x sec)
execRouterT RouterT childContent childSec m ()
cs
forall w (m :: * -> *). (Monoid w, MonadState w m) => w -> m ()
tell' forall a b. (a -> b) -> a -> b
$ forall x s.
RootedPredTrie Text x
-> RootedPredTrie Text x -> RootedPredTrie Text s -> Tries x s
Tries (forall chunks start result.
Extrude chunks start result =>
chunks -> start -> result
extrude UrlChunks xs
ts RootedPredTrie Text childContent
trieContent')
(forall chunks start result.
Extrude chunks start result =>
chunks -> start -> result
extrude UrlChunks xs
ts RootedPredTrie Text childContent
trieNotFound)
(forall chunks start result.
Extrude chunks start result =>
chunks -> start -> result
extrude UrlChunks xs
ts RootedPredTrie Text childSec
trieSec)
{-# INLINEABLE matchGroup #-}
data SecurityToken s = SecurityToken
{ forall s. SecurityToken s -> s
securityToken :: !s
, forall s. SecurityToken s -> AuthScope
securityScope :: !AuthScope
} deriving (Int -> SecurityToken s -> ShowS
forall s. Show s => Int -> SecurityToken s -> ShowS
forall s. Show s => [SecurityToken s] -> ShowS
forall s. Show s => SecurityToken s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecurityToken s] -> ShowS
$cshowList :: forall s. Show s => [SecurityToken s] -> ShowS
show :: SecurityToken s -> String
$cshow :: forall s. Show s => SecurityToken s -> String
showsPrec :: Int -> SecurityToken s -> ShowS
$cshowsPrec :: forall s. Show s => Int -> SecurityToken s -> ShowS
Show)
data AuthScope
= ProtectHere
| DontProtectHere
deriving (Int -> AuthScope -> ShowS
[AuthScope] -> ShowS
AuthScope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthScope] -> ShowS
$cshowList :: [AuthScope] -> ShowS
show :: AuthScope -> String
$cshow :: AuthScope -> String
showsPrec :: Int -> AuthScope -> ShowS
$cshowsPrec :: Int -> AuthScope -> ShowS
Show, AuthScope -> AuthScope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthScope -> AuthScope -> Bool
$c/= :: AuthScope -> AuthScope -> Bool
== :: AuthScope -> AuthScope -> Bool
$c== :: AuthScope -> AuthScope -> Bool
Eq)
auth :: Monad m
=> sec
-> AuthScope
-> RouterT content (SecurityToken sec) m ()
auth :: forall (m :: * -> *) sec content.
Monad m =>
sec -> AuthScope -> RouterT content (SecurityToken sec) m ()
auth !sec
token !AuthScope
scope =
forall w (m :: * -> *). (Monoid w, MonadState w m) => w -> m ()
tell' (forall x s.
RootedPredTrie Text x
-> RootedPredTrie Text x -> RootedPredTrie Text s -> Tries x s
Tries forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
(forall chunks a trie.
Singleton chunks a trie =>
chunks -> a -> trie
singleton UrlChunks '[]
origin_ (forall s. s -> AuthScope -> SecurityToken s
SecurityToken sec
token AuthScope
scope)))
{-# INLINEABLE auth #-}
route :: MonadIO m
=> RouterT (MiddlewareT m) sec m a
-> MiddlewareT m
route :: forall (m :: * -> *) sec a.
MonadIO m =>
RouterT (MiddlewareT m) sec m a -> MiddlewareT m
route RouterT (MiddlewareT m) sec m a
hs ApplicationT m
app Request
req Response -> m ResponseReceived
resp = do
let path :: [Text]
path = Request -> [Text]
pathInfo Request
req
Maybe (MiddlewareT m)
mightMatch <- forall (m :: * -> *) r sec a.
MonadIO m =>
[Text] -> RouterT r sec m a -> m (Maybe r)
extractMatch [Text]
path RouterT (MiddlewareT m) sec m a
hs
case Maybe (MiddlewareT m)
mightMatch of
Maybe (MiddlewareT m)
Nothing -> do
Maybe (MiddlewareT m)
mMatch <- forall (m :: * -> *) r sec a.
MonadIO m =>
[Text] -> RouterT r sec m a -> m (Maybe r)
extractMatchAny [Text]
path RouterT (MiddlewareT m) sec m a
hs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(ApplicationT m
app Request
req Response -> m ResponseReceived
resp)
(\MiddlewareT m
mid -> MiddlewareT m
mid ApplicationT m
app Request
req Response -> m ResponseReceived
resp)
Maybe (MiddlewareT m)
mMatch
Just MiddlewareT m
mid -> MiddlewareT m
mid ApplicationT m
app Request
req Response -> m ResponseReceived
resp
routeAuth :: MonadIO m
=> MonadThrow m
=> (Request -> [sec] -> m ())
-> RouterT (MiddlewareT m) (SecurityToken sec) m a
-> MiddlewareT m
routeAuth :: forall (m :: * -> *) sec a.
(MonadIO m, MonadThrow m) =>
(Request -> [sec] -> m ())
-> RouterT (MiddlewareT m) (SecurityToken sec) m a -> MiddlewareT m
routeAuth Request -> [sec] -> m ()
authorize RouterT (MiddlewareT m) (SecurityToken sec) m a
hs ApplicationT m
app Request
req Response -> m ResponseReceived
resp = do
forall (m :: * -> *) sec x a.
(MonadIO m, MonadThrow m) =>
(Request -> [sec] -> m ())
-> Request -> RouterT x (SecurityToken sec) m a -> m ()
extractAuth Request -> [sec] -> m ()
authorize Request
req RouterT (MiddlewareT m) (SecurityToken sec) m a
hs
forall (m :: * -> *) sec a.
MonadIO m =>
RouterT (MiddlewareT m) sec m a -> MiddlewareT m
route RouterT (MiddlewareT m) (SecurityToken sec) m a
hs ApplicationT m
app Request
req Response -> m ResponseReceived
resp
extractMatch :: MonadIO m
=> [T.Text]
-> RouterT r sec m a
-> m (Maybe r)
[Text]
path !RouterT r sec m a
hs = do
Tries{RootedPredTrie Text r
trieContent :: forall x s. Tries x s -> RootedPredTrie Text x
trieContent :: RootedPredTrie Text r
trieContent} <- forall (m :: * -> *) x sec a.
Monad m =>
RouterT x sec m a -> m (Tries x sec)
execRouterT RouterT r sec m a
hs
let mResult :: Maybe ([Text], r)
mResult = forall s a.
(Hashable s, Eq s) =>
(s -> s) -> [s] -> RootedPredTrie s a -> Maybe ([s], a)
lookupWithLRPT Text -> Text
trimFileExt [Text]
path RootedPredTrie Text r
trieContent
case Maybe ([Text], r)
mResult of
Maybe ([Text], r)
Nothing ->
if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
path)
Bool -> Bool -> Bool
&& Text -> Text
trimFileExt (forall a. [a] -> a
last [Text]
path) forall a. Eq a => a -> a -> Bool
== Text
"index"
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a.
(Eq k, Hashable k) =>
[k] -> RootedPredTrie k a -> Maybe a
Interface.lookup (forall a. [a] -> [a]
init [Text]
path) RootedPredTrie Text r
trieContent
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just ([Text]
_,r
r) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just r
r)
{-# INLINEABLE extractMatch #-}
extractMatchAny :: MonadIO m
=> [T.Text]
-> RouterT r sec m a
-> m (Maybe r)
[Text]
path = forall (m :: * -> *) r sec a.
MonadIO m =>
[Text]
-> (RouterT r sec m a -> m (RootedPredTrie Text r))
-> RouterT r sec m a
-> m (Maybe r)
extractNearestVia [Text]
path (\RouterT r sec m a
x -> forall x s. Tries x s -> RootedPredTrie Text x
trieCatchAll forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) x sec a.
Monad m =>
RouterT x sec m a -> m (Tries x sec)
execRouterT RouterT r sec m a
x)
{-# INLINEABLE extractMatchAny #-}
extractAuthSym :: MonadIO m
=> [T.Text]
-> RouterT x (SecurityToken sec) m a
-> m [sec]
[Text]
path RouterT x (SecurityToken sec) m a
hs = do
Tries{RootedPredTrie Text (SecurityToken sec)
trieSecurity :: forall x s. Tries x s -> RootedPredTrie Text s
trieSecurity :: RootedPredTrie Text (SecurityToken sec)
trieSecurity} <- forall (m :: * -> *) x sec a.
Monad m =>
RouterT x sec m a -> m (Tries x sec)
execRouterT RouterT x (SecurityToken sec) m a
hs
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ do
let results :: [([Text], SecurityToken sec, [Text])]
results = forall k a.
(Hashable k, Eq k) =>
[k] -> RootedPredTrie k a -> [([k], a, [k])]
Interface.matches [Text]
path RootedPredTrie Text (SecurityToken sec)
trieSecurity
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a} {a}. (a, SecurityToken a, [a]) -> [a] -> [a]
go [] [([Text], SecurityToken sec, [Text])]
results
where
go :: (a, SecurityToken a, [a]) -> [a] -> [a]
go (a
_,SecurityToken a
_ AuthScope
DontProtectHere,[]) [a]
ys = [a]
ys
go (a
_,SecurityToken a
x AuthScope
_ ,[a]
_ ) [a]
ys = a
xforall a. a -> [a] -> [a]
:[a]
ys
{-# INLINEABLE extractAuthSym #-}
extractAuth :: MonadIO m
=> MonadThrow m
=> (Request -> [sec] -> m ())
-> Request
-> RouterT x (SecurityToken sec) m a
-> m ()
Request -> [sec] -> m ()
authorize Request
req RouterT x (SecurityToken sec) m a
hs = do
[sec]
ss <- forall (m :: * -> *) x sec a.
MonadIO m =>
[Text] -> RouterT x (SecurityToken sec) m a -> m [sec]
extractAuthSym (Request -> [Text]
pathInfo Request
req) RouterT x (SecurityToken sec) m a
hs
Request -> [sec] -> m ()
authorize Request
req [sec]
ss
{-# INLINEABLE extractAuth #-}
extractNearestVia :: MonadIO m
=> [T.Text]
-> (RouterT r sec m a -> m (RootedPredTrie T.Text r))
-> RouterT r sec m a
-> m (Maybe r)
[Text]
path RouterT r sec m a -> m (RootedPredTrie Text r)
extr RouterT r sec m a
hs = do
RootedPredTrie Text r
trie <- RouterT r sec m a -> m (RootedPredTrie Text r)
extr RouterT r sec m a
hs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {a} {b} {c}. (a, b, c) -> b
mid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a.
(Hashable k, Eq k) =>
[k] -> RootedPredTrie k a -> Maybe ([k], a, [k])
Interface.match [Text]
path RootedPredTrie Text r
trie)
where
mid :: (a, b, c) -> b
mid (a
_,b
r,c
_) = b
r
{-# INLINEABLE extractNearestVia #-}
trimFileExt :: T.Text -> T.Text
trimFileExt :: Text -> Text
trimFileExt !Text
s =
case Text -> Text -> (Text, Text)
T.breakOnEnd Text
"." Text
s of
(Text
f,Text
e) | Text
f forall a. Eq a => a -> a -> Bool
/= Text
""
Bool -> Bool -> Bool
&& Text
e forall a. Eq a => a -> a -> Bool
/= Text
""
Bool -> Bool -> Bool
&& Text -> Int
T.length Text
f forall a. Ord a => a -> a -> Bool
> Int
0 -> Int -> Text -> Text
T.dropEnd Int
1 Text
f
(Text, Text)
_ -> Text
s
{-# INLINEABLE trimFileExt #-}
lookupWithLPT :: Hashable s
=> Eq s
=> (s -> s) -> NonEmpty s -> PredTrie s a -> Maybe ([s], a)
lookupWithLPT :: forall s a.
(Hashable s, Eq s) =>
(s -> s) -> NonEmpty s -> PredTrie s a -> Maybe ([s], a)
lookupWithLPT s -> s
f NonEmpty s
tss (PredTrie (HashMapStep HashMap s (HashMapChildren PredTrie s a)
ls) (PredStep HashMap s (Pred PredTrie s a)
ps)) =
forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> First a
First (forall s a.
(Hashable s, Eq s) =>
(s -> s)
-> NonEmpty s
-> HashMap s (HashMapChildren PredTrie s a)
-> Maybe ([s], a)
goLit s -> s
f NonEmpty s
tss HashMap s (HashMapChildren PredTrie s a)
ls)
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a.
(Hashable s, Eq s) =>
(s -> s) -> NonEmpty s -> Pred PredTrie s a -> Maybe ([s], a)
goPred s -> s
f NonEmpty s
tss) HashMap s (Pred PredTrie s a)
ps
goLit :: Hashable s
=> Eq s
=> (s -> s)
-> NonEmpty s
-> HM.HashMap s (HashMapChildren PredTrie s a)
-> Maybe ([s], a)
goLit :: forall s a.
(Hashable s, Eq s) =>
(s -> s)
-> NonEmpty s
-> HashMap s (HashMapChildren PredTrie s a)
-> Maybe ([s], a)
goLit s -> s
f (s
t:|[s]
ts) HashMap s (HashMapChildren PredTrie s a)
xs = do
(HashMapChildren Maybe a
mx Maybe (PredTrie s a)
mxs) <- forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> First a
First (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup s
t HashMap s (HashMapChildren PredTrie s a)
xs)
forall a. Semigroup a => a -> a -> a
<> forall a. Maybe a -> First a
First ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [s]
ts
then forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (s -> s
f s
t) HashMap s (HashMapChildren PredTrie s a)
xs
else forall a. Maybe a
Nothing)
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [s]
ts
then ([s -> s
f s
t],) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mx
else forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (s
tforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s a.
(Hashable s, Eq s) =>
(s -> s) -> NonEmpty s -> PredTrie s a -> Maybe ([s], a)
lookupWithLPT s -> s
f (forall a. [a] -> NonEmpty a
fromList [s]
ts) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (PredTrie s a)
mxs)
goPred :: Hashable s
=> Eq s
=> (s -> s)
-> NonEmpty s
-> Pred PredTrie s a
-> Maybe ([s], a)
goPred :: forall s a.
(Hashable s, Eq s) =>
(s -> s) -> NonEmpty s -> Pred PredTrie s a -> Maybe ([s], a)
goPred s -> s
f (s
t:|[s]
ts) (Pred s -> Maybe r
predicate Maybe (r -> a)
mx PredTrie s (r -> a)
xs) = do
r
d <- s -> Maybe r
predicate s
t
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [s]
ts
then (([s
t],) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ r
d)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (r -> a)
mx
else forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (s
tforall a. a -> [a] -> [a]
:) (forall a b. (a -> b) -> a -> b
$ r
d) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a.
(Hashable s, Eq s) =>
(s -> s) -> NonEmpty s -> PredTrie s a -> Maybe ([s], a)
lookupWithLPT s -> s
f (forall a. [a] -> NonEmpty a
fromList [s]
ts) PredTrie s (r -> a)
xs
{-# INLINEABLE lookupWithLPT #-}
lookupWithLRPT :: Hashable s
=> Eq s
=> (s -> s) -> [s] -> RootedPredTrie s a -> Maybe ([s], a)
lookupWithLRPT :: forall s a.
(Hashable s, Eq s) =>
(s -> s) -> [s] -> RootedPredTrie s a -> Maybe ([s], a)
lookupWithLRPT s -> s
_ [] (RootedPredTrie Maybe a
mx PredTrie s a
_) = ([],) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mx
lookupWithLRPT s -> s
f [s]
ts (RootedPredTrie Maybe a
_ PredTrie s a
xs) = forall s a.
(Hashable s, Eq s) =>
(s -> s) -> NonEmpty s -> PredTrie s a -> Maybe ([s], a)
lookupWithLPT s -> s
f (forall a. [a] -> NonEmpty a
fromList [s]
ts) PredTrie s a
xs
{-# INLINEABLE lookupWithLRPT #-}
tell' :: Monoid w => S.MonadState w m => w -> m ()
tell' :: forall w (m :: * -> *). (Monoid w, MonadState w m) => w -> m ()
tell' w
x = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify' (forall a. Semigroup a => a -> a -> a
<> w
x)
{-# INLINEABLE tell' #-}