{-# LANGUAGE
Rank2Types
, TypeFamilies
, DeriveFunctor
, DeriveGeneric
, FlexibleContexts
, OverloadedStrings
, FlexibleInstances
, StandaloneDeriving
, UndecidableInstances
, MultiParamTypeClasses
, ExistentialQuantification
, GeneralizedNewtypeDeriving
#-}
module Network.Wai.Middleware.ContentType.Types
(
FileExt (..)
, getFileExt
, toExt
, ResponseVia (..)
, runResponseVia
, mapStatus
, mapHeaders
, FileExtMap
, FileExtListenerT (..)
, execFileExtListenerT
, overFileExts
, mapFileExtMap
, getLogger
,
tell'
, AcceptHeader
, possibleFileExts
, invalidEncoding
) where
import qualified Data.Text as T
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HM
import Data.Semigroup (Semigroup)
import Data.Monoid ((<>))
import Data.Maybe (fromMaybe)
import Data.Url (MonadUrl)
import Data.Hashable (Hashable)
import qualified Data.ByteString as BS
import Data.Functor.Compose (Compose)
import Control.Monad (MonadPlus)
import Control.Applicative (Alternative)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.Base (MonadBase (..))
import Control.Monad.Catch (MonadMask, MonadCatch, MonadThrow)
import Control.Monad.Cont (MonadCont)
import Control.Monad.Except (MonadError)
import Control.Monad.Trans.Control (MonadTransControl (..), MonadBaseControl (..), ComposeSt, defaultRestoreM, defaultLiftBaseWith)
import qualified Control.Monad.Trans.Control.Aligned as Aligned
import Control.Monad.Trans.Resource (MonadResource)
import Control.Monad.State (StateT (..), MonadState, get, put, execStateT, modify')
import Control.Monad.Writer (MonadWriter)
import Control.Monad.Reader (ReaderT (..), MonadReader (..))
import Control.Monad.Logger (MonadLogger (..))
import GHC.Generics (Generic)
import Network.HTTP.Types (Status, ResponseHeaders)
import Network.HTTP.Media (mapAccept)
import Network.Wai (Response)
tell' :: (Monoid w, 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 ()
modify' (forall a. Semigroup a => a -> a -> a
<> w
x)
{-# INLINEABLE tell' #-}
data FileExt
= Html
| Css
| JavaScript
| Json
| Text
| Markdown
| Other {-# UNPACK #-} !T.Text
deriving (Int -> FileExt -> ShowS
[FileExt] -> ShowS
FileExt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileExt] -> ShowS
$cshowList :: [FileExt] -> ShowS
show :: FileExt -> String
$cshow :: FileExt -> String
showsPrec :: Int -> FileExt -> ShowS
$cshowsPrec :: Int -> FileExt -> ShowS
Show, FileExt -> FileExt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileExt -> FileExt -> Bool
$c/= :: FileExt -> FileExt -> Bool
== :: FileExt -> FileExt -> Bool
$c== :: FileExt -> FileExt -> Bool
Eq, Eq FileExt
FileExt -> FileExt -> Bool
FileExt -> FileExt -> Ordering
FileExt -> FileExt -> FileExt
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 :: FileExt -> FileExt -> FileExt
$cmin :: FileExt -> FileExt -> FileExt
max :: FileExt -> FileExt -> FileExt
$cmax :: FileExt -> FileExt -> FileExt
>= :: FileExt -> FileExt -> Bool
$c>= :: FileExt -> FileExt -> Bool
> :: FileExt -> FileExt -> Bool
$c> :: FileExt -> FileExt -> Bool
<= :: FileExt -> FileExt -> Bool
$c<= :: FileExt -> FileExt -> Bool
< :: FileExt -> FileExt -> Bool
$c< :: FileExt -> FileExt -> Bool
compare :: FileExt -> FileExt -> Ordering
$ccompare :: FileExt -> FileExt -> Ordering
Ord, forall x. Rep FileExt x -> FileExt
forall x. FileExt -> Rep FileExt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileExt x -> FileExt
$cfrom :: forall x. FileExt -> Rep FileExt x
Generic)
instance Hashable FileExt
getFileExt :: [T.Text] -> Maybe FileExt
getFileExt :: [Text] -> Maybe FileExt
getFileExt [Text]
chunks = case [Text]
chunks of
[] -> forall a. Maybe a
Nothing
[Text]
xs -> (Text, Text) -> Maybe FileExt
toExt (Text -> Text -> (Text, Text)
T.breakOnEnd Text
"." (forall a. [a] -> a
last [Text]
xs))
{-# INLINEABLE getFileExt #-}
toExt :: (T.Text, T.Text) -> Maybe FileExt
toExt :: (Text, Text) -> Maybe FileExt
toExt (Text
y,Text
x)
| Text
x forall a. Eq a => a -> a -> Bool
== Text
""
Bool -> Bool -> Bool
|| Text -> Int
T.length Text
y forall a. Eq a => a -> a -> Bool
== Int
0
Bool -> Bool -> Bool
|| Text -> Char
T.last Text
y forall a. Eq a => a -> a -> Bool
/= Char
'.' = forall a. Maybe a
Nothing
| Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
htmls = forall a. a -> Maybe a
Just FileExt
Html
| Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
csss = forall a. a -> Maybe a
Just FileExt
Css
| Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
javascripts = forall a. a -> Maybe a
Just FileExt
JavaScript
| Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
jsons = forall a. a -> Maybe a
Just FileExt
Json
| Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
texts = forall a. a -> Maybe a
Just FileExt
Text
| Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
markdowns = forall a. a -> Maybe a
Just FileExt
Markdown
| Bool
otherwise = forall a. a -> Maybe a
Just (Text -> FileExt
Other Text
x)
where
htmls :: [Text]
htmls = [Text
"htm", Text
"html"]
csss :: [Text]
csss = [Text
"css"]
javascripts :: [Text]
javascripts = [Text
"js", Text
"javascript"]
jsons :: [Text]
jsons = [Text
"json"]
texts :: [Text]
texts = [Text
"txt"]
markdowns :: [Text]
markdowns = [Text
"md", Text
"markdown"]
{-# INLINEABLE toExt #-}
data ResponseVia = forall a. ResponseVia
{ ()
responseData :: !a
, ResponseVia -> Status
responseStatus :: {-# UNPACK #-} !Status
, :: !ResponseHeaders
, ()
responseFunction :: !(a -> Status -> ResponseHeaders -> Response)
}
runResponseVia :: ResponseVia -> Response
runResponseVia :: ResponseVia -> Response
runResponseVia (ResponseVia a
d Status
s ResponseHeaders
hs a -> Status -> ResponseHeaders -> Response
f) = a -> Status -> ResponseHeaders -> Response
f a
d Status
s ResponseHeaders
hs
mapStatus :: (Status -> Status) -> ResponseVia -> ResponseVia
mapStatus :: (Status -> Status) -> ResponseVia -> ResponseVia
mapStatus Status -> Status
f (ResponseVia a
d Status
s ResponseHeaders
hs a -> Status -> ResponseHeaders -> Response
f') = forall a.
a
-> Status
-> ResponseHeaders
-> (a -> Status -> ResponseHeaders -> Response)
-> ResponseVia
ResponseVia a
d (Status -> Status
f Status
s) ResponseHeaders
hs a -> Status -> ResponseHeaders -> Response
f'
mapHeaders :: (ResponseHeaders -> ResponseHeaders) -> ResponseVia -> ResponseVia
ResponseHeaders -> ResponseHeaders
f (ResponseVia a
d Status
s ResponseHeaders
hs a -> Status -> ResponseHeaders -> Response
f') = forall a.
a
-> Status
-> ResponseHeaders
-> (a -> Status -> ResponseHeaders -> Response)
-> ResponseVia
ResponseVia a
d Status
s (ResponseHeaders -> ResponseHeaders
f ResponseHeaders
hs) a -> Status -> ResponseHeaders -> Response
f'
overFileExts :: Monad m =>
[FileExt]
-> (ResponseVia -> ResponseVia)
-> FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m a
overFileExts :: forall (m :: * -> *) urlbase a.
Monad m =>
[FileExt]
-> (ResponseVia -> ResponseVia)
-> FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m a
overFileExts [FileExt]
fs ResponseVia -> ResponseVia
f (FileExtListenerT (ReaderT (Status -> Maybe Integer -> IO ())
-> StateT (HashMap FileExt ResponseVia) m a
xs)) = do
Status -> Maybe Integer -> IO ()
aplogger <- forall (m :: * -> *) urlbase.
Monad m =>
FileExtListenerT urlbase m (Status -> Maybe Integer -> IO ())
getLogger
HashMap FileExt ResponseVia
i <- forall s (m :: * -> *). MonadState s m => m s
get
let i' :: HashMap FileExt ResponseVia
i' = forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey (\FileExt
k ResponseVia
x -> if FileExt
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FileExt]
fs then ResponseVia -> ResponseVia
f ResponseVia
x else ResponseVia
x) HashMap FileExt ResponseVia
i
(a
x, HashMap FileExt ResponseVia
o) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((Status -> Maybe Integer -> IO ())
-> StateT (HashMap FileExt ResponseVia) m a
xs Status -> Maybe Integer -> IO ()
aplogger) HashMap FileExt ResponseVia
i')
forall s (m :: * -> *). MonadState s m => s -> m ()
put HashMap FileExt ResponseVia
o
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
type FileExtMap = HashMap FileExt ResponseVia
newtype FileExtListenerT urlbase m a = FileExtListenerT
{ forall urlbase (m :: * -> *) a.
FileExtListenerT urlbase m a
-> ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
runFileExtListenerT :: ReaderT (Status -> Maybe Integer -> IO ()) (StateT FileExtMap m) a
} deriving ( forall a b.
a -> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m a
forall a b.
(a -> b)
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m b
forall urlbase (m :: * -> *) a b.
Functor m =>
a -> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m a
forall urlbase (m :: * -> *) a b.
Functor m =>
(a -> b)
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b.
a -> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m a
$c<$ :: forall urlbase (m :: * -> *) a b.
Functor m =>
a -> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m a
fmap :: forall a b.
(a -> b)
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m b
$cfmap :: forall urlbase (m :: * -> *) a b.
Functor m =>
(a -> b)
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m b
Functor, forall a. a -> FileExtListenerT urlbase m a
forall a b.
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m a
forall a b.
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m b
forall a b.
FileExtListenerT urlbase m (a -> b)
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m b
forall a b c.
(a -> b -> c)
-> FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b
-> FileExtListenerT urlbase m c
forall {urlbase} {m :: * -> *}.
Monad m =>
Functor (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *) a.
Monad m =>
a -> FileExtListenerT urlbase m a
forall urlbase (m :: * -> *) a b.
Monad m =>
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m a
forall urlbase (m :: * -> *) a b.
Monad m =>
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m b
forall urlbase (m :: * -> *) a b.
Monad m =>
FileExtListenerT urlbase m (a -> b)
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m b
forall urlbase (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b
-> FileExtListenerT urlbase m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m a
$c<* :: forall urlbase (m :: * -> *) a b.
Monad m =>
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m a
*> :: forall a b.
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m b
$c*> :: forall urlbase (m :: * -> *) a b.
Monad m =>
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m b
liftA2 :: forall a b c.
(a -> b -> c)
-> FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b
-> FileExtListenerT urlbase m c
$cliftA2 :: forall urlbase (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b
-> FileExtListenerT urlbase m c
<*> :: forall a b.
FileExtListenerT urlbase m (a -> b)
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m b
$c<*> :: forall urlbase (m :: * -> *) a b.
Monad m =>
FileExtListenerT urlbase m (a -> b)
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m b
pure :: forall a. a -> FileExtListenerT urlbase m a
$cpure :: forall urlbase (m :: * -> *) a.
Monad m =>
a -> FileExtListenerT urlbase m a
Applicative, forall a. FileExtListenerT urlbase m a
forall a.
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m [a]
forall a.
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a
forall {urlbase} {m :: * -> *}.
MonadPlus m =>
Applicative (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *) a.
MonadPlus m =>
FileExtListenerT urlbase m a
forall urlbase (m :: * -> *) a.
MonadPlus m =>
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m [a]
forall urlbase (m :: * -> *) a.
MonadPlus m =>
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a.
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m [a]
$cmany :: forall urlbase (m :: * -> *) a.
MonadPlus m =>
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m [a]
some :: forall a.
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m [a]
$csome :: forall urlbase (m :: * -> *) a.
MonadPlus m =>
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m [a]
<|> :: forall a.
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a
$c<|> :: forall urlbase (m :: * -> *) a.
MonadPlus m =>
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a
empty :: forall a. FileExtListenerT urlbase m a
$cempty :: forall urlbase (m :: * -> *) a.
MonadPlus m =>
FileExtListenerT urlbase m a
Alternative, forall a. a -> FileExtListenerT urlbase m a
forall a b.
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m b
forall a b.
FileExtListenerT urlbase m a
-> (a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m b
forall urlbase (m :: * -> *).
Monad m =>
Applicative (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *) a.
Monad m =>
a -> FileExtListenerT urlbase m a
forall urlbase (m :: * -> *) a b.
Monad m =>
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m b
forall urlbase (m :: * -> *) a b.
Monad m =>
FileExtListenerT urlbase m a
-> (a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> FileExtListenerT urlbase m a
$creturn :: forall urlbase (m :: * -> *) a.
Monad m =>
a -> FileExtListenerT urlbase m a
>> :: forall a b.
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m b
$c>> :: forall urlbase (m :: * -> *) a b.
Monad m =>
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m b -> FileExtListenerT urlbase m b
>>= :: forall a b.
FileExtListenerT urlbase m a
-> (a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m b
$c>>= :: forall urlbase (m :: * -> *) a b.
Monad m =>
FileExtListenerT urlbase m a
-> (a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m b
Monad, forall a.
(a -> FileExtListenerT urlbase m a) -> FileExtListenerT urlbase m a
forall {urlbase} {m :: * -> *}.
MonadFix m =>
Monad (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *) a.
MonadFix m =>
(a -> FileExtListenerT urlbase m a) -> FileExtListenerT urlbase m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a.
(a -> FileExtListenerT urlbase m a) -> FileExtListenerT urlbase m a
$cmfix :: forall urlbase (m :: * -> *) a.
MonadFix m =>
(a -> FileExtListenerT urlbase m a) -> FileExtListenerT urlbase m a
MonadFix, forall a. FileExtListenerT urlbase m a
forall a.
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a
forall {urlbase} {m :: * -> *}.
MonadPlus m =>
Monad (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *).
MonadPlus m =>
Alternative (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *) a.
MonadPlus m =>
FileExtListenerT urlbase m a
forall urlbase (m :: * -> *) a.
MonadPlus m =>
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a.
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a
$cmplus :: forall urlbase (m :: * -> *) a.
MonadPlus m =>
FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a
mzero :: forall a. FileExtListenerT urlbase m a
$cmzero :: forall urlbase (m :: * -> *) a.
MonadPlus m =>
FileExtListenerT urlbase m a
MonadPlus, forall a. IO a -> FileExtListenerT urlbase m a
forall {urlbase} {m :: * -> *}.
MonadIO m =>
Monad (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *) a.
MonadIO m =>
IO a -> FileExtListenerT urlbase m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> FileExtListenerT urlbase m a
$cliftIO :: forall urlbase (m :: * -> *) a.
MonadIO m =>
IO a -> FileExtListenerT urlbase m a
MonadIO
, MonadWriter w, MonadState FileExtMap
, forall a b.
((a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m a
forall {urlbase} {m :: * -> *}.
MonadCont m =>
Monad (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *) a b.
MonadCont m =>
((a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
callCC :: forall a b.
((a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m a
$ccallCC :: forall urlbase (m :: * -> *) a b.
MonadCont m =>
((a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m a
MonadCont, MonadError e, MonadBase b, forall e a. Exception e => e -> FileExtListenerT urlbase m a
forall {urlbase} {m :: * -> *}.
MonadThrow m =>
Monad (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> FileExtListenerT urlbase m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> FileExtListenerT urlbase m a
$cthrowM :: forall urlbase (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> FileExtListenerT urlbase m a
MonadThrow, forall e a.
Exception e =>
FileExtListenerT urlbase m a
-> (e -> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m a
forall {urlbase} {m :: * -> *}.
MonadCatch m =>
MonadThrow (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
FileExtListenerT urlbase m a
-> (e -> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
FileExtListenerT urlbase m a
-> (e -> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m a
$ccatch :: forall urlbase (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
FileExtListenerT urlbase m a
-> (e -> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m a
MonadCatch
, forall b.
((forall a.
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m b
forall a b c.
FileExtListenerT urlbase m a
-> (a -> ExitCase b -> FileExtListenerT urlbase m c)
-> (a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m (b, c)
forall {urlbase} {m :: * -> *}.
MonadMask m =>
MonadCatch (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *) b.
MonadMask m =>
((forall a.
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m b
forall urlbase (m :: * -> *) a b c.
MonadMask m =>
FileExtListenerT urlbase m a
-> (a -> ExitCase b -> FileExtListenerT urlbase m c)
-> (a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
FileExtListenerT urlbase m a
-> (a -> ExitCase b -> FileExtListenerT urlbase m c)
-> (a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m (b, c)
$cgeneralBracket :: forall urlbase (m :: * -> *) a b c.
MonadMask m =>
FileExtListenerT urlbase m a
-> (a -> ExitCase b -> FileExtListenerT urlbase m c)
-> (a -> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m (b, c)
uninterruptibleMask :: forall b.
((forall a.
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m b
$cuninterruptibleMask :: forall urlbase (m :: * -> *) b.
MonadMask m =>
((forall a.
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m b
mask :: forall b.
((forall a.
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m b
$cmask :: forall urlbase (m :: * -> *) b.
MonadMask m =>
((forall a.
FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a)
-> FileExtListenerT urlbase m b)
-> FileExtListenerT urlbase m b
MonadMask, forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> FileExtListenerT urlbase m ()
forall {urlbase} {m :: * -> *}.
MonadLogger m =>
Monad (FileExtListenerT urlbase m)
forall urlbase (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> FileExtListenerT urlbase m ()
forall (m :: * -> *).
Monad m
-> (forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> m ())
-> MonadLogger m
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> FileExtListenerT urlbase m ()
$cmonadLoggerLog :: forall urlbase (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> FileExtListenerT urlbase m ()
MonadLogger, MonadUrl urlbase
)
getLogger :: Monad m => FileExtListenerT urlbase m (Status -> Maybe Integer -> IO ())
getLogger :: forall (m :: * -> *) urlbase.
Monad m =>
FileExtListenerT urlbase m (Status -> Maybe Integer -> IO ())
getLogger = forall urlbase (m :: * -> *) a.
ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
-> FileExtListenerT urlbase m a
FileExtListenerT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall (f :: * -> *) a. Applicative f => a -> f a
pure)
instance Aligned.MonadTransControl (FileExtListenerT urlbase) ((,) FileExtMap) where
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (FileExtListenerT urlbase) ((,) (HashMap FileExt ResponseVia))
-> m a)
-> FileExtListenerT urlbase m a
liftWith Run (FileExtListenerT urlbase) ((,) (HashMap FileExt ResponseVia))
-> m a
client = forall urlbase (m :: * -> *) a.
ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
-> FileExtListenerT urlbase m a
FileExtListenerT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Status -> Maybe Integer -> IO ()
env -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \HashMap FileExt ResponseVia
s ->
let run :: forall urlbase m a. Monad m => FileExtListenerT urlbase m a -> m (FileExtMap, a)
run :: forall urlbase (m :: * -> *) a.
Monad m =>
FileExtListenerT urlbase m a -> m (HashMap FileExt ResponseVia, a)
run (FileExtListenerT (ReaderT (Status -> Maybe Integer -> IO ())
-> StateT (HashMap FileExt ResponseVia) m a
f)) =
let (StateT HashMap FileExt ResponseVia -> m (a, HashMap FileExt ResponseVia)
g) = (Status -> Maybe Integer -> IO ())
-> StateT (HashMap FileExt ResponseVia) m a
f Status -> Maybe Integer -> IO ()
env
in do (a
x, HashMap FileExt ResponseVia
s') <- HashMap FileExt ResponseVia -> m (a, HashMap FileExt ResponseVia)
g HashMap FileExt ResponseVia
s
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap FileExt ResponseVia
s', a
x)
in do a
x <- Run (FileExtListenerT urlbase) ((,) (HashMap FileExt ResponseVia))
-> m a
client forall urlbase (m :: * -> *) a.
Monad m =>
FileExtListenerT urlbase m a -> m (HashMap FileExt ResponseVia, a)
run
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, HashMap FileExt ResponseVia
s)
restoreT :: forall (m :: * -> *) a.
Monad m =>
m (HashMap FileExt ResponseVia, a) -> FileExtListenerT urlbase m a
restoreT m (HashMap FileExt ResponseVia, a)
mx = forall urlbase (m :: * -> *) a.
ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
-> FileExtListenerT urlbase m a
FileExtListenerT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Status -> Maybe Integer -> IO ()
_ -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \HashMap FileExt ResponseVia
_ -> do
(HashMap FileExt ResponseVia
s',a
x) <- m (HashMap FileExt ResponseVia, a)
mx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x,HashMap FileExt ResponseVia
s')
instance ( Aligned.MonadBaseControl b m stM
) => Aligned.MonadBaseControl b
(FileExtListenerT urlbase m) (Compose stM ((,) FileExtMap)) where
liftBaseWith :: forall a.
(RunInBase
(FileExtListenerT urlbase m)
b
(Compose stM ((,) (HashMap FileExt ResponseVia)))
-> b a)
-> FileExtListenerT urlbase m a
liftBaseWith = forall (t :: (* -> *) -> * -> *) (stT :: * -> *) (b :: * -> *)
(m :: * -> *) (stM :: * -> *) a.
(MonadTransControl t stT, MonadBaseControl b m stM) =>
(RunInBaseDefault t m b stM stT -> b a) -> t m a
Aligned.defaultLiftBaseWith
restoreM :: forall a.
Compose stM ((,) (HashMap FileExt ResponseVia)) a
-> FileExtListenerT urlbase m a
restoreM = forall (t :: (* -> *) -> * -> *) (stT :: * -> *) (b :: * -> *)
(m :: * -> *) (stM :: * -> *) a.
(MonadTransControl t stT, MonadBaseControl b m stM) =>
Compose stM stT a -> t m a
Aligned.defaultRestoreM
instance MonadTrans (FileExtListenerT urlbase) where
lift :: forall (m :: * -> *) a.
Monad m =>
m a -> FileExtListenerT urlbase m a
lift m a
m = forall urlbase (m :: * -> *) a.
ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
-> FileExtListenerT urlbase m a
FileExtListenerT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\Status -> Maybe Integer -> IO ()
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m))
instance MonadReader r m => MonadReader r (FileExtListenerT urlbase m) where
ask :: FileExtListenerT urlbase m r
ask = forall urlbase (m :: * -> *) a.
ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
-> FileExtListenerT urlbase m a
FileExtListenerT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (forall a b. a -> b -> a
const forall r (m :: * -> *). MonadReader r m => m r
ask))
local :: forall a.
(r -> r)
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a
local r -> r
f (FileExtListenerT (ReaderT (Status -> Maybe Integer -> IO ())
-> StateT (HashMap FileExt ResponseVia) m a
g)) = forall urlbase (m :: * -> *) a.
ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
-> FileExtListenerT urlbase m a
FileExtListenerT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Status -> Maybe Integer -> IO ()
x -> forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f ((Status -> Maybe Integer -> IO ())
-> StateT (HashMap FileExt ResponseVia) m a
g Status -> Maybe Integer -> IO ()
x)
instance Monad m => Semigroup (FileExtListenerT urlbase m ()) where
FileExtListenerT urlbase m ()
x <> :: FileExtListenerT urlbase m ()
-> FileExtListenerT urlbase m () -> FileExtListenerT urlbase m ()
<> FileExtListenerT urlbase m ()
y = FileExtListenerT urlbase m ()
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FileExtListenerT urlbase m ()
y
instance Monad m => Monoid (FileExtListenerT urlbase m ()) where
mempty :: FileExtListenerT urlbase m ()
mempty = forall urlbase (m :: * -> *) a.
ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
-> FileExtListenerT urlbase m a
FileExtListenerT (forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a. Monoid a => a
mempty)
deriving instance (MonadResource m, MonadBase IO m) => MonadResource (FileExtListenerT urlbase m)
instance MonadTransControl (FileExtListenerT urlbase) where
type StT (FileExtListenerT urlbase) a = StT (StateT FileExtMap)
(StT (ReaderT (Status -> Maybe Integer -> IO ())) a)
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (FileExtListenerT urlbase) -> m a)
-> FileExtListenerT urlbase m a
liftWith Run (FileExtListenerT urlbase) -> m a
f = forall urlbase (m :: * -> *) a.
ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
-> FileExtListenerT urlbase m a
FileExtListenerT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Status -> Maybe Integer -> IO ()
aplogger -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run (StateT (HashMap FileExt ResponseVia))
runInBase ->
Run (FileExtListenerT urlbase) -> m a
f (\(FileExtListenerT (ReaderT (Status -> Maybe Integer -> IO ())
-> StateT (HashMap FileExt ResponseVia) n b
xs)) -> Run (StateT (HashMap FileExt ResponseVia))
runInBase ((Status -> Maybe Integer -> IO ())
-> StateT (HashMap FileExt ResponseVia) n b
xs Status -> Maybe Integer -> IO ()
aplogger))
restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (FileExtListenerT urlbase) a)
-> FileExtListenerT urlbase m a
restoreT m (StT (FileExtListenerT urlbase) a)
x = forall urlbase (m :: * -> *) a.
ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
-> FileExtListenerT urlbase m a
FileExtListenerT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Status -> Maybe Integer -> IO ()
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT m (StT (FileExtListenerT urlbase) a)
x
instance ( MonadBaseControl b m
) => MonadBaseControl b (FileExtListenerT urlbase m) where
type StM (FileExtListenerT urlbase m) a = ComposeSt (FileExtListenerT urlbase) m a
liftBaseWith :: forall a.
(RunInBase (FileExtListenerT urlbase m) b -> b a)
-> FileExtListenerT urlbase m a
liftBaseWith = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
restoreM :: forall a.
StM (FileExtListenerT urlbase m) a -> FileExtListenerT urlbase m a
restoreM = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
execFileExtListenerT :: Monad m
=> FileExtListenerT urlbase m a
-> Maybe (Status -> Maybe Integer -> IO ())
-> m FileExtMap
execFileExtListenerT :: forall (m :: * -> *) urlbase a.
Monad m =>
FileExtListenerT urlbase m a
-> Maybe (Status -> Maybe Integer -> IO ())
-> m (HashMap FileExt ResponseVia)
execFileExtListenerT FileExtListenerT urlbase m a
xs Maybe (Status -> Maybe Integer -> IO ())
mL =
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT
( forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall urlbase (m :: * -> *) a.
FileExtListenerT urlbase m a
-> ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
runFileExtListenerT FileExtListenerT urlbase m a
xs)
(forall a. a -> Maybe a -> a
fromMaybe (\Status
_ Maybe Integer
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Maybe (Status -> Maybe Integer -> IO ())
mL)
) forall a. Monoid a => a
mempty
mapFileExtMap :: ( Monad m
) => (FileExtMap -> FileExtMap)
-> FileExtListenerT urlbase m a
-> FileExtListenerT urlbase m a
mapFileExtMap :: forall (m :: * -> *) urlbase a.
Monad m =>
(HashMap FileExt ResponseVia -> HashMap FileExt ResponseVia)
-> FileExtListenerT urlbase m a -> FileExtListenerT urlbase m a
mapFileExtMap HashMap FileExt ResponseVia -> HashMap FileExt ResponseVia
f (FileExtListenerT ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
xs) = do
Status -> Maybe Integer -> IO ()
aplogger <- forall (m :: * -> *) urlbase.
Monad m =>
FileExtListenerT urlbase m (Status -> Maybe Integer -> IO ())
getLogger
HashMap FileExt ResponseVia
m <- forall s (m :: * -> *). MonadState s m => m s
get
(a
x,HashMap FileExt ResponseVia
m') <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
(Status -> Maybe Integer -> IO ())
(StateT (HashMap FileExt ResponseVia) m)
a
xs Status -> Maybe Integer -> IO ()
aplogger) (HashMap FileExt ResponseVia -> HashMap FileExt ResponseVia
f HashMap FileExt ResponseVia
m))
forall s (m :: * -> *). MonadState s m => s -> m ()
put HashMap FileExt ResponseVia
m'
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
type = BS.ByteString
{-# INLINEABLE execFileExtListenerT #-}
possibleFileExts :: [FileExt] -> AcceptHeader -> [FileExt]
possibleFileExts :: [FileExt] -> ByteString -> [FileExt]
possibleFileExts [FileExt]
allFileExts ByteString
accept = if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileExt]
wildcard) then [FileExt]
wildcard else [FileExt]
computed
where
computed :: [FileExt]
computed :: [FileExt]
computed = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$
forall a b. Accept a => [(a, b)] -> ByteString -> Maybe b
mapAccept [ ( ByteString
"application/json" :: BS.ByteString
, [FileExt
Json]
)
, ( ByteString
"application/javascript" :: BS.ByteString
, [FileExt
JavaScript,FileExt
Json]
)
, ( ByteString
"text/html" :: BS.ByteString
, [FileExt
Html]
)
, ( ByteString
"text/css" :: BS.ByteString
, [FileExt
Css]
)
, ( ByteString
"text/markdown" :: BS.ByteString
, [FileExt
Markdown]
)
, ( ByteString
"text/plain" :: BS.ByteString
, [FileExt
Text, FileExt
Markdown]
)
] ByteString
accept
wildcard :: [FileExt]
wildcard :: [FileExt]
wildcard = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$
forall a b. Accept a => [(a, b)] -> ByteString -> Maybe b
mapAccept [ (ByteString
"*/*" :: BS.ByteString
, [FileExt]
allFileExts
)
] ByteString
accept
{-# INLINEABLE possibleFileExts #-}
invalidEncoding :: Monad m => ResponseVia -> FileExtListenerT urlbase m ()
invalidEncoding :: forall (m :: * -> *) urlbase.
Monad m =>
ResponseVia -> FileExtListenerT urlbase m ()
invalidEncoding ResponseVia
r = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\FileExt
t -> forall w (m :: * -> *). (Monoid w, MonadState w m) => w -> m ()
tell' (forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton FileExt
t ResponseVia
r)) [FileExt
Html,FileExt
Css,FileExt
JavaScript,FileExt
Json,FileExt
Text,FileExt
Markdown]
{-# INLINEABLE invalidEncoding #-}