{-# LANGUAGE
    MultiParamTypeClasses
  , FunctionalDependencies
  , NamedFieldPuns
  , ScopedTypeVariables
  , OverloadedStrings
  , QuasiQuotes
  , DeriveGeneric
  #-}

module Path.Extended
  ( -- * Types
    Location (..)
  , LocationPath (..)
  , QueryParam
  , -- * Classes
    ToPath (..)
  , ToLocation (..)
  , FromPath (..)
  , FromLocation (..)
  , -- * Combinators
    -- ** Path
    fromDir
  , fromFile
  , prependAbs
  , prependRel
  , -- ** Query Parameters
    setQuery
  , addQuery
  , (<&>)
  , addQueries
  , delQuery
  , getQuery
  , -- ** Fragment
    setFragment
  , addFragment
  , (<#>)
  , delFragment
  , getFragment
  , -- ** Parser & Printer
    locationAbsParser
  , locationRelParser
  , printLocation
  ) where

-- import Path as P hiding ((</>))
import Path (Path, Abs, Rel, Dir, File, (</>), toFilePath, parseAbsFile, parseAbsDir, parseRelDir, parseRelFile, stripProperPrefix, absdir, reldir)

import Prelude hiding (takeWhile)
import Data.Attoparsec.Text (Parser, char, takeWhile, takeWhile1, sepBy)
import qualified Data.Text as T
import Control.Applicative ((<|>), optional)
import Control.Exception (SomeException)
import Control.Monad (void)
import GHC.Generics (Generic)



-- | Convenience typeclass for symbolic, stringless routes - make an instance
-- for your own data type to use your constructors as route-referencing symbols.
class ToPath sym base type' | sym -> base type' where
  toPath :: sym -> Path base type'

-- | Convenience typeclass for symbolic, stringless routes - make an instance
-- for your own data type to use your constructors as route-referencing symbols.
class ToLocation sym base | sym -> base where
  toLocation :: sym -> Location base

class FromPath sym base type' | sym -> base type' where
  parsePath :: Path base type' -> Either String sym

class FromLocation sym base | sym -> base where
  parseLocation :: Location base -> Either String sym


data LocationPath base
  = Dir (Path base Dir)
  | File (Path base File)
  deriving (LocationPath base -> LocationPath base -> Bool
forall base. LocationPath base -> LocationPath base -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocationPath base -> LocationPath base -> Bool
$c/= :: forall base. LocationPath base -> LocationPath base -> Bool
== :: LocationPath base -> LocationPath base -> Bool
$c== :: forall base. LocationPath base -> LocationPath base -> Bool
Eq, LocationPath base -> LocationPath base -> Bool
LocationPath base -> LocationPath base -> Ordering
forall base. Eq (LocationPath base)
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 base. LocationPath base -> LocationPath base -> Bool
forall base. LocationPath base -> LocationPath base -> Ordering
forall base.
LocationPath base -> LocationPath base -> LocationPath base
min :: LocationPath base -> LocationPath base -> LocationPath base
$cmin :: forall base.
LocationPath base -> LocationPath base -> LocationPath base
max :: LocationPath base -> LocationPath base -> LocationPath base
$cmax :: forall base.
LocationPath base -> LocationPath base -> LocationPath base
>= :: LocationPath base -> LocationPath base -> Bool
$c>= :: forall base. LocationPath base -> LocationPath base -> Bool
> :: LocationPath base -> LocationPath base -> Bool
$c> :: forall base. LocationPath base -> LocationPath base -> Bool
<= :: LocationPath base -> LocationPath base -> Bool
$c<= :: forall base. LocationPath base -> LocationPath base -> Bool
< :: LocationPath base -> LocationPath base -> Bool
$c< :: forall base. LocationPath base -> LocationPath base -> Bool
compare :: LocationPath base -> LocationPath base -> Ordering
$ccompare :: forall base. LocationPath base -> LocationPath base -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall base x. Rep (LocationPath base) x -> LocationPath base
forall base x. LocationPath base -> Rep (LocationPath base) x
$cto :: forall base x. Rep (LocationPath base) x -> LocationPath base
$cfrom :: forall base x. LocationPath base -> Rep (LocationPath base) x
Generic, Int -> LocationPath base -> ShowS
forall base. Int -> LocationPath base -> ShowS
forall base. [LocationPath base] -> ShowS
forall base. LocationPath base -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocationPath base] -> ShowS
$cshowList :: forall base. [LocationPath base] -> ShowS
show :: LocationPath base -> String
$cshow :: forall base. LocationPath base -> String
showsPrec :: Int -> LocationPath base -> ShowS
$cshowsPrec :: forall base. Int -> LocationPath base -> ShowS
Show)

-- | A location for some base and type - internally uses @Path@.
data Location base = Location
  { forall base. Location base -> LocationPath base
locPath        :: LocationPath base
  , forall base. Location base -> [QueryParam]
locQueryParams :: [QueryParam]
  , forall base. Location base -> Maybe String
locFragment    :: Maybe String
  } deriving (Location base -> Location base -> Bool
forall base. Location base -> Location base -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location base -> Location base -> Bool
$c/= :: forall base. Location base -> Location base -> Bool
== :: Location base -> Location base -> Bool
$c== :: forall base. Location base -> Location base -> Bool
Eq, Location base -> Location base -> Bool
Location base -> Location base -> Ordering
forall base. Eq (Location base)
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 base. Location base -> Location base -> Bool
forall base. Location base -> Location base -> Ordering
forall base. Location base -> Location base -> Location base
min :: Location base -> Location base -> Location base
$cmin :: forall base. Location base -> Location base -> Location base
max :: Location base -> Location base -> Location base
$cmax :: forall base. Location base -> Location base -> Location base
>= :: Location base -> Location base -> Bool
$c>= :: forall base. Location base -> Location base -> Bool
> :: Location base -> Location base -> Bool
$c> :: forall base. Location base -> Location base -> Bool
<= :: Location base -> Location base -> Bool
$c<= :: forall base. Location base -> Location base -> Bool
< :: Location base -> Location base -> Bool
$c< :: forall base. Location base -> Location base -> Bool
compare :: Location base -> Location base -> Ordering
$ccompare :: forall base. Location base -> Location base -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall base x. Rep (Location base) x -> Location base
forall base x. Location base -> Rep (Location base) x
$cto :: forall base x. Rep (Location base) x -> Location base
$cfrom :: forall base x. Location base -> Rep (Location base) x
Generic, Int -> Location base -> ShowS
forall base. Int -> Location base -> ShowS
forall base. [Location base] -> ShowS
forall base. Location base -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location base] -> ShowS
$cshowList :: forall base. [Location base] -> ShowS
show :: Location base -> String
$cshow :: forall base. Location base -> String
showsPrec :: Int -> Location base -> ShowS
$cshowsPrec :: forall base. Int -> Location base -> ShowS
Show)



