{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedLists            #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeSynonymInstances       #-}
{-# LANGUAGE UndecidableInstances       #-}

-- |
-- Module      :  Data.Url
-- Copyright   :  (c) Athan L. Clark
-- License     :  MIT
--
-- Maintainer  :  Athan L. Clark <athan.clark@gmail.com>
-- Stability   :  experimental
-- Portability :  GHC
--
-- This library helps us distinguish how we present URLs - we might show them
-- relatively, absolutely (with the URI authority - scheme, port, hostname, etc.),
-- or /grounded/ - where the path begins with @/@.
--
-- We leverage Chris Done's <https://hackage.haskell.org/package/path path>
-- library to distinguish relative vs. grounded paths at compile time, and provide
-- some additional features like a file extension and query parameters in
-- <https://hackage.haskell.org/package/path-extra path-extra>.

module Data.Url where

import           Path                                (Abs, Path, Rel, absdir,
                                                      parseAbsDir, parseRelDir,
                                                      parseRelFile, toFilePath,
                                                      (</>))
import           Path.Extended                       (Location (..),
                                                      LocationPath,
                                                      printLocation,
                                                      setFragment, (<&>))
import qualified Path.Extended                       as Path

import           Control.Applicative                 (Alternative (empty, (<|>)))
import           Control.Monad                       (MonadPlus)
import           Control.Monad.Base                  (MonadBase (liftBase),
                                                      liftBaseDefault)
import           Control.Monad.Catch                 (ExitCase (ExitCaseSuccess),
                                                      MonadCatch (catch),
                                                      MonadMask (generalBracket, mask, uninterruptibleMask),
                                                      MonadThrow (throwM))
import           Control.Monad.Cont                  (ContT, MonadCont (callCC))
import           Control.Monad.Except                (ExceptT,
                                                      MonadError (catchError, throwError))
import           Control.Monad.Fix                   (MonadFix)
import           Control.Monad.IO.Class              (MonadIO (liftIO))
import           Control.Monad.List                  (ListT)
import           Control.Monad.Logger                (LoggingT,
                                                      MonadLogger (monadLoggerLog),
                                                      NoLoggingT)
import           Control.Monad.Morph                 (MFunctor (hoist),
                                                      MMonad (embed))
import           Control.Monad.Reader                (MonadReader (ask, local),
                                                      ReaderT)
import           Control.Monad.RWS                   (MonadRWS, RWST)
import           Control.Monad.State                 (MonadState (get, put),
                                                      StateT)
import           Control.Monad.Trans                 (MonadTrans (lift))
import           Control.Monad.Trans.Control         (ComposeSt,
                                                      MonadBaseControl (StM, liftBaseWith, restoreM),
                                                      MonadTransControl (StT, liftWith, restoreT),
                                                      defaultLiftBaseWith,
                                                      defaultRestoreM)
import qualified Control.Monad.Trans.Control.Aligned as Aligned
import           Control.Monad.Trans.Error           (Error, ErrorT)
import           Control.Monad.Trans.Identity        (IdentityT)
import           Control.Monad.Trans.Maybe           (MaybeT)
import           Control.Monad.Trans.Resource        (MonadResource (liftResourceT),
                                                      ResourceT)
import           Control.Monad.Writer                (MonadWriter (listen, pass, tell),
                                                      WriterT)
import           Data.Functor.Compose                (Compose)
import           Data.Functor.Identity               (Identity (..))
import           Data.List.Split                     (splitOn)
import qualified Data.Strict.Maybe                   as Strict
import qualified Data.Strict.Tuple                   as Strict
import qualified Data.Text                           as T
import           Data.URI                            (URI (..), printURI)
import qualified Data.URI                            as URI
import           Data.URI.Auth                       (URIAuth (..))
import           Data.URI.Auth.Host                  (URIAuthHost (Localhost))
import qualified Data.Vector                         as V
import           System.IO.Unsafe                    (unsafePerformIO)
import           Unsafe.Coerce                       (unsafeCoerce)



-- * Classes

-- | Turns a 'Path' or 'Location' into a 'String', where the rendering behavior
-- (relative, grounded and absolute) is encoded in the monad you use, much like
-- @LoggingT@ and @NoLoggingT@ from <https://hackage.haskell.org/package/monad-logger monad-logger>.
class MonadUrl (m :: * -> *) base | m -> base where
  -- | Create a 'URL' from a 'Location' - either a directory or file, and can include query strings
  -- & fragments.
  locToUrl :: Location base -> m URL

-- | Treated as relative urls
instance MonadUrl IO Rel where
  locToUrl :: Location Rel -> IO URL
locToUrl = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location Rel -> URL
RelURL

instance ( MonadUrl m base
         , Monad m
         ) => MonadUrl (MaybeT m) base where
  locToUrl :: Location base -> MaybeT m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         ) => MonadUrl (ListT m) base where
  locToUrl :: Location base -> ListT m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         ) => MonadUrl (ResourceT m) base where
  locToUrl :: Location base -> ResourceT m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         ) => MonadUrl (IdentityT m) base where
  locToUrl :: Location base -> IdentityT m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         ) => MonadUrl (LoggingT m) base where
  locToUrl :: Location base -> LoggingT m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         ) => MonadUrl (NoLoggingT m) base where
  locToUrl :: Location base -> NoLoggingT m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         ) => MonadUrl (ReaderT r m) base where
  locToUrl :: Location base -> ReaderT r m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         , Monoid w
         ) => MonadUrl (WriterT w m) base where
  locToUrl :: Location base -> WriterT w m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         ) => MonadUrl (StateT s m) base where
  locToUrl :: Location base -> StateT s m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         , Error e
         ) => MonadUrl (ErrorT e m) base where
  locToUrl :: Location base -> ErrorT e m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         ) => MonadUrl (ContT r m) base where
  locToUrl :: Location base -> ContT r m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         ) => MonadUrl (ExceptT e m) base where
  locToUrl :: Location base -> ExceptT e m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl

instance ( MonadUrl m base
         , Monad m
         , Monoid w
         ) => MonadUrl (RWST r w s m) base where
  locToUrl :: Location base -> RWST r w s m URL
locToUrl     = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) base.
MonadUrl m base =>
Location base -> m URL
locToUrl


-- * Types

-- ** URL

-- | Either a URI (which could include a hostname), or a relative url.
data URL = AbsURL URI | RelURL (Location Rel)

printURL :: URL -> T.Text
printURL :: URL -> Text
printURL URL
x = case URL
x of
  AbsURL URI
y -> URI -> Text
printURI URI
y
  RelURL Location Rel
y -> forall base. Location base -> Text
printLocation Location Rel
y


-- ** Relative Urls

-- | When printing a 'URL' generated by a 'Location' in this context,
-- they will always omit the hostname information and print path references relatively
-- (without @./@).
newtype RelativeUrlT m a = RelativeUrlT
  { forall (m :: * -> *) a. RelativeUrlT m a -> m a
runRelativeUrlT :: m a
  } deriving ( Int -> RelativeUrlT m a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) a.
Show (m a) =>
Int -> RelativeUrlT m a -> ShowS
forall (m :: * -> *) a. Show (m a) => [RelativeUrlT m a] -> ShowS
forall (m :: * -> *) a. Show (m a) => RelativeUrlT m a -> FilePath
showList :: [RelativeUrlT m a] -> ShowS
$cshowList :: forall (m :: * -> *) a. Show (m a) => [RelativeUrlT m a] -> ShowS
show :: RelativeUrlT m a -> FilePath
$cshow :: forall (m :: * -> *) a. Show (m a) => RelativeUrlT m a -> FilePath
showsPrec :: Int -> RelativeUrlT m a -> ShowS
$cshowsPrec :: forall (m :: * -> *) a.
Show (m a) =>
Int -> RelativeUrlT m a -> ShowS
Show, RelativeUrlT m a -> RelativeUrlT m a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *) a.
Eq (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> Bool
/= :: RelativeUrlT m a -> RelativeUrlT m a -> Bool
$c/= :: forall (m :: * -> *) a.
Eq (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> Bool
== :: RelativeUrlT m a -> RelativeUrlT m a -> Bool
$c== :: forall (m :: * -> *) a.
Eq (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> Bool
Eq, RelativeUrlT m a -> RelativeUrlT m a -> Bool
RelativeUrlT m a -> RelativeUrlT m a -> Ordering
RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
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
forall {m :: * -> *} {a}. Ord (m a) => Eq (RelativeUrlT m a)
forall (m :: * -> *) a.
Ord (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> Bool
forall (m :: * -> *) a.
Ord (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> Ordering
forall (m :: * -> *) a.
Ord (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
min :: RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
$cmin :: forall (m :: * -> *) a.
Ord (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
max :: RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
$cmax :: forall (m :: * -> *) a.
Ord (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
>= :: RelativeUrlT m a -> RelativeUrlT m a -> Bool
$c>= :: forall (m :: * -> *) a.
Ord (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> Bool
> :: RelativeUrlT m a -> RelativeUrlT m a -> Bool
$c> :: forall (m :: * -> *) a.
Ord (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> Bool
<= :: RelativeUrlT m a -> RelativeUrlT m a -> Bool
$c<= :: forall (m :: * -> *) a.
Ord (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> Bool
< :: RelativeUrlT m a -> RelativeUrlT m a -> Bool
$c< :: forall (m :: * -> *) a.
Ord (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> Bool
compare :: RelativeUrlT m a -> RelativeUrlT m a -> Ordering
$ccompare :: forall (m :: * -> *) a.
Ord (m a) =>
RelativeUrlT m a -> RelativeUrlT m a -> Ordering
Ord, forall a b. a -> RelativeUrlT m b -> RelativeUrlT m a
forall a b. (a -> b) -> RelativeUrlT m a -> RelativeUrlT m b
forall (m :: * -> *) a b.
Functor m =>
a -> RelativeUrlT m b -> RelativeUrlT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RelativeUrlT m a -> RelativeUrlT 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 -> RelativeUrlT m b -> RelativeUrlT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> RelativeUrlT m b -> RelativeUrlT m a
fmap :: forall a b. (a -> b) -> RelativeUrlT m a -> RelativeUrlT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RelativeUrlT m a -> RelativeUrlT m b
Functor, forall a. a -> RelativeUrlT m a
forall a b.
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m a
forall a b.
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m b
forall a b.
RelativeUrlT m (a -> b) -> RelativeUrlT m a -> RelativeUrlT m b
forall a b c.
(a -> b -> c)
-> RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT 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 {m :: * -> *}. Applicative m => Functor (RelativeUrlT m)
forall (m :: * -> *) a. Applicative m => a -> RelativeUrlT m a
forall (m :: * -> *) a b.
Applicative m =>
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m a
forall (m :: * -> *) a b.
Applicative m =>
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m b
forall (m :: * -> *) a b.
Applicative m =>
RelativeUrlT m (a -> b) -> RelativeUrlT m a -> RelativeUrlT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m c
<* :: forall a b.
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m a
*> :: forall a b.
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m b
liftA2 :: forall a b c.
(a -> b -> c)
-> RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m c
<*> :: forall a b.
RelativeUrlT m (a -> b) -> RelativeUrlT m a -> RelativeUrlT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
RelativeUrlT m (a -> b) -> RelativeUrlT m a -> RelativeUrlT m b
pure :: forall a. a -> RelativeUrlT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> RelativeUrlT m a
Applicative, forall a. RelativeUrlT m a
forall a. RelativeUrlT m a -> RelativeUrlT m [a]
forall a. RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT 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
forall {m :: * -> *}. Alternative m => Applicative (RelativeUrlT m)
forall (m :: * -> *) a. Alternative m => RelativeUrlT m a
forall (m :: * -> *) a.
Alternative m =>
RelativeUrlT m a -> RelativeUrlT m [a]
forall (m :: * -> *) a.
Alternative m =>
RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
many :: forall a. RelativeUrlT m a -> RelativeUrlT m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
RelativeUrlT m a -> RelativeUrlT m [a]
some :: forall a. RelativeUrlT m a -> RelativeUrlT m [a]
$csome :: forall (m :: * -> *) a.
Alternative m =>
RelativeUrlT m a -> RelativeUrlT m [a]
<|> :: forall a. RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
empty :: forall a. RelativeUrlT m a
$cempty :: forall (m :: * -> *) a. Alternative m => RelativeUrlT m a
Alternative, forall a. a -> RelativeUrlT m a
forall a b.
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m b
forall a b.
RelativeUrlT m a -> (a -> RelativeUrlT m b) -> RelativeUrlT m b
forall {m :: * -> *}. Monad m => Applicative (RelativeUrlT m)
forall (m :: * -> *) a. Monad m => a -> RelativeUrlT m a
forall (m :: * -> *) a b.
Monad m =>
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m b
forall (m :: * -> *) a b.
Monad m =>
RelativeUrlT m a -> (a -> RelativeUrlT m b) -> RelativeUrlT 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 -> RelativeUrlT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> RelativeUrlT m a
>> :: forall a b.
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
RelativeUrlT m a -> RelativeUrlT m b -> RelativeUrlT m b
>>= :: forall a b.
RelativeUrlT m a -> (a -> RelativeUrlT m b) -> RelativeUrlT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
RelativeUrlT m a -> (a -> RelativeUrlT m b) -> RelativeUrlT m b
Monad, forall a. (a -> RelativeUrlT m a) -> RelativeUrlT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (RelativeUrlT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> RelativeUrlT m a) -> RelativeUrlT m a
mfix :: forall a. (a -> RelativeUrlT m a) -> RelativeUrlT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> RelativeUrlT m a) -> RelativeUrlT m a
MonadFix
             , forall a. RelativeUrlT m a
forall a. RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall {m :: * -> *}. MonadPlus m => Monad (RelativeUrlT m)
forall {m :: * -> *}. MonadPlus m => Alternative (RelativeUrlT m)
forall (m :: * -> *) a. MonadPlus m => RelativeUrlT m a
forall (m :: * -> *) a.
MonadPlus m =>
RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
mplus :: forall a. RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
RelativeUrlT m a -> RelativeUrlT m a -> RelativeUrlT m a
mzero :: forall a. RelativeUrlT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => RelativeUrlT m a
MonadPlus, forall a. IO a -> RelativeUrlT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (RelativeUrlT m)
forall (m :: * -> *) a. MonadIO m => IO a -> RelativeUrlT m a
liftIO :: forall a. IO a -> RelativeUrlT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> RelativeUrlT m a
MonadIO, MonadReader r, MonadWriter w, MonadState s
             , MonadRWS r w s, forall a b.
((a -> RelativeUrlT m b) -> RelativeUrlT m a) -> RelativeUrlT m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
forall {m :: * -> *}. MonadCont m => Monad (RelativeUrlT m)
forall (m :: * -> *) a b.
MonadCont m =>
((a -> RelativeUrlT m b) -> RelativeUrlT m a) -> RelativeUrlT m a
callCC :: forall a b.
((a -> RelativeUrlT m b) -> RelativeUrlT m a) -> RelativeUrlT m a
$ccallCC :: forall (m :: * -> *) a b.
MonadCont m =>
((a -> RelativeUrlT m b) -> RelativeUrlT m a) -> RelativeUrlT m a
MonadCont, MonadError e, MonadBase b, forall e a. Exception e => e -> RelativeUrlT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *}. MonadThrow m => Monad (RelativeUrlT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> RelativeUrlT m a
throwM :: forall e a. Exception e => e -> RelativeUrlT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> RelativeUrlT m a
MonadThrow
             , forall e a.
Exception e =>
RelativeUrlT m a -> (e -> RelativeUrlT m a) -> RelativeUrlT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall {m :: * -> *}. MonadCatch m => MonadThrow (RelativeUrlT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
RelativeUrlT m a -> (e -> RelativeUrlT m a) -> RelativeUrlT m a
catch :: forall e a.
Exception e =>
RelativeUrlT m a -> (e -> RelativeUrlT m a) -> RelativeUrlT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
RelativeUrlT m a -> (e -> RelativeUrlT m a) -> RelativeUrlT m a
MonadCatch, forall b.
((forall a. RelativeUrlT m a -> RelativeUrlT m a)
 -> RelativeUrlT m b)
-> RelativeUrlT m b
forall a b c.
RelativeUrlT m a
-> (a -> ExitCase b -> RelativeUrlT m c)
-> (a -> RelativeUrlT m b)
-> RelativeUrlT m (b, c)
forall {m :: * -> *}. MonadMask m => MonadCatch (RelativeUrlT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. RelativeUrlT m a -> RelativeUrlT m a)
 -> RelativeUrlT m b)
-> RelativeUrlT m b
forall (m :: * -> *) a b c.
MonadMask m =>
RelativeUrlT m a
-> (a -> ExitCase b -> RelativeUrlT m c)
-> (a -> RelativeUrlT m b)
-> RelativeUrlT 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.
RelativeUrlT m a
-> (a -> ExitCase b -> RelativeUrlT m c)
-> (a -> RelativeUrlT m b)
-> RelativeUrlT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
RelativeUrlT m a
-> (a -> ExitCase b -> RelativeUrlT m c)
-> (a -> RelativeUrlT m b)
-> RelativeUrlT m (b, c)
uninterruptibleMask :: forall b.
((forall a. RelativeUrlT m a -> RelativeUrlT m a)
 -> RelativeUrlT m b)
-> RelativeUrlT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. RelativeUrlT m a -> RelativeUrlT m a)
 -> RelativeUrlT m b)
-> RelativeUrlT m b
mask :: forall b.
((forall a. RelativeUrlT m a -> RelativeUrlT m a)
 -> RelativeUrlT m b)
-> RelativeUrlT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. RelativeUrlT m a -> RelativeUrlT m a)
 -> RelativeUrlT m b)
-> RelativeUrlT m b
MonadMask, forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> RelativeUrlT m ()
forall (m :: * -> *).
Monad m
-> (forall msg.
    ToLogStr msg =>
    Loc -> Text -> LogLevel -> msg -> m ())
-> MonadLogger m
forall {m :: * -> *}. MonadLogger m => Monad (RelativeUrlT m)
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> RelativeUrlT m ()
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> RelativeUrlT m ()
$cmonadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> RelativeUrlT m ()
MonadLogger)

deriving instance (MonadResource m, MonadBase IO m) => MonadResource (RelativeUrlT m)

type RelativeUrl = RelativeUrlT Identity

instance MonadTrans RelativeUrlT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> RelativeUrlT m a
lift = forall (m :: * -> *) a. m a -> RelativeUrlT m a
RelativeUrlT

instance MonadTransControl RelativeUrlT where
  type StT RelativeUrlT a = a
  liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run RelativeUrlT -> m a) -> RelativeUrlT m a
liftWith Run RelativeUrlT -> m a
f = forall (m :: * -> *) a. m a -> RelativeUrlT m a
RelativeUrlT (Run RelativeUrlT -> m a
f forall (m :: * -> *) a. RelativeUrlT m a -> m a
runRelativeUrlT)
  restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT RelativeUrlT a) -> RelativeUrlT m a
restoreT = forall (m :: * -> *) a. m a -> RelativeUrlT m a
RelativeUrlT

instance Aligned.MonadTransControl RelativeUrlT Identity where
  liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run RelativeUrlT Identity -> m a) -> RelativeUrlT m a
liftWith Run RelativeUrlT Identity -> m a
f = forall (m :: * -> *) a. m a -> RelativeUrlT m a
RelativeUrlT (Run RelativeUrlT Identity -> m a
f (\RelativeUrlT n b
x -> forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. RelativeUrlT m a -> m a
runRelativeUrlT RelativeUrlT n b
x))
  restoreT :: forall (m :: * -> *) a.
Monad m =>
m (Identity a) -> RelativeUrlT m a
restoreT m (Identity a)
x = forall (m :: * -> *) a. m a -> RelativeUrlT m a
RelativeUrlT (forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Identity a)
x)

instance ( MonadBaseControl b m
         ) => MonadBaseControl b (RelativeUrlT m) where
  type StM (RelativeUrlT m) a = ComposeSt RelativeUrlT m a
  liftBaseWith :: forall a. (RunInBase (RelativeUrlT m) b -> b a) -> RelativeUrlT 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 (RelativeUrlT m) a -> RelativeUrlT m a
restoreM = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

instance ( Aligned.MonadBaseControl b m stM
         ) => Aligned.MonadBaseControl b (RelativeUrlT m) (Compose stM Identity) where
  liftBaseWith :: forall a.
(RunInBase (RelativeUrlT m) b (Compose stM Identity) -> b a)
-> RelativeUrlT 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 Identity a -> RelativeUrlT 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 MFunctor RelativeUrlT where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> RelativeUrlT m b -> RelativeUrlT n b
hoist forall a. m a -> n a
f (RelativeUrlT m b
x) = forall (m :: * -> *) a. m a -> RelativeUrlT m a
RelativeUrlT (forall a. m a -> n a
f m b
x)

instance MMonad RelativeUrlT where
  embed :: forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> RelativeUrlT n a)
-> RelativeUrlT m b -> RelativeUrlT n b
embed forall a. m a -> RelativeUrlT n a
f RelativeUrlT m b
x = forall a. m a -> RelativeUrlT n a
f (forall (m :: * -> *) a. RelativeUrlT m a -> m a
runRelativeUrlT RelativeUrlT m b
x)


instance ( Applicative m
         ) => MonadUrl (RelativeUrlT m) Rel where
  locToUrl :: Location Rel -> RelativeUrlT m URL
locToUrl = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location Rel -> URL
RelURL


-- ** Grounded Urls

-- | "Grounded" urls mean that, while omiting host information, paths start with
-- a @/@, like @/foo@.
newtype GroundedUrlT m a = GroundedUrlT
  { forall (m :: * -> *) a. GroundedUrlT m a -> m a
runGroundedUrlT :: m a
  } deriving ( Int -> GroundedUrlT m a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) a.
Show (m a) =>
Int -> GroundedUrlT m a -> ShowS
forall (m :: * -> *) a. Show (m a) => [GroundedUrlT m a] -> ShowS
forall (m :: * -> *) a. Show (m a) => GroundedUrlT m a -> FilePath
showList :: [GroundedUrlT m a] -> ShowS
$cshowList :: forall (m :: * -> *) a. Show (m a) => [GroundedUrlT m a] -> ShowS
show :: GroundedUrlT m a -> FilePath
$cshow :: forall (m :: * -> *) a. Show (m a) => GroundedUrlT m a -> FilePath
showsPrec :: Int -> GroundedUrlT m a -> ShowS
$cshowsPrec :: forall (m :: * -> *) a.
Show (m a) =>
Int -> GroundedUrlT m a -> ShowS
Show, GroundedUrlT m a -> GroundedUrlT m a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *) a.
Eq (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> Bool
/= :: GroundedUrlT m a -> GroundedUrlT m a -> Bool
$c/= :: forall (m :: * -> *) a.
Eq (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> Bool
== :: GroundedUrlT m a -> GroundedUrlT m a -> Bool
$c== :: forall (m :: * -> *) a.
Eq (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> Bool
Eq, GroundedUrlT m a -> GroundedUrlT m a -> Bool
GroundedUrlT m a -> GroundedUrlT m a -> Ordering
GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
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
forall {m :: * -> *} {a}. Ord (m a) => Eq (GroundedUrlT m a)
forall (m :: * -> *) a.
Ord (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> Bool
forall (m :: * -> *) a.
Ord (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> Ordering
forall (m :: * -> *) a.
Ord (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
min :: GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
$cmin :: forall (m :: * -> *) a.
Ord (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
max :: GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
$cmax :: forall (m :: * -> *) a.
Ord (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
>= :: GroundedUrlT m a -> GroundedUrlT m a -> Bool
$c>= :: forall (m :: * -> *) a.
Ord (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> Bool
> :: GroundedUrlT m a -> GroundedUrlT m a -> Bool
$c> :: forall (m :: * -> *) a.
Ord (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> Bool
<= :: GroundedUrlT m a -> GroundedUrlT m a -> Bool
$c<= :: forall (m :: * -> *) a.
Ord (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> Bool
< :: GroundedUrlT m a -> GroundedUrlT m a -> Bool
$c< :: forall (m :: * -> *) a.
Ord (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> Bool
compare :: GroundedUrlT m a -> GroundedUrlT m a -> Ordering
$ccompare :: forall (m :: * -> *) a.
Ord (m a) =>
GroundedUrlT m a -> GroundedUrlT m a -> Ordering
Ord, forall a b. a -> GroundedUrlT m b -> GroundedUrlT m a
forall a b. (a -> b) -> GroundedUrlT m a -> GroundedUrlT m b
forall (m :: * -> *) a b.
Functor m =>
a -> GroundedUrlT m b -> GroundedUrlT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GroundedUrlT m a -> GroundedUrlT 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 -> GroundedUrlT m b -> GroundedUrlT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> GroundedUrlT m b -> GroundedUrlT m a
fmap :: forall a b. (a -> b) -> GroundedUrlT m a -> GroundedUrlT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GroundedUrlT m a -> GroundedUrlT m b
Functor, forall a. a -> GroundedUrlT m a
forall a b.
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m a
forall a b.
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m b
forall a b.
GroundedUrlT m (a -> b) -> GroundedUrlT m a -> GroundedUrlT m b
forall a b c.
(a -> b -> c)
-> GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT 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 {m :: * -> *}. Applicative m => Functor (GroundedUrlT m)
forall (m :: * -> *) a. Applicative m => a -> GroundedUrlT m a
forall (m :: * -> *) a b.
Applicative m =>
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m a
forall (m :: * -> *) a b.
Applicative m =>
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m b
forall (m :: * -> *) a b.
Applicative m =>
GroundedUrlT m (a -> b) -> GroundedUrlT m a -> GroundedUrlT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m c
<* :: forall a b.
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m a
*> :: forall a b.
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m b
liftA2 :: forall a b c.
(a -> b -> c)
-> GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m c
<*> :: forall a b.
GroundedUrlT m (a -> b) -> GroundedUrlT m a -> GroundedUrlT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
GroundedUrlT m (a -> b) -> GroundedUrlT m a -> GroundedUrlT m b
pure :: forall a. a -> GroundedUrlT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> GroundedUrlT m a
Applicative, forall a. GroundedUrlT m a
forall a. GroundedUrlT m a -> GroundedUrlT m [a]
forall a. GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT 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
forall {m :: * -> *}. Alternative m => Applicative (GroundedUrlT m)
forall (m :: * -> *) a. Alternative m => GroundedUrlT m a
forall (m :: * -> *) a.
Alternative m =>
GroundedUrlT m a -> GroundedUrlT m [a]
forall (m :: * -> *) a.
Alternative m =>
GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
many :: forall a. GroundedUrlT m a -> GroundedUrlT m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
GroundedUrlT m a -> GroundedUrlT m [a]
some :: forall a. GroundedUrlT m a -> GroundedUrlT m [a]
$csome :: forall (m :: * -> *) a.
Alternative m =>
GroundedUrlT m a -> GroundedUrlT m [a]
<|> :: forall a. GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
empty :: forall a. GroundedUrlT m a
$cempty :: forall (m :: * -> *) a. Alternative m => GroundedUrlT m a
Alternative, forall a. a -> GroundedUrlT m a
forall a b.
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m b
forall a b.
GroundedUrlT m a -> (a -> GroundedUrlT m b) -> GroundedUrlT m b
forall {m :: * -> *}. Monad m => Applicative (GroundedUrlT m)
forall (m :: * -> *) a. Monad m => a -> GroundedUrlT m a
forall (m :: * -> *) a b.
Monad m =>
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m b
forall (m :: * -> *) a b.
Monad m =>
GroundedUrlT m a -> (a -> GroundedUrlT m b) -> GroundedUrlT 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 -> GroundedUrlT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> GroundedUrlT m a
>> :: forall a b.
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
GroundedUrlT m a -> GroundedUrlT m b -> GroundedUrlT m b
>>= :: forall a b.
GroundedUrlT m a -> (a -> GroundedUrlT m b) -> GroundedUrlT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
GroundedUrlT m a -> (a -> GroundedUrlT m b) -> GroundedUrlT m b
Monad, forall a. (a -> GroundedUrlT m a) -> GroundedUrlT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (GroundedUrlT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> GroundedUrlT m a) -> GroundedUrlT m a
mfix :: forall a. (a -> GroundedUrlT m a) -> GroundedUrlT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> GroundedUrlT m a) -> GroundedUrlT m a
MonadFix
             , forall a. GroundedUrlT m a
forall a. GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall {m :: * -> *}. MonadPlus m => Monad (GroundedUrlT m)
forall {m :: * -> *}. MonadPlus m => Alternative (GroundedUrlT m)
forall (m :: * -> *) a. MonadPlus m => GroundedUrlT m a
forall (m :: * -> *) a.
MonadPlus m =>
GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
mplus :: forall a. GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
GroundedUrlT m a -> GroundedUrlT m a -> GroundedUrlT m a
mzero :: forall a. GroundedUrlT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => GroundedUrlT m a
MonadPlus, forall a. IO a -> GroundedUrlT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (GroundedUrlT m)
forall (m :: * -> *) a. MonadIO m => IO a -> GroundedUrlT m a
liftIO :: forall a. IO a -> GroundedUrlT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> GroundedUrlT m a
MonadIO, MonadReader r, MonadWriter w, MonadState s
             , MonadRWS r w s, forall a b.
((a -> GroundedUrlT m b) -> GroundedUrlT m a) -> GroundedUrlT m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
forall {m :: * -> *}. MonadCont m => Monad (GroundedUrlT m)
forall (m :: * -> *) a b.
MonadCont m =>
((a -> GroundedUrlT m b) -> GroundedUrlT m a) -> GroundedUrlT m a
callCC :: forall a b.
((a -> GroundedUrlT m b) -> GroundedUrlT m a) -> GroundedUrlT m a
$ccallCC :: forall (m :: * -> *) a b.
MonadCont m =>
((a -> GroundedUrlT m b) -> GroundedUrlT m a) -> GroundedUrlT m a
MonadCont, MonadError e, MonadBase b, forall e a. Exception e => e -> GroundedUrlT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *}. MonadThrow m => Monad (GroundedUrlT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> GroundedUrlT m a
throwM :: forall e a. Exception e => e -> GroundedUrlT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> GroundedUrlT m a
MonadThrow
             , forall e a.
Exception e =>
GroundedUrlT m a -> (e -> GroundedUrlT m a) -> GroundedUrlT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall {m :: * -> *}. MonadCatch m => MonadThrow (GroundedUrlT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
GroundedUrlT m a -> (e -> GroundedUrlT m a) -> GroundedUrlT m a
catch :: forall e a.
Exception e =>
GroundedUrlT m a -> (e -> GroundedUrlT m a) -> GroundedUrlT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
GroundedUrlT m a -> (e -> GroundedUrlT m a) -> GroundedUrlT m a
MonadCatch, forall b.
((forall a. GroundedUrlT m a -> GroundedUrlT m a)
 -> GroundedUrlT m b)
-> GroundedUrlT m b
forall a b c.
GroundedUrlT m a
-> (a -> ExitCase b -> GroundedUrlT m c)
-> (a -> GroundedUrlT m b)
-> GroundedUrlT m (b, c)
forall {m :: * -> *}. MonadMask m => MonadCatch (GroundedUrlT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. GroundedUrlT m a -> GroundedUrlT m a)
 -> GroundedUrlT m b)
-> GroundedUrlT m b
forall (m :: * -> *) a b c.
MonadMask m =>
GroundedUrlT m a
-> (a -> ExitCase b -> GroundedUrlT m c)
-> (a -> GroundedUrlT m b)
-> GroundedUrlT 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.
GroundedUrlT m a
-> (a -> ExitCase b -> GroundedUrlT m c)
-> (a -> GroundedUrlT m b)
-> GroundedUrlT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
GroundedUrlT m a
-> (a -> ExitCase b -> GroundedUrlT m c)
-> (a -> GroundedUrlT m b)
-> GroundedUrlT m (b, c)
uninterruptibleMask :: forall b.
((forall a. GroundedUrlT m a -> GroundedUrlT m a)
 -> GroundedUrlT m b)
-> GroundedUrlT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. GroundedUrlT m a -> GroundedUrlT m a)
 -> GroundedUrlT m b)
-> GroundedUrlT m b
mask :: forall b.
((forall a. GroundedUrlT m a -> GroundedUrlT m a)
 -> GroundedUrlT m b)
-> GroundedUrlT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. GroundedUrlT m a -> GroundedUrlT m a)
 -> GroundedUrlT m b)
-> GroundedUrlT m b
MonadMask, forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> GroundedUrlT m ()
forall (m :: * -> *).
Monad m
-> (forall msg.
    ToLogStr msg =>
    Loc -> Text -> LogLevel -> msg -> m ())
-> MonadLogger m
forall {m :: * -> *}. MonadLogger m => Monad (GroundedUrlT m)
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> GroundedUrlT m ()
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> GroundedUrlT m ()
$cmonadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> GroundedUrlT m ()
MonadLogger)

deriving instance (MonadResource m, MonadBase IO m) => MonadResource (GroundedUrlT m)

type GroundedUrl = GroundedUrlT Identity

instance MonadTrans GroundedUrlT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> GroundedUrlT m a
lift = forall (m :: * -> *) a. m a -> GroundedUrlT m a
GroundedUrlT

instance MonadTransControl GroundedUrlT where
  type StT GroundedUrlT a = a
  liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run GroundedUrlT -> m a) -> GroundedUrlT m a
liftWith Run GroundedUrlT -> m a
f = forall (m :: * -> *) a. m a -> GroundedUrlT m a
GroundedUrlT (Run GroundedUrlT -> m a
f forall (m :: * -> *) a. GroundedUrlT m a -> m a
runGroundedUrlT)
  restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT GroundedUrlT a) -> GroundedUrlT m a
restoreT = forall (m :: * -> *) a. m a -> GroundedUrlT m a
GroundedUrlT

instance Aligned.MonadTransControl GroundedUrlT Identity where
  liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run GroundedUrlT Identity -> m a) -> GroundedUrlT m a
liftWith Run GroundedUrlT Identity -> m a
f = forall (m :: * -> *) a. m a -> GroundedUrlT m a
GroundedUrlT (Run GroundedUrlT Identity -> m a
f (\GroundedUrlT n b
x -> forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. GroundedUrlT m a -> m a
runGroundedUrlT GroundedUrlT n b
x))
  restoreT :: forall (m :: * -> *) a.
Monad m =>
m (Identity a) -> GroundedUrlT m a
restoreT m (Identity a)
x = forall (m :: * -> *) a. m a -> GroundedUrlT m a
GroundedUrlT (forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Identity a)
x)

instance ( MonadBaseControl b m
         ) => MonadBaseControl b (GroundedUrlT m) where
  type StM (GroundedUrlT m) a = ComposeSt GroundedUrlT m a
  liftBaseWith :: forall a. (RunInBase (GroundedUrlT m) b -> b a) -> GroundedUrlT 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 (GroundedUrlT m) a -> GroundedUrlT m a
restoreM = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

instance ( Aligned.MonadBaseControl b m stM
         ) => Aligned.MonadBaseControl b (GroundedUrlT m) (Compose stM Identity) where
  liftBaseWith :: forall a.
(RunInBase (GroundedUrlT m) b (Compose stM Identity) -> b a)
-> GroundedUrlT 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 Identity a -> GroundedUrlT 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 MFunctor GroundedUrlT where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> GroundedUrlT m b -> GroundedUrlT n b
hoist forall a. m a -> n a
f (GroundedUrlT m b
x) = forall (m :: * -> *) a. m a -> GroundedUrlT m a
GroundedUrlT (forall a. m a -> n a
f m b
x)

instance MMonad GroundedUrlT where
  embed :: forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> GroundedUrlT n a)
-> GroundedUrlT m b -> GroundedUrlT n b
embed forall a. m a -> GroundedUrlT n a
f GroundedUrlT m b
x = forall a. m a -> GroundedUrlT n a
f (forall (m :: * -> *) a. GroundedUrlT m a -> m a
runGroundedUrlT GroundedUrlT m b
x)

instance ( Applicative m
         ) => MonadUrl (GroundedUrlT m) Abs where
  locToUrl :: Location Abs -> GroundedUrlT m URL
locToUrl     = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> URL
AbsURL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location Abs -> URI
mkUriLocEmpty


-- ** Absolute Urls

-- | Given a means to take an absolute location and turn it into an URI, make a monad used to
-- construct urls. You can use 'packLocation' to create the @Location Abs -> URI@ function.
newtype AbsoluteUrlT m a = AbsoluteUrlT
  { forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT :: (Location Abs -> URI) -> m a
  } deriving forall a b. a -> AbsoluteUrlT m b -> AbsoluteUrlT m a
forall a b. (a -> b) -> AbsoluteUrlT m a -> AbsoluteUrlT m b
forall (m :: * -> *) a b.
Functor m =>
a -> AbsoluteUrlT m b -> AbsoluteUrlT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> AbsoluteUrlT m a -> AbsoluteUrlT 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 -> AbsoluteUrlT m b -> AbsoluteUrlT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> AbsoluteUrlT m b -> AbsoluteUrlT m a
fmap :: forall a b. (a -> b) -> AbsoluteUrlT m a -> AbsoluteUrlT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> AbsoluteUrlT m a -> AbsoluteUrlT m b
Functor

type AbsoluteUrl = AbsoluteUrlT Identity

instance ( Applicative m
         ) => MonadUrl (AbsoluteUrlT m) Abs where
  locToUrl :: Location Abs -> AbsoluteUrlT m URL
locToUrl Location Abs
x = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT (\Location Abs -> URI
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> URL
AbsURL forall a b. (a -> b) -> a -> b
$ Location Abs -> URI
f Location Abs
x)

instance Applicative m => Applicative (AbsoluteUrlT m) where
  pure :: forall a. a -> AbsoluteUrlT m a
pure a
x = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  AbsoluteUrlT m (a -> b)
f <*> :: forall a b.
AbsoluteUrlT m (a -> b) -> AbsoluteUrlT m a -> AbsoluteUrlT m b
<*> AbsoluteUrlT m a
x = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT AbsoluteUrlT m (a -> b)
f Location Abs -> URI
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT AbsoluteUrlT m a
x Location Abs -> URI
r

instance Alternative m => Alternative (AbsoluteUrlT m) where
  empty :: forall a. AbsoluteUrlT m a
empty = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT (forall a b. a -> b -> a
const forall (f :: * -> *) a. Alternative f => f a
empty)
  (AbsoluteUrlT (Location Abs -> URI) -> m a
f) <|> :: forall a. AbsoluteUrlT m a -> AbsoluteUrlT m a -> AbsoluteUrlT m a
<|> (AbsoluteUrlT (Location Abs -> URI) -> m a
g) = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
h -> (Location Abs -> URI) -> m a
f Location Abs -> URI
h forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Location Abs -> URI) -> m a
g Location Abs -> URI
h