fromDir :: Path base Dir -> Location base
fromDir :: forall base. Path base Dir -> Location base
fromDir Path base Dir
path = Location
  { locPath :: LocationPath base
locPath = forall base. Path base Dir -> LocationPath base
Dir Path base Dir
path
  , locQueryParams :: [QueryParam]
locQueryParams = []
  , locFragment :: Maybe String
locFragment = forall a. Maybe a
Nothing
  }

fromFile :: Path base File -> Location base
fromFile :: forall base. Path base File -> Location base
fromFile Path base File
path = Location
  { locPath :: LocationPath base
locPath = forall base. Path base File -> LocationPath base
File Path base File
path
  , locQueryParams :: [QueryParam]
locQueryParams = []
  , locFragment :: Maybe String
locFragment = forall a. Maybe a
Nothing
  }


locationAbsParser :: Parser (Location Abs)
locationAbsParser :: Parser (Location Abs)
locationAbsParser = do
  Parser Text ()
divider
  LocationPath Abs
locPath <- do
    [Text]
xs <- Parser Text
chunk forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Parser Text ()
divider
    case [Text]
xs of
      [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall base. Path base Dir -> LocationPath base
Dir [absdir|/|]
      [Text]
_ -> do
        let dir :: Parser Text (LocationPath Abs)
dir = do
              Parser Text ()
divider
              case forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir (Text -> String
T.unpack (Text
"/" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
xs forall a. Semigroup a => a -> a -> a
<> Text
"/")) of
                Left (SomeException
e :: SomeException) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show SomeException
e)
                Right Path Abs Dir
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall base. Path base Dir -> LocationPath base
Dir Path Abs Dir
x)
            file :: Parser Text (LocationPath Abs)
file =
              case forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile (Text -> String
T.unpack (Text
"/" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
xs)) of
                Left (SomeException
e :: SomeException) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show SomeException
e)
                Right Path Abs File
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall base. Path base File -> LocationPath base
File Path Abs File
x)
        Parser Text (LocationPath Abs)
dir forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (LocationPath Abs)
file
  [QueryParam]
locQueryParams <- do
    Maybe [QueryParam]
xs <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
      let val :: Parser Text String
val = Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
takeWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'=',Char
'&',Char
'#'])
      forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'?')
      let kv :: Parser Text QueryParam
kv = do
            String
k <- Parser Text String
val
            Maybe String
mV <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
              forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'=')
              Parser Text String
val
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
k,Maybe String
mV)
      Parser Text QueryParam
kv forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'&')
    case Maybe [QueryParam]
xs of
      Maybe [QueryParam]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just [QueryParam]