instance Monad m => Monad (AbsoluteUrlT m) where
  AbsoluteUrlT m a
m >>= :: forall a b.
AbsoluteUrlT m a -> (a -> AbsoluteUrlT m b) -> AbsoluteUrlT m b
>>= a -> AbsoluteUrlT m b
f = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT AbsoluteUrlT m a
m Location Abs -> URI
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\a
x -> forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT (a -> AbsoluteUrlT m b
f a
x) Location Abs -> URI
r)

instance MonadTrans AbsoluteUrlT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> AbsoluteUrlT m a
lift = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

instance MonadIO m => MonadIO (AbsoluteUrlT m) where
  liftIO :: forall a. IO a -> AbsoluteUrlT m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance ( MonadReader r m
         ) => MonadReader r (AbsoluteUrlT m) where
  ask :: AbsoluteUrlT m r
ask       = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> AbsoluteUrlT m a -> AbsoluteUrlT m a
local r -> r
f (AbsoluteUrlT (Location Abs -> URI) -> m a
x) = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f ((Location Abs -> URI) -> m a
x Location Abs -> URI
r)

instance ( MonadWriter w m
         ) => MonadWriter w (AbsoluteUrlT m) where
  tell :: w -> AbsoluteUrlT m ()
tell w
w = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell w
w)
  listen :: forall a. AbsoluteUrlT m a -> AbsoluteUrlT m (a, w)