xs' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [QueryParam]
xs'
  Maybe String
locFragment <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
    forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'#')
    Text
xs <- (Char -> Bool) -> Parser Text
takeWhile (forall a b. a -> b -> a
const Bool
True)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
T.unpack Text
xs)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Location
    { LocationPath Abs
locPath :: LocationPath Abs
locPath :: LocationPath Abs
locPath
    , [QueryParam]
locQueryParams :: [QueryParam]
locQueryParams :: [QueryParam]
locQueryParams
    , Maybe String
locFragment :: Maybe String
locFragment :: Maybe String
locFragment
    }
  where
    divider :: Parser Text ()
divider = forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'/')
    chunk :: Parser Text
chunk = (Char -> Bool) -> Parser Text
takeWhile1 (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'?',Char
'&',Char
'/',Char
'#'])

locationRelParser :: Parser (Location Rel)
locationRelParser :: Parser (Location Rel)
locationRelParser = do
  LocationPath Rel
locPath <- do
    [Text]
xs <- Parser Text
chunk forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Parser Text ()
divider
    case [Text]
xs of
      [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall base. Path base Dir -> LocationPath base
Dir [reldir|./|]
      [Text]
_ -> do
        let dir :: Parser Text (LocationPath Rel)
dir = do
              Parser Text ()
divider
              case forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (Text -> String
T.unpack (Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
xs forall a. Semigroup a => a -> a -> a
<> Text
"/")) of
                Left (SomeException
e :: SomeException) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show SomeException
e)
                Right Path Rel Dir
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall base. Path base Dir -> LocationPath base
Dir Path Rel Dir
x)
            file :: Parser Text (LocationPath Rel)
file =
              case forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (Text -> String
T.unpack (Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
xs)) of
                Left (SomeException
e :: SomeException) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show SomeException
e)
                Right Path Rel File
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall base. Path base File -> LocationPath base
File Path Rel File
x)
        Parser Text (LocationPath Rel)
dir forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (LocationPath Rel)
file
  [QueryParam]
locQueryParams <- do
    Maybe [QueryParam]
xs <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
      let val :: Parser Text String
val = Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
takeWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'=',Char
'&',Char
'#'])
      forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'?')
      let kv :: Parser Text QueryParam
kv = do
            String
k <- Parser Text String
val
            Maybe String
mV <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
              forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'=')
              Parser Text String
val
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
k,Maybe String
mV)
      Parser Text QueryParam
kv forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'&')
    case Maybe [QueryParam]
xs of
      Maybe [QueryParam]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just [QueryParam]
xs' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [QueryParam]
xs'
  Maybe String
locFragment <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
    forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'#')
    Text
xs <- (Char -> Bool) -> Parser Text
takeWhile (forall a b. a -> b -> a
const Bool
True)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
T.unpack Text
xs)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Location
    { LocationPath Rel
locPath :: LocationPath Rel
locPath :: LocationPath Rel
locPath
    , [QueryParam]
locQueryParams :: [QueryParam]
locQueryParams :: [QueryParam]
locQueryParams
    , Maybe String
locFragment :: Maybe String
locFragment :: Maybe String
locFragment
    }
  where
    divider :: Parser Text ()
divider = forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'/')
    chunk :: Parser Text
chunk = (Char -> Bool) -> Parser Text
takeWhile1 (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'?',Char
'&',Char
'/',Char
'#'])


prependAbs :: Path Abs Dir -> Location Abs -> Location Abs
prependAbs :: Path Abs Dir -> Location Abs -> Location Abs
prependAbs Path Abs Dir
path l :: Location Abs
l@Location{LocationPath Abs
locPath :: LocationPath Abs
locPath :: forall base. Location base -> LocationPath base
locPath} =
  case LocationPath Abs
locPath of
    File Path Abs File
f ->
      Location Abs