listen (AbsoluteUrlT (Location Abs -> URI) -> m a
x) = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen ((Location Abs -> URI) -> m a
x Location Abs -> URI
r)
  pass :: forall a. AbsoluteUrlT m (a, w -> w) -> AbsoluteUrlT m a
pass (AbsoluteUrlT (Location Abs -> URI) -> m (a, w -> w)
x) = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass ((Location Abs -> URI) -> m (a, w -> w)
x Location Abs -> URI
r)

instance ( MonadState s m
         ) => MonadState s (AbsoluteUrlT m) where
  get :: AbsoluteUrlT m s
get   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> AbsoluteUrlT m ()
put s
x = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *). MonadState s m => s -> m ()
put s
x)

instance ( MonadRWS r w s m
         ) => MonadRWS r w s (AbsoluteUrlT m) where

instance ( MonadCont m
         ) => MonadCont (AbsoluteUrlT m) where
  callCC :: forall a b.
((a -> AbsoluteUrlT m b) -> AbsoluteUrlT m a) -> AbsoluteUrlT m a
callCC (a -> AbsoluteUrlT m b) -> AbsoluteUrlT m a
f = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC forall a b. (a -> b) -> a -> b
$ \a -> m b
c -> forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT ((a -> AbsoluteUrlT m b) -> AbsoluteUrlT m a
f (forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
c)) Location Abs -> URI
r

instance ( MonadError e m
         ) => MonadError e (AbsoluteUrlT m) where
  throwError :: forall a. e -> AbsoluteUrlT m a
throwError = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a.
AbsoluteUrlT m a -> (e -> AbsoluteUrlT m a) -> AbsoluteUrlT m a
catchError (AbsoluteUrlT (Location Abs -> URI) -> m a
x) e -> AbsoluteUrlT m a
f = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ((Location Abs -> URI) -> m a
x Location Abs -> URI
r) (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT Location Abs -> URI
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> AbsoluteUrlT m a
f)

instance ( MonadBase b m
         ) => MonadBase b (AbsoluteUrlT m) where
  liftBase :: forall α. b α -> AbsoluteUrlT m α
liftBase = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) α.
(MonadTrans t, MonadBase b m) =>
b α -> t m α
liftBaseDefault

instance MonadTransControl AbsoluteUrlT where
  type StT AbsoluteUrlT a = a
  liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run AbsoluteUrlT -> m a) -> AbsoluteUrlT m a
liftWith Run AbsoluteUrlT -> m a
f = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    Run AbsoluteUrlT -> m a
f forall a b. (a -> b) -> a -> b
$ \AbsoluteUrlT n b
t -> forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT AbsoluteUrlT n b
t Location Abs -> URI
r
  restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT AbsoluteUrlT a) -> AbsoluteUrlT m a