l { locPath :: LocationPath Abs
locPath = case forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix [absdir|/|] Path Abs File
f of
            Maybe (Path Rel File)
Nothing -> forall a. HasCallStack => a
undefined
            Just Path Rel File
f' -> forall base. Path base File -> LocationPath base
File (Path Abs Dir
path forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
f')
        }
    Dir Path Abs Dir
d ->
      Location Abs
l { locPath :: LocationPath Abs
locPath = case forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix [absdir|/|] Path Abs Dir
d of
            Maybe (Path Rel Dir)
Nothing -> forall a. HasCallStack => a
undefined
            Just Path Rel Dir
d' -> forall base. Path base Dir -> LocationPath base
Dir (Path Abs Dir
path forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
d')
        }

prependRel :: Path Rel Dir -> Location Rel -> Location Rel
prependRel :: Path Rel Dir -> Location Rel -> Location Rel
prependRel Path Rel Dir
path l :: Location Rel
l@Location{LocationPath Rel
locPath :: LocationPath Rel
locPath :: forall base. Location base -> LocationPath base
locPath} =
  case LocationPath Rel
locPath of
    File Path Rel File
f ->
      Location Rel
l { locPath :: LocationPath Rel
locPath = forall base. Path base File -> LocationPath base
File (Path Rel Dir
path forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
f)
        }
    Dir Path Rel Dir
d ->
      Location Rel
l { locPath :: LocationPath Rel
locPath = forall base. Path base Dir -> LocationPath base
Dir (Path Rel Dir
path forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
d)
        }


printLocation :: Location base -> T.Text
printLocation :: forall base. Location base -> Text
printLocation (Location LocationPath base
pa [QueryParam]
qp Maybe String
fr) =
  let loc :: String
loc = case LocationPath base
pa of
        Dir Path base Dir
x -> forall b t. Path b t -> String
toFilePath Path base Dir
x
        File Path base File
x -> forall b t. Path b t -> String
toFilePath Path base File
x
      query :: Text
query = case [QueryParam]
qp of
                [] -> Text
""
                [QueryParam]
qs -> Text
"?" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"&" (QueryParam -> Text
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QueryParam]
qs)
        where
          go :: QueryParam -> Text
go (String
k,Maybe String
mv) = String -> Text
T.pack String
k forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\String
v -> Text
"=" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
v) Maybe String
mv
  in String -> Text
T.pack String
loc forall a. Semigroup a => a -> a -> a
<> Text
query forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\String
f -> Text
"#" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
f) Maybe String
fr

type QueryParam = (String, Maybe String)



setQuery :: [QueryParam] -> Location base -> Location base
setQuery :: forall base. [QueryParam] -> Location base -> Location base
setQuery [QueryParam]
qp (Location LocationPath base
pa [QueryParam]
_ Maybe String
fr) =
  forall base.
LocationPath base -> [QueryParam] -> Maybe String -> Location base
Location LocationPath base
pa [QueryParam]
qp Maybe String
fr

-- | Appends a query parameter
addQuery :: QueryParam -> Location base -> Location base
addQuery :: forall base. QueryParam -> Location base -> Location base
addQuery QueryParam
q (Location LocationPath base
pa [QueryParam]
qp Maybe String
fr) =
  forall base.
LocationPath base -> [QueryParam] -> Maybe String -> Location base
Location LocationPath base
pa ([QueryParam]
qp forall a. [a] -> [a] -> [a]
++ [QueryParam
q]) Maybe String
fr

(<&>) :: Location base -> QueryParam -> Location base
<&> :: forall base. Location base -> QueryParam -> Location base
(<&>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall base. QueryParam -> Location base -> Location base
addQuery

infixl 7 <&>

addQueries :: [QueryParam] -> Location base -> Location base
addQueries :: forall base. [QueryParam] -> Location base -> Location base
addQueries [QueryParam]
qs (Location LocationPath base
pa [QueryParam]
qs' Maybe String
fr) =
  forall base.
LocationPath base -> [QueryParam] -> Maybe String -> Location base
Location LocationPath base
pa ([QueryParam]
qs' forall a. [a] -> [a] -> [a]
++ [QueryParam]
qs) Maybe String
fr

delQuery :: Location base -> Location base
delQuery :: forall base. Location base -> Location base
delQuery = forall base. [QueryParam] -> Location base -> Location base
setQuery []

getQuery :: Location base -> [QueryParam]
getQuery :: forall base. Location base -> [QueryParam]
getQuery (Location LocationPath base
_ [QueryParam]
qp Maybe String
_) =
  [QueryParam]
qp


setFragment :: Maybe String -> Location base -> Location base
setFragment :: forall base. Maybe String -> Location base -> Location base
setFragment Maybe String
fr (Location LocationPath base
pa [QueryParam]
qp Maybe String
_) =
  forall base.
LocationPath base -> [QueryParam] -> Maybe String -> Location base
Location LocationPath base
pa [QueryParam]
qp Maybe String
fr

addFragment :: String -> Location base -> Location base
addFragment :: forall base. String -> Location base -> Location base
addFragment String
fr = forall base. Maybe String -> Location base -> Location base
setFragment (forall a. a -> Maybe a
Just String
fr)

(<#>) :: Location base -> String -> Location base
<#> :: forall base. Location base -> String -> Location base
(<#>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall base. String -> Location base -> Location base
addFragment

infixl 8 <#>

delFragment :: Location base -> Location base
delFragment :: forall base. Location base -> Location base
delFragment = forall base. Maybe String -> Location base -> Location base
setFragment forall a. Maybe a
Nothing

getFragment :: Location base -> Maybe String
getFragment :: forall base. Location base -> Maybe String
getFragment (Location LocationPath base
_ [QueryParam]
_ Maybe String
x) = Maybe String
x