restoreT = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

instance Aligned.MonadTransControl AbsoluteUrlT Identity where
  liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run AbsoluteUrlT Identity -> m a) -> AbsoluteUrlT m a
liftWith Run AbsoluteUrlT Identity -> m a
f = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    Run AbsoluteUrlT Identity -> m a
f forall a b. (a -> b) -> a -> b
$ \AbsoluteUrlT n b
x -> forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT AbsoluteUrlT n b
x Location Abs -> URI
r
  restoreT :: forall (m :: * -> *) a.
Monad m =>
m (Identity a) -> AbsoluteUrlT m a
restoreT m (Identity a)
x = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
_ -> forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Identity a)
x

instance ( MonadBaseControl b m
         ) => MonadBaseControl b (AbsoluteUrlT m) where
  type StM (AbsoluteUrlT m) a = ComposeSt AbsoluteUrlT m a
  liftBaseWith :: forall a. (RunInBase (AbsoluteUrlT m) b -> b a) -> AbsoluteUrlT 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 (AbsoluteUrlT m) a -> AbsoluteUrlT m a
restoreM = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

instance ( Aligned.MonadBaseControl b m stM
         ) => Aligned.MonadBaseControl b (AbsoluteUrlT m) (Compose stM Identity) where
  liftBaseWith :: forall a.
(RunInBase (AbsoluteUrlT m) b (Compose stM Identity) -> b a)
-> AbsoluteUrlT 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 Identity a -> AbsoluteUrlT 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 ( MonadThrow m
         ) => MonadThrow (AbsoluteUrlT m) where
  throwM :: forall e a. Exception e => e -> AbsoluteUrlT m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance ( MonadCatch m
         ) => MonadCatch (AbsoluteUrlT m) where
  catch :: forall e a.
Exception e =>
AbsoluteUrlT m a -> (e -> AbsoluteUrlT m a) -> AbsoluteUrlT m a
catch (AbsoluteUrlT (Location Abs -> URI) -> m a
x) e -> AbsoluteUrlT m a
f = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch ((Location Abs -> URI) -> m a
x Location Abs -> URI
r) (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT Location Abs -> URI
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> AbsoluteUrlT m a
f)

instance ( MonadMask m
         ) => MonadMask (AbsoluteUrlT m) where
  mask :: forall b.
((forall a. AbsoluteUrlT m a -> AbsoluteUrlT m a)
 -> AbsoluteUrlT m b)
-> AbsoluteUrlT m b
mask (forall a. AbsoluteUrlT m a -> AbsoluteUrlT m a)
-> AbsoluteUrlT m b
a = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT ((forall a. AbsoluteUrlT m a -> AbsoluteUrlT m a)
-> AbsoluteUrlT m b
a forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {m :: * -> *} {a}.
(m a -> m a) -> AbsoluteUrlT m a -> AbsoluteUrlT m a
q forall a. m a -> m a
u) Location Abs -> URI
r
    where q :: (m a -> m a) -> AbsoluteUrlT m a -> AbsoluteUrlT m a
q m a -> m a
u (AbsoluteUrlT (Location Abs -> URI) -> m a
x) = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT (m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Location Abs -> URI) -> m a
x)
  uninterruptibleMask :: forall b.
((forall a. AbsoluteUrlT m a -> AbsoluteUrlT m a)
 -> AbsoluteUrlT m b)
-> AbsoluteUrlT m b
uninterruptibleMask (forall a. AbsoluteUrlT m a -> AbsoluteUrlT m a)
-> AbsoluteUrlT m b
a = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT ((forall a. AbsoluteUrlT m a -> AbsoluteUrlT m a)
-> AbsoluteUrlT m b
a forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {m :: * -> *} {a}.
(m a -> m a) -> AbsoluteUrlT m a -> AbsoluteUrlT m a
q forall a. m a -> m a
u) Location Abs -> URI
r
    where q :: (m a -> m a) -> AbsoluteUrlT m a -> AbsoluteUrlT m a
q m a -> m a
u (AbsoluteUrlT (Location Abs -> URI) -> m a
x) = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT (m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Location Abs -> URI) -> m a
x)
  generalBracket :: forall a b c.
AbsoluteUrlT m a
-> (a -> ExitCase b -> AbsoluteUrlT m c)
-> (a -> AbsoluteUrlT m b)
-> AbsoluteUrlT m (b, c)
generalBracket AbsoluteUrlT m a
acq a -> ExitCase b -> AbsoluteUrlT m c
rel a -> AbsoluteUrlT m b
f = do
    a
a <- AbsoluteUrlT m a
acq
    b
b <- a -> AbsoluteUrlT m b
f a
a
    c
c <- a -> ExitCase b -> AbsoluteUrlT m c
rel a
a (forall a. a -> ExitCase a
ExitCaseSuccess b
b)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, c
c)

instance ( MonadLogger m
         ) => MonadLogger (AbsoluteUrlT m) where
  monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> AbsoluteUrlT m ()
monadLoggerLog Loc
a Text
b LogLevel
c msg
d = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog Loc
a Text
b LogLevel
c msg
d)

instance ( MonadResource m
         ) => MonadResource (AbsoluteUrlT m) where
  liftResourceT :: forall a. ResourceT IO a -> AbsoluteUrlT m a
liftResourceT = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT

instance MFunctor AbsoluteUrlT where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> AbsoluteUrlT m b -> AbsoluteUrlT n b
hoist forall a. m a -> n a
f (AbsoluteUrlT (Location Abs -> URI) -> m b
x) = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall a. m a -> n a
f ((Location Abs -> URI) -> m b
x Location Abs -> URI
r)

instance MMonad AbsoluteUrlT where
  embed :: forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> AbsoluteUrlT n a)
-> AbsoluteUrlT m b -> AbsoluteUrlT n b
embed forall a. m a -> AbsoluteUrlT n a
f AbsoluteUrlT m b
x = forall (m :: * -> *) a.
((Location Abs -> URI) -> m a) -> AbsoluteUrlT m a
AbsoluteUrlT forall a b. (a -> b) -> a -> b
$ \Location Abs -> URI
r ->
    forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT (forall a. m a -> AbsoluteUrlT n a
f (forall (m :: * -> *) a.
AbsoluteUrlT m a -> (Location Abs -> URI) -> m a
runAbsoluteUrlT AbsoluteUrlT m b
x Location Abs -> URI
r)) Location Abs -> URI
r


mkUriLocEmpty :: Location Abs -> URI
mkUriLocEmpty :: Location Abs -> URI
mkUriLocEmpty =
  Maybe Text -> Bool -> URIAuth -> Location Abs -> URI
packLocation forall a. Maybe a
Strict.Nothing Bool
False (Maybe Text -> Maybe Text -> URIAuthHost -> Maybe Word16 -> URIAuth
URIAuth forall a. Maybe a
Strict.Nothing forall a. Maybe a
Strict.Nothing URIAuthHost
Localhost forall a. Maybe a
Strict.Nothing)


getPathChunks :: Path base type' -> V.Vector T.Text
getPathChunks :: forall base type'. Path base type' -> Vector Text
getPathChunks = forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath



packLocation :: Strict.Maybe T.Text -> Bool -> URIAuth -> Location Abs -> URI
packLocation :: Maybe Text -> Bool -> URIAuth -> Location Abs -> URI
packLocation Maybe Text
scheme Bool
slashes URIAuth
auth Location{[QueryParam]
Maybe FilePath
LocationPath Abs
locPath :: forall base. Location base -> LocationPath base
locQueryParams :: forall base. Location base -> [QueryParam]
locFragment :: forall base. Location base -> Maybe FilePath
locFragment :: Maybe FilePath
locQueryParams :: [QueryParam]
locPath :: LocationPath Abs
..} =
  Maybe Text
-> Bool
-> URIAuth
-> Maybe (Vector Text, DirOrFile)
-> Vector (Pair Text (Maybe Text))
-> Maybe Text
-> URI
URI Maybe Text
scheme Bool
slashes URIAuth
auth
    (forall a. a -> Maybe a
Strict.Just forall a b. (a -> b) -> a -> b
$ case LocationPath Abs
locPath of
        Path.Dir Path Abs Dir
xs  -> (forall base type'. Path base type' -> Vector Text
getPathChunks Path Abs Dir
xs, DirOrFile
URI.Dir)
        Path.File Path Abs File
xs -> (forall base type'. Path base type' -> Vector Text
getPathChunks Path Abs File
xs, DirOrFile
URI.File)
    )
    (forall a. [a] -> Vector a
V.fromList
        forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
l,Maybe FilePath
r) ->
            FilePath -> Text
T.pack FilePath
l forall a b. a -> b -> Pair a b
Strict.:!: forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Strict.Nothing (forall a. a -> Maybe a
Strict.Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) Maybe FilePath
r)
            [QueryParam]
locQueryParams
    )
    (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Strict.Nothing (forall a. a -> Maybe a
Strict.Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) Maybe FilePath
locFragment)


unpackLocation :: URI -> (Strict.Maybe T.Text, Bool, URIAuth, Location Abs)
unpackLocation :: URI -> (Maybe Text, Bool, URIAuth, Location Abs)
unpackLocation (URI Maybe Text
scheme Bool
slashes URIAuth
auth Maybe (Vector Text, DirOrFile)
xs Vector (Pair Text (Maybe Text))
qs Maybe Text
mFrag) =
  ( Maybe Text
scheme
  , Bool
slashes
  , URIAuth
auth
  , let path :: LocationPath Abs
        path :: LocationPath Abs
path = case Maybe (Vector Text, DirOrFile)
xs of
          Maybe (Vector Text, DirOrFile)
Strict.Nothing -> forall base. Path base Dir -> LocationPath base
Path.Dir [absdir|/|]
          Strict.Just (Vector Text
xs', DirOrFile
dirOrFile)
            | Vector Text
xs' forall a. Eq a => a -> a -> Bool
== [] -> forall base. Path base Dir -> LocationPath base
Path.Dir [absdir|/|]
            | Bool
otherwise ->
              case DirOrFile
dirOrFile of
                DirOrFile
URI.File -> forall base. Path base File -> LocationPath base
Path.File forall a b. (a -> b) -> a -> b
$
                  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Path Abs File
acc Text
x -> forall a b. a -> b
unsafeCoerce Path Abs File
acc forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall a. IO a -> a
unsafePerformIO (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
x))
                        (forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. a -> b
unsafeCoerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir FilePath
"/")
                        Vector Text
xs'
                DirOrFile
URI.Dir -> forall base. Path base Dir -> LocationPath base
Path.Dir forall a b. (a -> b) -> a -> b
$
                  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Path Abs Dir
acc Text
x -> forall a b. a -> b
unsafeCoerce Path Abs Dir
acc forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall a. IO a -> a
unsafePerformIO (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
x forall a. Semigroup a => a -> a -> a
<> FilePath
"/"))
                        (forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. a -> b
unsafeCoerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir FilePath
"/")
                        Vector Text
xs'
        withQs :: Location Abs
        withQs :: Location Abs
withQs =
          forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
            (\Location Abs
acc (Text
k Strict.:!: Maybe Text
mV) ->
               Location Abs
acc forall base. Location base -> QueryParam -> Location base
<&> (Text -> FilePath
T.unpack Text
k, forall b a. b -> (a -> b) -> Maybe a -> b
Strict.maybe forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) Maybe Text
mV)
            )
            (forall base.
LocationPath base
-> [QueryParam] -> Maybe FilePath -> Location base
Location LocationPath Abs
path [] forall a. Maybe a
Nothing)
            Vector (Pair Text (Maybe Text))
qs
    in  forall base. Maybe FilePath -> Location base -> Location base
setFragment (forall b a. b -> (a -> b) -> Maybe a -> b
Strict.maybe forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) Maybe Text
mFrag) Location Abs
withQs
  )