{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

-- | An implementation of the RFC3987
--  [RFC3987]: http://www.ietf.org/rfc/rfc3987.txt
module Data.RDF.IRI
  ( IRI (..),
    IRIRef (..),
    Scheme (..),
    Authority (..),
    UserInfo (..),
    Host (..),
    Port (..),
    Path (..),
    IRIQuery (..),
    Fragment (..),
    IRIError (..),
    SchemaError (..),
    mkIRI,
    serializeIRI,
    parseIRI,
    parseRelIRI,
    validateIRI,
    resolveIRI,
    removeIRIFragment,
  )
where

#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#else
#endif
#else
#endif

#if MIN_VERSION_base(4,13,0)
import Data.Maybe (isJust)
#else
import Data.Maybe (maybe, isJust)
#endif

import Control.Applicative
import Control.Arrow (first, (&&&), (>>>))
import Control.Monad (guard)
import Data.Attoparsec.Text (Parser, (<?>))
import qualified Data.Attoparsec.Text as P
import Data.Char (isAlpha, isAlphaNum, isDigit, toLower, toUpper)
import Data.Functor
import Data.List (intersperse)
import Data.Text (Text)
import qualified Data.Text as T

-- | A serialized IRI representation.
newtype IRI = IRI {IRI -> Text
getIRI :: Text}
  deriving (Int -> IRI -> ShowS
[IRI] -> ShowS
IRI -> String
(Int -> IRI -> ShowS)
-> (IRI -> String) -> ([IRI] -> ShowS) -> Show IRI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IRI] -> ShowS
$cshowList :: [IRI] -> ShowS
show :: IRI -> String
$cshow :: IRI -> String
showsPrec :: Int -> IRI -> ShowS
$cshowsPrec :: Int -> IRI -> ShowS
Show, IRI -> IRI -> Bool
(IRI -> IRI -> Bool) -> (IRI -> IRI -> Bool) -> Eq IRI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IRI -> IRI -> Bool
$c/= :: IRI -> IRI -> Bool
== :: IRI -> IRI -> Bool
$c== :: IRI -> IRI -> Bool
Eq)

-- | A detailed IRI representation with its components.
data IRIRef
  = IRIRef
      !(Maybe Scheme)
      !(Maybe Authority)
      !Path
      !(Maybe IRIQuery)
      !(Maybe Fragment)
  deriving (Int -> IRIRef -> ShowS
[IRIRef] -> ShowS
IRIRef -> String
(Int -> IRIRef -> ShowS)
-> (IRIRef -> String) -> ([IRIRef] -> ShowS) -> Show IRIRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IRIRef] -> ShowS
$cshowList :: [IRIRef] -> ShowS
show :: IRIRef -> String
$cshow :: IRIRef -> String
showsPrec :: Int -> IRIRef -> ShowS
$cshowsPrec :: Int -> IRIRef -> ShowS
Show, IRIRef -> IRIRef -> Bool
(IRIRef -> IRIRef -> Bool)
-> (IRIRef -> IRIRef -> Bool) -> Eq IRIRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IRIRef -> IRIRef -> Bool
$c/= :: IRIRef -> IRIRef -> Bool
== :: IRIRef -> IRIRef -> Bool
$c== :: IRIRef -> IRIRef -> Bool
Eq, Eq IRIRef
Eq IRIRef
-> (IRIRef -> IRIRef -> Ordering)
-> (IRIRef -> IRIRef -> Bool)
-> (IRIRef -> IRIRef -> Bool)
-> (IRIRef -> IRIRef -> Bool)
-> (IRIRef -> IRIRef -> Bool)
-> (IRIRef -> IRIRef -> IRIRef)
-> (IRIRef -> IRIRef -> IRIRef)
-> Ord IRIRef
IRIRef -> IRIRef -> Bool
IRIRef -> IRIRef -> Ordering
IRIRef -> IRIRef -> IRIRef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IRIRef -> IRIRef -> IRIRef
$cmin :: IRIRef -> IRIRef -> IRIRef
max :: IRIRef -> IRIRef -> IRIRef
$cmax :: IRIRef -> IRIRef -> IRIRef
>= :: IRIRef -> IRIRef -> Bool
$c>= :: IRIRef -> IRIRef -> Bool
> :: IRIRef -> IRIRef -> Bool
$c> :: IRIRef -> IRIRef -> Bool
<= :: IRIRef -> IRIRef -> Bool
$c<= :: IRIRef -> IRIRef -> Bool
< :: IRIRef -> IRIRef -> Bool
$c< :: IRIRef -> IRIRef -> Bool
compare :: IRIRef -> IRIRef -> Ordering
$ccompare :: IRIRef -> IRIRef -> Ordering
$cp1Ord :: Eq IRIRef
Ord)

newtype Scheme = Scheme Text
  deriving (Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
(Int -> Scheme -> ShowS)
-> (Scheme -> String) -> ([Scheme] -> ShowS) -> Show Scheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scheme] -> ShowS
$cshowList :: [Scheme] -> ShowS
show :: Scheme -> String
$cshow :: Scheme -> String
showsPrec :: Int -> Scheme -> ShowS
$cshowsPrec :: Int -> Scheme -> ShowS
Show, Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c== :: Scheme -> Scheme -> Bool
Eq, Eq Scheme
Eq Scheme
-> (Scheme -> Scheme -> Ordering)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Scheme)
-> (Scheme -> Scheme -> Scheme)
-> Ord Scheme
Scheme -> Scheme -> Bool
Scheme -> Scheme -> Ordering
Scheme -> Scheme -> Scheme
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Scheme -> Scheme -> Scheme
$cmin :: Scheme -> Scheme -> Scheme
max :: Scheme -> Scheme -> Scheme
$cmax :: Scheme -> Scheme -> Scheme
>= :: Scheme -> Scheme -> Bool
$c>= :: Scheme -> Scheme -> Bool
> :: Scheme -> Scheme -> Bool
$c> :: Scheme -> Scheme -> Bool
<= :: Scheme -> Scheme -> Bool
$c<= :: Scheme -> Scheme -> Bool
< :: Scheme -> Scheme -> Bool
$c< :: Scheme -> Scheme -> Bool
compare :: Scheme -> Scheme -> Ordering
$ccompare :: Scheme -> Scheme -> Ordering
$cp1Ord :: Eq Scheme
Ord)

data Authority
  = Authority
      !(Maybe UserInfo)
      !Host
      !(Maybe Port)
  deriving (Int -> Authority -> ShowS
[Authority] -> ShowS
Authority -> String
(Int -> Authority -> ShowS)
-> (Authority -> String)
-> ([Authority] -> ShowS)
-> Show Authority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Authority] -> ShowS
$cshowList :: [Authority] -> ShowS
show :: Authority -> String
$cshow :: Authority -> String
showsPrec :: Int -> Authority -> ShowS
$cshowsPrec :: Int -> Authority -> ShowS
Show, Authority -> Authority -> Bool
(Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool) -> Eq Authority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Authority -> Authority -> Bool
$c/= :: Authority -> Authority -> Bool
== :: Authority -> Authority -> Bool
$c== :: Authority -> Authority -> Bool
Eq, Eq Authority
Eq Authority
-> (Authority -> Authority -> Ordering)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Authority)
-> (Authority -> Authority -> Authority)
-> Ord Authority
Authority -> Authority -> Bool
Authority -> Authority -> Ordering
Authority -> Authority -> Authority
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Authority -> Authority -> Authority
$cmin :: Authority -> Authority -> Authority
max :: Authority -> Authority -> Authority
$cmax :: Authority -> Authority -> Authority
>= :: Authority -> Authority -> Bool
$c>= :: Authority -> Authority -> Bool
> :: Authority -> Authority -> Bool
$c> :: Authority -> Authority -> Bool
<= :: Authority -> Authority -> Bool
$c<= :: Authority -> Authority -> Bool
< :: Authority -> Authority -> Bool
$c< :: Authority -> Authority -> Bool
compare :: Authority -> Authority -> Ordering
$ccompare :: Authority -> Authority -> Ordering
$cp1Ord :: Eq Authority
Ord)

newtype UserInfo = UserInfo Text
  deriving (Int -> UserInfo -> ShowS
[UserInfo] -> ShowS
UserInfo -> String
(Int -> UserInfo -> ShowS)
-> (UserInfo -> String) -> ([UserInfo] -> ShowS) -> Show UserInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserInfo] -> ShowS
$cshowList :: [UserInfo] -> ShowS
show :: UserInfo -> String
$cshow :: UserInfo -> String
showsPrec :: Int -> UserInfo -> ShowS
$cshowsPrec :: Int -> UserInfo -> ShowS
Show, UserInfo -> UserInfo -> Bool
(UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool) -> Eq UserInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserInfo -> UserInfo -> Bool
$c/= :: UserInfo -> UserInfo -> Bool
== :: UserInfo -> UserInfo -> Bool
$c== :: UserInfo -> UserInfo -> Bool
Eq, Eq UserInfo
Eq UserInfo
-> (UserInfo -> UserInfo -> Ordering)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> UserInfo)
-> (UserInfo -> UserInfo -> UserInfo)
-> Ord UserInfo
UserInfo -> UserInfo -> Bool
UserInfo -> UserInfo -> Ordering
UserInfo -> UserInfo -> UserInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UserInfo -> UserInfo -> UserInfo
$cmin :: UserInfo -> UserInfo -> UserInfo
max :: UserInfo -> UserInfo -> UserInfo
$cmax :: UserInfo -> UserInfo -> UserInfo
>= :: UserInfo -> UserInfo -> Bool
$c>= :: UserInfo -> UserInfo -> Bool
> :: UserInfo -> UserInfo -> Bool
$c> :: UserInfo -> UserInfo -> Bool
<= :: UserInfo -> UserInfo -> Bool
$c<= :: UserInfo -> UserInfo -> Bool
< :: UserInfo -> UserInfo -> Bool
$c< :: UserInfo -> UserInfo -> Bool
compare :: UserInfo -> UserInfo -> Ordering
$ccompare :: UserInfo -> UserInfo -> Ordering
$cp1Ord :: Eq UserInfo
Ord)

newtype Host = Host Text
  deriving (Int -> Host -> ShowS
[Host] -> ShowS
Host -> String
(Int -> Host -> ShowS)
-> (Host -> String) -> ([Host] -> ShowS) -> Show Host
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Host] -> ShowS
$cshowList :: [Host] -> ShowS
show :: Host -> String
$cshow :: Host -> String
showsPrec :: Int -> Host -> ShowS
$cshowsPrec :: Int -> Host -> ShowS
Show, Host -> Host -> Bool
(Host -> Host -> Bool) -> (Host -> Host -> Bool) -> Eq Host
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Host -> Host -> Bool
$c/= :: Host -> Host -> Bool
== :: Host -> Host -> Bool
$c== :: Host -> Host -> Bool
Eq, Eq Host
Eq Host
-> (Host -> Host -> Ordering)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Host)
-> (Host -> Host -> Host)
-> Ord Host
Host -> Host -> Bool
Host -> Host -> Ordering
Host -> Host -> Host
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Host -> Host -> Host
$cmin :: Host -> Host -> Host
max :: Host -> Host -> Host
$cmax :: Host -> Host -> Host
>= :: Host -> Host -> Bool
$c>= :: Host -> Host -> Bool
> :: Host -> Host -> Bool
$c> :: Host -> Host -> Bool
<= :: Host -> Host -> Bool
$c<= :: Host -> Host -> Bool
< :: Host -> Host -> Bool
$c< :: Host -> Host -> Bool
compare :: Host -> Host -> Ordering
$ccompare :: Host -> Host -> Ordering
$cp1Ord :: Eq Host
Ord)

newtype Port = Port Int
  deriving (Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
(Int -> Port -> ShowS)
-> (Port -> String) -> ([Port] -> ShowS) -> Show Port
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Port] -> ShowS
$cshowList :: [Port] -> ShowS
show :: Port -> String
$cshow :: Port -> String
showsPrec :: Int -> Port -> ShowS
$cshowsPrec :: Int -> Port -> ShowS
Show, Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c== :: Port -> Port -> Bool
Eq, Eq Port
Eq Port
-> (Port -> Port -> Ordering)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> Ord Port
Port -> Port -> Bool
Port -> Port -> Ordering
Port -> Port -> Port
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmax :: Port -> Port -> Port
>= :: Port -> Port -> Bool
$c>= :: Port -> Port -> Bool
> :: Port -> Port -> Bool
$c> :: Port -> Port -> Bool
<= :: Port -> Port -> Bool
$c<= :: Port -> Port -> Bool
< :: Port -> Port -> Bool
$c< :: Port -> Port -> Bool
compare :: Port -> Port -> Ordering
$ccompare :: Port -> Port -> Ordering
$cp1Ord :: Eq Port
Ord)

newtype Path = Path Text
  deriving (Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show, Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, b -> Path -> Path
NonEmpty Path -> Path
Path -> Path -> Path
(Path -> Path -> Path)
-> (NonEmpty Path -> Path)
-> (forall b. Integral b => b -> Path -> Path)
-> Semigroup Path
forall b. Integral b => b -> Path -> Path
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Path -> Path
$cstimes :: forall b. Integral b => b -> Path -> Path
sconcat :: NonEmpty Path -> Path
$csconcat :: NonEmpty Path -> Path
<> :: Path -> Path -> Path
$c<> :: Path -> Path -> Path
Semigroup, Semigroup Path
Path
Semigroup Path
-> Path
-> (Path -> Path -> Path)
-> ([Path] -> Path)
-> Monoid Path
[Path] -> Path
Path -> Path -> Path
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Path] -> Path
$cmconcat :: [Path] -> Path
mappend :: Path -> Path -> Path
$cmappend :: Path -> Path -> Path
mempty :: Path
$cmempty :: Path
$cp1Monoid :: Semigroup Path
Monoid, Eq Path
Eq Path
-> (Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmax :: Path -> Path -> Path
>= :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c< :: Path -> Path -> Bool
compare :: Path -> Path -> Ordering
$ccompare :: Path -> Path -> Ordering
$cp1Ord :: Eq Path
Ord)

newtype IRIQuery = IRIQuery Text
  deriving (Int -> IRIQuery -> ShowS
[IRIQuery] -> ShowS
IRIQuery -> String
(Int -> IRIQuery -> ShowS)
-> (IRIQuery -> String) -> ([IRIQuery] -> ShowS) -> Show IRIQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IRIQuery] -> ShowS
$cshowList :: [IRIQuery] -> ShowS
show :: IRIQuery -> String
$cshow :: IRIQuery -> String
showsPrec :: Int -> IRIQuery -> ShowS
$cshowsPrec :: Int -> IRIQuery -> ShowS
Show, IRIQuery -> IRIQuery -> Bool
(IRIQuery -> IRIQuery -> Bool)
-> (IRIQuery -> IRIQuery -> Bool) -> Eq IRIQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IRIQuery -> IRIQuery -> Bool
$c/= :: IRIQuery -> IRIQuery -> Bool
== :: IRIQuery -> IRIQuery -> Bool
$c== :: IRIQuery -> IRIQuery -> Bool
Eq, b -> IRIQuery -> IRIQuery
NonEmpty IRIQuery -> IRIQuery
IRIQuery -> IRIQuery -> IRIQuery
(IRIQuery -> IRIQuery -> IRIQuery)
-> (NonEmpty IRIQuery -> IRIQuery)
-> (forall b. Integral b => b -> IRIQuery -> IRIQuery)
-> Semigroup IRIQuery
forall b. Integral b => b -> IRIQuery -> IRIQuery
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> IRIQuery -> IRIQuery
$cstimes :: forall b. Integral b => b -> IRIQuery -> IRIQuery
sconcat :: NonEmpty IRIQuery -> IRIQuery
$csconcat :: NonEmpty IRIQuery -> IRIQuery
<> :: IRIQuery -> IRIQuery -> IRIQuery
$c<> :: IRIQuery -> IRIQuery -> IRIQuery
Semigroup, Eq IRIQuery
Eq IRIQuery
-> (IRIQuery -> IRIQuery -> Ordering)
-> (IRIQuery -> IRIQuery -> Bool)
-> (IRIQuery -> IRIQuery -> Bool)
-> (IRIQuery -> IRIQuery -> Bool)
-> (IRIQuery -> IRIQuery -> Bool)
-> (IRIQuery -> IRIQuery -> IRIQuery)
-> (IRIQuery -> IRIQuery -> IRIQuery)
-> Ord IRIQuery
IRIQuery -> IRIQuery -> Bool
IRIQuery -> IRIQuery -> Ordering
IRIQuery -> IRIQuery -> IRIQuery
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IRIQuery -> IRIQuery -> IRIQuery
$cmin :: IRIQuery -> IRIQuery -> IRIQuery
max :: IRIQuery -> IRIQuery -> IRIQuery
$cmax :: IRIQuery -> IRIQuery -> IRIQuery
>= :: IRIQuery -> IRIQuery -> Bool
$c>= :: IRIQuery -> IRIQuery -> Bool
> :: IRIQuery -> IRIQuery -> Bool
$c> :: IRIQuery -> IRIQuery -> Bool
<= :: IRIQuery -> IRIQuery -> Bool
$c<= :: IRIQuery -> IRIQuery -> Bool
< :: IRIQuery -> IRIQuery -> Bool
$c< :: IRIQuery -> IRIQuery -> Bool
compare :: IRIQuery -> IRIQuery -> Ordering
$ccompare :: IRIQuery -> IRIQuery -> Ordering
$cp1Ord :: Eq IRIQuery
Ord)

instance Monoid IRIQuery where
  mempty :: IRIQuery
mempty = Text -> IRIQuery
IRIQuery Text
forall a. Monoid a => a
mempty

#if !(MIN_VERSION_base(4,11,0))
  mappend = (<>)
#endif

newtype Fragment = Fragment Text
  deriving (Int -> Fragment -> ShowS
[Fragment] -> ShowS
Fragment -> String
(Int -> Fragment -> ShowS)
-> (Fragment -> String) -> ([Fragment] -> ShowS) -> Show Fragment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fragment] -> ShowS
$cshowList :: [Fragment] -> ShowS
show :: Fragment -> String
$cshow :: Fragment -> String
showsPrec :: Int -> Fragment -> ShowS
$cshowsPrec :: Int -> Fragment -> ShowS
Show, Fragment -> Fragment -> Bool
(Fragment -> Fragment -> Bool)
-> (Fragment -> Fragment -> Bool) -> Eq Fragment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fragment -> Fragment -> Bool
$c/= :: Fragment -> Fragment -> Bool
== :: Fragment -> Fragment -> Bool
$c== :: Fragment -> Fragment -> Bool
Eq, b -> Fragment -> Fragment
NonEmpty Fragment -> Fragment
Fragment -> Fragment -> Fragment
(Fragment -> Fragment -> Fragment)
-> (NonEmpty Fragment -> Fragment)
-> (forall b. Integral b => b -> Fragment -> Fragment)
-> Semigroup Fragment
forall b. Integral b => b -> Fragment -> Fragment
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Fragment -> Fragment
$cstimes :: forall b. Integral b => b -> Fragment -> Fragment
sconcat :: NonEmpty Fragment -> Fragment
$csconcat :: NonEmpty Fragment -> Fragment
<> :: Fragment -> Fragment -> Fragment
$c<> :: Fragment -> Fragment -> Fragment
Semigroup, Eq Fragment
Eq Fragment
-> (Fragment -> Fragment -> Ordering)
-> (Fragment -> Fragment -> Bool)
-> (Fragment -> Fragment -> Bool)
-> (Fragment -> Fragment -> Bool)
-> (Fragment -> Fragment -> Bool)
-> (Fragment -> Fragment -> Fragment)
-> (Fragment -> Fragment -> Fragment)
-> Ord Fragment
Fragment -> Fragment -> Bool
Fragment -> Fragment -> Ordering
Fragment -> Fragment -> Fragment
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Fragment -> Fragment -> Fragment
$cmin :: Fragment -> Fragment -> Fragment
max :: Fragment -> Fragment -> Fragment
$cmax :: Fragment -> Fragment -> Fragment
>= :: Fragment -> Fragment -> Bool
$c>= :: Fragment -> Fragment -> Bool
> :: Fragment -> Fragment -> Bool
$c> :: Fragment -> Fragment -> Bool
<= :: Fragment -> Fragment -> Bool
$c<= :: Fragment -> Fragment -> Bool
< :: Fragment -> Fragment -> Bool
$c< :: Fragment -> Fragment -> Bool
compare :: Fragment -> Fragment -> Ordering
$ccompare :: Fragment -> Fragment -> Ordering
$cp1Ord :: Eq Fragment
Ord)

instance Monoid Fragment where
  mempty :: Fragment
mempty = Text -> Fragment
Fragment Text
forall a. Monoid a => a
mempty

#if !(MIN_VERSION_base(4,11,0))
  mappend = (<>)
#endif

data IRIError = InvalidIRI
  deriving (Int -> IRIError -> ShowS
[IRIError] -> ShowS
IRIError -> String
(Int -> IRIError -> ShowS)
-> (IRIError -> String) -> ([IRIError] -> ShowS) -> Show IRIError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IRIError] -> ShowS
$cshowList :: [IRIError] -> ShowS
show :: IRIError -> String
$cshow :: IRIError -> String
showsPrec :: Int -> IRIError -> ShowS
$cshowsPrec :: Int -> IRIError -> ShowS
Show, IRIError -> IRIError -> Bool
(IRIError -> IRIError -> Bool)
-> (IRIError -> IRIError -> Bool) -> Eq IRIError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IRIError -> IRIError -> Bool
$c/= :: IRIError -> IRIError -> Bool
== :: IRIError -> IRIError -> Bool
$c== :: IRIError -> IRIError -> Bool
Eq)

data SchemaError
  = -- | Scheme must start with an alphabet character
    NonAlphaLeading
  | -- | Subsequent characters in the schema were invalid
    InvalidChars
  | -- | Schemas must be followed by a colon
    MissingColon
  deriving (Int -> SchemaError -> ShowS
[SchemaError] -> ShowS
SchemaError -> String
(Int -> SchemaError -> ShowS)
-> (SchemaError -> String)
-> ([SchemaError] -> ShowS)
-> Show SchemaError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaError] -> ShowS
$cshowList :: [SchemaError] -> ShowS
show :: SchemaError -> String
$cshow :: SchemaError -> String
showsPrec :: Int -> SchemaError -> ShowS
$cshowsPrec :: Int -> SchemaError -> ShowS
Show, SchemaError -> SchemaError -> Bool
(SchemaError -> SchemaError -> Bool)
-> (SchemaError -> SchemaError -> Bool) -> Eq SchemaError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaError -> SchemaError -> Bool
$c/= :: SchemaError -> SchemaError -> Bool
== :: SchemaError -> SchemaError -> Bool
$c== :: SchemaError -> SchemaError -> Bool
Eq)

removeIRIFragment :: IRIRef -> IRIRef
removeIRIFragment :: IRIRef -> IRIRef
removeIRIFragment (IRIRef Maybe Scheme
s Maybe Authority
a Path
p Maybe IRIQuery
q Maybe Fragment
_) = Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> Maybe Fragment
-> IRIRef
IRIRef Maybe Scheme
s Maybe Authority
a Path
p Maybe IRIQuery
q Maybe Fragment
forall a. Maybe a
Nothing

-- [TODO] use Builder
serializeIRI :: IRIRef -> Text
serializeIRI :: IRIRef -> Text
serializeIRI (IRIRef Maybe Scheme
s Maybe Authority
a Path
p Maybe IRIQuery
q Maybe Fragment
f) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text -> (Scheme -> Text) -> Maybe Scheme -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty Scheme -> Text
scheme Maybe Scheme
s,
      Text -> (Authority -> Text) -> Maybe Authority -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty Authority -> Text
authority Maybe Authority
a,
      Path -> Text
path Path
p,
      Text -> (IRIQuery -> Text) -> Maybe IRIQuery -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty IRIQuery -> Text
query Maybe IRIQuery
q,
      Text -> (Fragment -> Text) -> Maybe Fragment -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty Fragment -> Text
fragment Maybe Fragment
f
    ]
  where
    scheme :: Scheme -> Text
scheme (Scheme Text
s') = Text
s' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
    authority :: Authority -> Text
authority (Authority Maybe UserInfo
u (Host Text
h) Maybe Port
p') =
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"//",
          Text -> (UserInfo -> Text) -> Maybe UserInfo -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty UserInfo -> Text
userInfo Maybe UserInfo
u,
          Text
h,
          Text -> (Port -> Text) -> Maybe Port -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty Port -> Text
port Maybe Port
p'
        ]
    userInfo :: UserInfo -> Text
userInfo (UserInfo Text
u) = Text
u Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@"
    port :: Port -> Text
port (Port Int
p') = (Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
p'
    path :: Path -> Text
path (Path Text
p') = Text
p'
    query :: IRIQuery -> Text
query (IRIQuery Text
q') = Text
"?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q'
    fragment :: Fragment -> Text
fragment (Fragment Text
f') = Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f'

mkIRI :: Text -> Either String IRI
mkIRI :: Text -> Either String IRI
mkIRI Text
t = Text -> IRI
IRI (Text -> IRI) -> (IRIRef -> Text) -> IRIRef -> IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRIRef -> Text
serializeIRI (IRIRef -> IRI) -> Either String IRIRef -> Either String IRI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either String IRIRef
parseIRI Text
t

parseIRI :: Text -> Either String IRIRef
parseIRI :: Text -> Either String IRIRef
parseIRI = Parser IRIRef -> Text -> Either String IRIRef
forall a. Parser a -> Text -> Either String a
P.parseOnly (Parser IRIRef -> Text -> Either String IRIRef)
-> Parser IRIRef -> Text -> Either String IRIRef
forall a b. (a -> b) -> a -> b
$ Parser IRIRef
iriParser Parser IRIRef -> Parser Text () -> Parser IRIRef
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text ()
forall t. Chunk t => Parser t ()
P.endOfInput Parser Text () -> String -> Parser Text ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"Unexpected characters at the end")

parseRelIRI :: Text -> Either String IRIRef
parseRelIRI :: Text -> Either String IRIRef
parseRelIRI = Parser IRIRef -> Text -> Either String IRIRef
forall a. Parser a -> Text -> Either String a
P.parseOnly (Parser IRIRef -> Text -> Either String IRIRef)
-> Parser IRIRef -> Text -> Either String IRIRef
forall a b. (a -> b) -> a -> b
$ Parser IRIRef
irelativeRefParser Parser IRIRef -> Parser Text () -> Parser IRIRef
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text ()
forall t. Chunk t => Parser t ()
P.endOfInput Parser Text () -> String -> Parser Text ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"Unexpected characters at the end")

validateIRI :: Text -> Either String Text
validateIRI :: Text -> Either String Text
validateIRI Text
t = Text
t Text -> Either String IRIRef -> Either String Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Either String IRIRef
parseIRI Text
t

-- | IRI parsing and resolution according to algorithm 5.2 from RFC3986
-- See: http://www.ietf.org/rfc/rfc3986.txt
-- [FIXME] Currently, this is a correct but naive implementation.
resolveIRI ::
  -- | Base URI
  Text ->
  -- | URI to resolve
  Text ->
  Either String Text
resolveIRI :: Text -> Text -> Either String Text
resolveIRI Text
baseIri Text
iri = IRIRef -> Text
serializeIRI (IRIRef -> Text) -> Either String IRIRef -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String IRIRef
resolvedIRI
  where
    resolvedIRI :: Either String IRIRef
resolvedIRI = (String -> Either String IRIRef)
-> (IRIRef -> Either String IRIRef)
-> Either String IRIRef
-> Either String IRIRef
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either String IRIRef -> String -> Either String IRIRef
forall a b. a -> b -> a
const Either String IRIRef
resolvedRelativeIRI) IRIRef -> Either String IRIRef
forall (m :: * -> *). Monad m => IRIRef -> m IRIRef
resolveAbsoluteIRI (Text -> Either String IRIRef
parseIRI Text
iri)
    resolveAbsoluteIRI :: IRIRef -> m IRIRef
resolveAbsoluteIRI (IRIRef Maybe Scheme
s Maybe Authority
a (Path Text
p) Maybe IRIQuery
q Maybe Fragment
f) = IRIRef -> m IRIRef
forall (m :: * -> *) a. Monad m => a -> m a
return (IRIRef -> m IRIRef) -> IRIRef -> m IRIRef
forall a b. (a -> b) -> a -> b
$ Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> Maybe Fragment
-> IRIRef
IRIRef Maybe Scheme
s Maybe Authority
a (Text -> Path
removeDotSegments Text
p) Maybe IRIQuery
q Maybe Fragment
f
    resolvedRelativeIRI :: Either String IRIRef
resolvedRelativeIRI = do
      -- Parse as a relative IRI
      (IRIRef Maybe Scheme
_ Maybe Authority
ra rp :: Path
rp@(Path Text
rp') Maybe IRIQuery
rq Maybe Fragment
rf) <- Text -> Either String IRIRef
parseRelIRI Text
iri
      -- Parse base IRI
      (IRIRef Maybe Scheme
bs Maybe Authority
ba Path
bp Maybe IRIQuery
bq Maybe Fragment
_) <- Text -> Either String IRIRef
parseIRI Text
baseIri
      let rIriWithoutAuth :: Either String IRIRef
rIriWithoutAuth = Path
-> Maybe IRIQuery
-> Maybe Fragment
-> Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> Either String IRIRef
forall (m :: * -> *).
Monad m =>
Path
-> Maybe IRIQuery
-> Maybe Fragment
-> Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> m IRIRef
resolveIriWithoutAuth Path
rp Maybe IRIQuery
rq Maybe Fragment
rf Maybe Scheme
bs Maybe Authority
ba Path
bp Maybe IRIQuery
bq
          rIriWithAuth :: Either String IRIRef
rIriWithAuth = IRIRef -> Either String IRIRef
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> Maybe Fragment
-> IRIRef
IRIRef Maybe Scheme
bs Maybe Authority
ra (Text -> Path
removeDotSegments Text
rp') Maybe IRIQuery
rq Maybe Fragment
rf)
      Either String IRIRef
-> (Authority -> Either String IRIRef)
-> Maybe Authority
-> Either String IRIRef
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either String IRIRef
rIriWithoutAuth (Either String IRIRef -> Authority -> Either String IRIRef
forall a b. a -> b -> a
const Either String IRIRef
rIriWithAuth) Maybe Authority
ra
    resolveIriWithoutAuth :: Path
-> Maybe IRIQuery
-> Maybe Fragment
-> Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> m IRIRef
resolveIriWithoutAuth Path
rp Maybe IRIQuery
rq Maybe Fragment
rf Maybe Scheme
bs Maybe Authority
ba Path
bp Maybe IRIQuery
bq =
      IRIRef -> m IRIRef
forall (m :: * -> *) a. Monad m => a -> m a
return
        (IRIRef -> m IRIRef) -> IRIRef -> m IRIRef
forall a b. (a -> b) -> a -> b
$! if (Path
rp Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
forall a. Monoid a => a
mempty)
          then IRIRef -> (IRIQuery -> IRIRef) -> Maybe IRIQuery -> IRIRef
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> Maybe Fragment
-> IRIRef
IRIRef Maybe Scheme
bs Maybe Authority
ba Path
bp Maybe IRIQuery
bq Maybe Fragment
rf) (IRIRef -> IRIQuery -> IRIRef
forall a b. a -> b -> a
const (Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> Maybe Fragment
-> IRIRef
IRIRef Maybe Scheme
bs Maybe Authority
ba Path
bp Maybe IRIQuery
rq Maybe Fragment
rf)) Maybe IRIQuery
rq
          else
            let (Path Text
rp') = Path
rp
             in if (Text -> Char
T.head Text
rp' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')
                  then Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> Maybe Fragment
-> IRIRef
IRIRef Maybe Scheme
bs Maybe Authority
ba (Text -> Path
removeDotSegments Text
rp') Maybe IRIQuery
rq Maybe Fragment
rf
                  else Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> Maybe Fragment
-> IRIRef
IRIRef Maybe Scheme
bs Maybe Authority
ba (Text -> Path
removeDotSegments (Maybe Authority -> Path -> Path -> Text
forall a. Maybe a -> Path -> Path -> Text
merge Maybe Authority
ba Path
bp Path
rp)) Maybe IRIQuery
rq Maybe Fragment
rf
    removeDotSegments :: Text -> Path
removeDotSegments Text
p = [Text] -> [Text] -> Path
removeDotSegments' ((Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
p) [Text]
forall a. Monoid a => a
mempty
    removeDotSegments' :: [Text] -> [Text] -> Path
removeDotSegments' [] [Text]
os = Text -> Path
Path (Text -> Path) -> Text -> Path
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"/" [Text]
os)
    removeDotSegments' [Text
"."] [Text]
os = [Text] -> [Text] -> Path
removeDotSegments' [Text]
forall a. Monoid a => a
mempty ([Text]
os [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
forall a. Monoid a => a
mempty])
    removeDotSegments' [Text
".."] [] = [Text] -> [Text] -> Path
removeDotSegments' [Text]
forall a. Monoid a => a
mempty [Text]
forall a. Monoid a => a
mempty
    removeDotSegments' [Text
".."] [Text]
os = [Text] -> [Text] -> Path
removeDotSegments' [Text]
forall a. Monoid a => a
mempty ([Text] -> [Text]
forall a. [a] -> [a]
init [Text]
os [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
forall a. Monoid a => a
mempty])
    removeDotSegments' ss :: [Text]
ss@[Text
_] [Text]
os = [Text] -> [Text] -> Path
removeDotSegments' [Text]
forall a. Monoid a => a
mempty ([Text]
os [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ss)
    removeDotSegments' (Text
"." : [Text]
ss) [Text]
os = [Text] -> [Text] -> Path
removeDotSegments' [Text]
ss [Text]
os
    removeDotSegments' (Text
".." : [Text]
ss) [] = [Text] -> [Text] -> Path
removeDotSegments' [Text]
ss [Text]
forall a. Monoid a => a
mempty
    removeDotSegments' (Text
".." : [Text]
ss) os :: [Text]
os@[Text
""] = [Text] -> [Text] -> Path
removeDotSegments' [Text]
ss [Text]
os
    removeDotSegments' (Text
".." : [Text]
ss) [Text]
os = [Text] -> [Text] -> Path
removeDotSegments' [Text]
ss ([Text] -> [Text]
forall a. [a] -> [a]
init [Text]
os)
    removeDotSegments' (Text
s : [Text]
ss) [Text]
os = [Text] -> [Text] -> Path
removeDotSegments' [Text]
ss ([Text]
os [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
s])
    merge :: Maybe a -> Path -> Path -> Text
merge Maybe a
ba (Path Text
bp) (Path Text
rp)
      | Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
ba Bool -> Bool -> Bool
&& Text
bp Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
forall a. Monoid a => a
mempty = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rp
      | Bool
otherwise = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') Text
bp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rp

-- IRI = scheme ":" ihier-part [ "?" iquery ] [ "#" ifragment ]
iriParser :: Parser IRIRef
iriParser :: Parser IRIRef
iriParser = do
  Maybe Scheme
scheme <- Scheme -> Maybe Scheme
forall a. a -> Maybe a
Just (Scheme -> Maybe Scheme)
-> Parser Text Scheme -> Parser Text (Maybe Scheme)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Scheme
schemeParser
  Text
_ <- Text -> Parser Text
P.string Text
":" Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Missing colon after scheme"
  (Maybe Authority
authority, Path
path) <- Parser (Maybe Authority, Path)
ihierPartParser
  Maybe IRIQuery
query <- Parser Text IRIQuery -> Parser Text (Maybe IRIQuery)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text IRIQuery
iqueryParser
  Maybe Fragment
fragment <- Parser Text Fragment -> Parser Text (Maybe Fragment)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text Fragment
ifragmentParser
  IRIRef -> Parser IRIRef
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> Maybe Fragment
-> IRIRef
IRIRef Maybe Scheme
scheme Maybe Authority
authority Path
path Maybe IRIQuery
query Maybe Fragment
fragment)

-- ihier-part = "//" iauthority ipath-abempty
--            / ipath-absolute
--            / ipath-rootless
--            / ipath-empty
ihierPartParser :: Parser (Maybe Authority, Path)
ihierPartParser :: Parser (Maybe Authority, Path)
ihierPartParser =
  Parser (Maybe Authority, Path)
iauthWithPathParser
    Parser (Maybe Authority, Path)
-> Parser (Maybe Authority, Path) -> Parser (Maybe Authority, Path)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe Authority, Path)
ipathAbsoluteParser
    Parser (Maybe Authority, Path)
-> Parser (Maybe Authority, Path) -> Parser (Maybe Authority, Path)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe Authority, Path)
ipathRootlessParser
    Parser (Maybe Authority, Path)
-> Parser (Maybe Authority, Path) -> Parser (Maybe Authority, Path)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe Authority, Path)
ipathEmptyParser

-- IRI-reference = IRI / irelative-ref
-- [TODO]

-- absolute-IRI = scheme ":" ihier-part [ "?" iquery ]
-- [TODO]

-- irelative-ref = irelative-part [ "?" iquery ] [ "#" ifragment ]
irelativeRefParser :: Parser IRIRef
irelativeRefParser :: Parser IRIRef
irelativeRefParser = do
  (Maybe Authority
authority, Path
path) <- Parser (Maybe Authority, Path)
irelativePartParser
  Maybe IRIQuery
query <- Parser Text IRIQuery -> Parser Text (Maybe IRIQuery)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text IRIQuery
iqueryParser
  Maybe Fragment
fragment <- Parser Text Fragment -> Parser Text (Maybe Fragment)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text Fragment
ifragmentParser
  IRIRef -> Parser IRIRef
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Scheme
-> Maybe Authority
-> Path
-> Maybe IRIQuery
-> Maybe Fragment
-> IRIRef
IRIRef Maybe Scheme
forall a. Maybe a
Nothing Maybe Authority
authority Path
path Maybe IRIQuery
query Maybe Fragment
fragment)

-- irelative-part = "//" iauthority ipath-abempty
--                / ipath-absolute
--                / ipath-noscheme
--                / ipath-empty
irelativePartParser :: Parser (Maybe Authority, Path)
irelativePartParser :: Parser (Maybe Authority, Path)
irelativePartParser =
  Parser (Maybe Authority, Path)
iauthWithPathParser
    Parser (Maybe Authority, Path)
-> Parser (Maybe Authority, Path) -> Parser (Maybe Authority, Path)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe Authority, Path)
ipathAbsoluteParser
    Parser (Maybe Authority, Path)
-> Parser (Maybe Authority, Path) -> Parser (Maybe Authority, Path)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe Authority, Path)
ipathNoSchemeParser
    Parser (Maybe Authority, Path)
-> Parser (Maybe Authority, Path) -> Parser (Maybe Authority, Path)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe Authority, Path)
ipathEmptyParser

-- iauthority = [ iuserinfo "@" ] ihost [ ":" port ]
iauthorityParser :: Parser Authority
iauthorityParser :: Parser Authority
iauthorityParser =
  Maybe UserInfo -> Host -> Maybe Port -> Authority
Authority (Maybe UserInfo -> Host -> Maybe Port -> Authority)
-> Parser Text (Maybe UserInfo)
-> Parser Text (Host -> Maybe Port -> Authority)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text UserInfo -> Parser Text (Maybe UserInfo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text UserInfo
iuserInfoParser Parser Text UserInfo -> Parser Text -> Parser Text UserInfo
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text
P.string Text
"@")
    Parser Text (Host -> Maybe Port -> Authority)
-> Parser Text Host -> Parser Text (Maybe Port -> Authority)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Host
ihostParser
    Parser Text (Maybe Port -> Authority)
-> Parser Text (Maybe Port) -> Parser Authority
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Port -> Parser Text (Maybe Port)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text
P.string Text
":" Parser Text -> Parser Text Port -> Parser Text Port
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Port
portParser)
    Parser Authority -> String -> Parser Authority
forall i a. Parser i a -> String -> Parser i a
<?> String
"Authority"

-- iuserinfo = *( iunreserved / pct-encoded / sub-delims / ":" )
iuserInfoParser :: Parser UserInfo
iuserInfoParser :: Parser Text UserInfo
iuserInfoParser = Text -> UserInfo
UserInfo (Text -> UserInfo) -> ([Text] -> Text) -> [Text] -> UserInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> UserInfo) -> Parser Text [Text] -> Parser Text UserInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 Parser Text
iuserInfoP
  where
    iuserInfoP :: Parser Text
iuserInfoP = Parser Text
iunreservedP Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
pctEncodedParser Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
subDelimsP Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
P.string Text
":"

-- ihost = IP-literal / IPv4address / ireg-name
ihostParser :: Parser Host
ihostParser :: Parser Text Host
ihostParser =
  Text -> Host
Host (Text -> Host) -> Parser Text -> Parser Text Host
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text
ipLiteralParser Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
ipV4AddressParser Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
iregNameParser)
    Parser Text Host -> String -> Parser Text Host
forall i a. Parser i a -> String -> Parser i a
<?> String
"Host"

-- ireg-name = *( iunreserved / pct-encoded / sub-delims )
iregNameParser :: Parser Text
iregNameParser :: Parser Text
iregNameParser = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Parser Text
iunreservedP Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
pctEncodedParser Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
subDelimsP)

{-
ipath          = ipath-abempty   ; begins with "/" or is empty
                  / ipath-absolute  ; begins with "/" but not "//"
                  / ipath-noscheme  ; begins with a non-colon segment
                  / ipath-rootless  ; begins with a segment
                  / ipath-empty     ; zero characters
-}
-- [TODO]

-- ipath-abempty = *( "/" isegment )
ipathAbEmptyParser :: Parser Path
ipathAbEmptyParser :: Parser Path
ipathAbEmptyParser = Text -> Path
Path (Text -> Path) -> Parser Text -> Parser Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
ipathAbEmptyParser'

ipathAbEmptyParser' :: Parser Text
ipathAbEmptyParser' :: Parser Text
ipathAbEmptyParser' = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text] -> Parser Text [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Text -> Parser Text
P.string Text
"/", Parser Text
isegmentParser])

-- ipath-absolute = "/" [ isegment-nz *( "/" isegment ) ]
ipathAbsoluteParser :: Parser (Maybe Authority, Path)
ipathAbsoluteParser :: Parser (Maybe Authority, Path)
ipathAbsoluteParser = (Maybe Authority
forall a. Maybe a
Nothing,) (Path -> (Maybe Authority, Path))
-> Parser Path -> Parser (Maybe Authority, Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Path
Path (Text -> Path) -> Parser Text -> Parser Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
ipathAbsoluteParser')

ipathAbsoluteParser' :: Parser Text
ipathAbsoluteParser' :: Parser Text
ipathAbsoluteParser' = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text] -> Parser Text [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Text -> Parser Text
P.string Text
"/", Parser Text
ipathRootlessParser']

-- ipath-noscheme = isegment-nz-nc *( "/" isegment )
ipathNoSchemeParser :: Parser (Maybe Authority, Path)
ipathNoSchemeParser :: Parser (Maybe Authority, Path)
ipathNoSchemeParser = (Maybe Authority
forall a. Maybe a
Nothing,) (Path -> (Maybe Authority, Path))
-> Parser Path -> Parser (Maybe Authority, Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Path
Path (Text -> Path) -> Parser Text -> Parser Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
ipathNoSchemeParser')

ipathNoSchemeParser' :: Parser Text
ipathNoSchemeParser' :: Parser Text
ipathNoSchemeParser' = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text] -> Parser Text [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Parser Text
isegmentNzNcParser, Parser Text
ipathAbEmptyParser']

-- ipath-rootless = isegment-nz *( "/" isegment )
ipathRootlessParser :: Parser (Maybe Authority, Path)
ipathRootlessParser :: Parser (Maybe Authority, Path)
ipathRootlessParser = (Maybe Authority
forall a. Maybe a
Nothing,) (Path -> (Maybe Authority, Path))
-> Parser Path -> Parser (Maybe Authority, Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Path
Path (Text -> Path) -> Parser Text -> Parser Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
ipathRootlessParser')

ipathRootlessParser' :: Parser Text
ipathRootlessParser' :: Parser Text
ipathRootlessParser' = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text] -> Parser Text [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Parser Text
isegmentNzParser, Parser Text
ipathAbEmptyParser']

-- ipath-empty = 0<ipchar>
ipathEmptyParser :: Parser (Maybe Authority, Path)
ipathEmptyParser :: Parser (Maybe Authority, Path)
ipathEmptyParser = (Maybe Authority
forall a. Maybe a
Nothing, Path
forall a. Monoid a => a
mempty) (Maybe Authority, Path)
-> Parser Text -> Parser (Maybe Authority, Path)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text
ipathEmptyParser'

ipathEmptyParser' :: Parser Text
ipathEmptyParser' :: Parser Text
ipathEmptyParser' = Text -> Parser Text
P.string Text
forall a. Monoid a => a
mempty Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Empty path"

-- isegment = *ipchar
isegmentParser :: Parser Text
isegmentParser :: Parser Text
isegmentParser = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' Parser Text
ipcharParser)

-- isegment-nz = 1*ipchar
isegmentNzParser :: Parser Text
isegmentNzParser :: Parser Text
isegmentNzParser = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 Parser Text
ipcharParser)

-- isegment-nz-nc = 1*( iunreserved / pct-encoded / sub-delims / "@" )
--                ; non-zero-length segment without any colon ":"
isegmentNzNcParser :: Parser Text
isegmentNzNcParser :: Parser Text
isegmentNzNcParser = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many1 Parser Text
_isegmentNzNcParser)
  where
    _isegmentNzNcParser :: Parser Text
_isegmentNzNcParser = Parser Text
iunreservedP Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
pctEncodedParser Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
subDelimsP Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
P.string Text
"@"

-- ipchar = iunreserved / pct-encoded / sub-delims / ":" / "@"
ipcharParser :: Parser Text
ipcharParser :: Parser Text
ipcharParser = Parser Text
iunreservedP Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
pctEncodedParser Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
subDelimsP Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
P.string Text
":" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
P.string Text
"@"

-- iquery = *( ipchar / iprivate / "/" / "?" )
iqueryParser :: Parser IRIQuery
iqueryParser :: Parser Text IRIQuery
iqueryParser = Text -> IRIQuery
IRIQuery (Text -> IRIQuery) -> Parser Text -> Parser Text IRIQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
iqueryParser'

iqueryParser' :: Parser Text
iqueryParser' :: Parser Text
iqueryParser' =
  Char -> Parser Char
P.char Char
'?' Parser Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Parser Text
ipcharParser Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
iprivateParser Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
P.string Text
"/" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
P.string Text
"?"))
    Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Query"

-- ifragment = *( ipchar / "/" / "?" )
ifragmentParser :: Parser Fragment
ifragmentParser :: Parser Text Fragment
ifragmentParser = Text -> Fragment
Fragment (Text -> Fragment) -> Parser Text -> Parser Text Fragment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
ifragmentParser'

ifragmentParser' :: Parser Text
ifragmentParser' :: Parser Text
ifragmentParser' =
  Char -> Parser Char
P.char Char
'#' Parser Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many' (Parser Text
ipcharParser Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
P.string Text
"/" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
P.string Text
"?"))
    Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Fragment"

-- iunreserved = ALPHA / DIGIT / "-" / "." / "_" / "~" / ucschar
iunreservedP :: Parser Text
iunreservedP :: Parser Text
iunreservedP = Char -> Text
T.singleton (Char -> Text) -> Parser Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Char
P.satisfy Char -> Bool
isIunreserved

isIunreserved :: Char -> Bool
isIunreserved :: Char -> Bool
isIunreserved Char
c = Char -> Bool
isUnreserved Char
c Bool -> Bool -> Bool
|| Char -> Bool
isUcsChar Char
c

-- ucschar = %xA0-D7FF / %xF900-FDCF / %xFDF0-FFEF
--         / %x10000-1FFFD / %x20000-2FFFD / %x30000-3FFFD
--         / %x40000-4FFFD / %x50000-5FFFD / %x60000-6FFFD
--         / %x70000-7FFFD / %x80000-8FFFD / %x90000-9FFFD
--         / %xA0000-AFFFD / %xB0000-BFFFD / %xC0000-CFFFD
--         / %xD0000-DFFFD / %xE1000-EFFFD
isUcsChar :: Char -> Bool
isUcsChar :: Char -> Bool
isUcsChar Char
c =
  (Char
'\x000A0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0D7FF')
    Bool -> Bool -> Bool
|| (Char
'\x0F900' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0FDCF')
    Bool -> Bool -> Bool
|| (Char
'\x0FDF0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0FFEF')
    Bool -> Bool -> Bool
|| (Char
'\x10000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1FFFD')
    Bool -> Bool -> Bool
|| (Char
'\x20000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2FFFD')
    Bool -> Bool -> Bool
|| (Char
'\x30000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3FFFD')
    Bool -> Bool -> Bool
|| (Char
'\x40000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x4FFFD')
    Bool -> Bool -> Bool
|| (Char
'\x50000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x5FFFD')
    Bool -> Bool -> Bool
|| (Char
'\x60000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x6FFFD')
    Bool -> Bool -> Bool
|| (Char
'\x70000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x7FFFD')
    Bool -> Bool -> Bool
|| (Char
'\x80000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x8FFFD')
    Bool -> Bool -> Bool
|| (Char
'\x90000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x9FFFD')
    Bool -> Bool -> Bool
|| (Char
'\xA0000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xAFFFD')
    Bool -> Bool -> Bool
|| (Char
'\xB0000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xBFFFD')
    Bool -> Bool -> Bool
|| (Char
'\xC0000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xCFFFD')
    Bool -> Bool -> Bool
|| (Char
'\xD0000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xDFFFD')
    Bool -> Bool -> Bool
|| (Char
'\xE1000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xEFFFD')

-- iprivate = %xE000-F8FF / %xF0000-FFFFD / %x100000-10FFFD
iprivateParser :: Parser Text
iprivateParser :: Parser Text
iprivateParser = Char -> Text
T.singleton (Char -> Text) -> Parser Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Char
P.satisfy Char -> Bool
isIPrivate

isIPrivate :: Char -> Bool
isIPrivate :: Char -> Bool
isIPrivate Char
c =
  (Char
'\x00E000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x00F8FF')
    Bool -> Bool -> Bool
|| (Char
'\x0F0000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0FFFFD')
    Bool -> Bool -> Bool
|| (Char
'\x100000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFD')

-- scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )
schemeParser :: Parser Scheme
schemeParser :: Parser Text Scheme
schemeParser =
  -- Force lower case (RFC page 25)
  Text -> Scheme
Scheme (Text -> Scheme) -> (Text -> Text) -> Text -> Scheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
toLower (Text -> Scheme) -> Parser Text -> Parser Text Scheme
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Text -> Text
T.cons (Char -> Text -> Text) -> Parser Char -> Parser Text (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
schemeHead Parser Text (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
schemeRest)
  where
    schemeHead :: Parser Char
schemeHead = (Char -> Bool) -> Parser Char
P.satisfy Char -> Bool
isAlpha Parser Char -> String -> Parser Char
forall i a. Parser i a -> String -> Parser i a
<?> String
"Scheme head"
    schemeRest :: Parser Text
schemeRest = (Char -> Bool) -> Parser Text
P.takeWhile Char -> Bool
isSchemeTailChar Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Scheme tail"
    isSchemeTailChar :: Char -> Bool
isSchemeTailChar Char
c =
      Char -> Bool
isAlphaNum Char
c
        Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'
        Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
        Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
        Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

-- port = *DIGIT
portParser :: Parser Port
portParser :: Parser Text Port
portParser = Int -> Port
Port (Int -> Port) -> Parser Text Int -> Parser Text Port
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Int
portParser'

portParser' :: Parser Int
portParser' :: Parser Text Int
portParser' = Parser Text Int
forall a. Integral a => Parser a
P.decimal Parser Text Int -> String -> Parser Text Int
forall i a. Parser i a -> String -> Parser i a
<?> String
"Port"

-- IP-literal = "[" ( IPv6address / IPvFuture  ) "]"
ipLiteralParser :: Parser Text
ipLiteralParser :: Parser Text
ipLiteralParser = Text -> Parser Text
P.string Text
"[" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text
ipV6AddressParser Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
ipFutureParser) Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text
P.string Text
"]"

-- IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" )
ipFutureParser :: Parser Text
ipFutureParser :: Parser Text
ipFutureParser =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text] -> Parser Text [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
      [ Text -> Parser Text
P.string Text
"v",
        (Char -> Bool) -> Parser Text
P.takeWhile1 Char -> Bool
isHexaDigit,
        Text -> Parser Text
P.string Text
".",
        (Char -> Bool) -> Parser Text
P.takeWhile1 Char -> Bool
isValidFinalChar
      ]
  where
    isValidFinalChar :: Char -> Bool
isValidFinalChar Char
c = Char -> Bool
isUnreserved Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSubDelims Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'

-- IPv6address =                            6( h16 ":" ) ls32
--             /                       "::" 5( h16 ":" ) ls32
--             / [               h16 ] "::" 4( h16 ":" ) ls32
--             / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32
--             / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32
--             / [ *3( h16 ":" ) h16 ] "::"    h16 ":"   ls32
--             / [ *4( h16 ":" ) h16 ] "::"              ls32
--             / [ *5( h16 ":" ) h16 ] "::"              h16
--             / [ *6( h16 ":" ) h16 ] "::"
ipV6AddressParser :: Parser Text
ipV6AddressParser :: Parser Text
ipV6AddressParser =
  do
    [Text]
l <- Parser Text [Text]
leadingP
    Text
t <- [Text] -> Parser Text
trailingP [Text]
l
    [Text] -> Text -> Parser Text
forall (f :: * -> *). Applicative f => [Text] -> Text -> f Text
joinParts [Text]
l Text
t
    Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"IPV6"
  where
    leadingP :: Parser Text [Text]
leadingP = Parser Text
h16 Parser Text -> Parser Text -> Parser Text [Text]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`P.sepBy` Parser Text
":"
    trailingP :: [Text] -> Parser Text
trailingP = ([Text] -> [Text]
forall a. a -> a
id ([Text] -> [Text]) -> ([Text] -> Int) -> [Text] -> ([Text], Int)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([Text] -> ([Text], Int))
-> (([Text], Int) -> Parser Text) -> [Text] -> Parser Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \([Text], Int)
l -> ([Text], Int) -> Parser Text
forall a. (Eq a, Num a) => ([Text], a) -> Parser Text
ipNotElided ([Text], Int)
l Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Text], Int) -> Parser Text
forall a. (a, Int) -> Parser Text
ipElided ([Text], Int)
l
    joinParts :: [Text] -> Text -> f Text
joinParts [Text]
leading Text
trailing = Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> f Text) -> Text -> f Text
forall a b. (a -> b) -> a -> b
$ (Text -> [Text] -> Text
T.intercalate Text
":" [Text]
leading) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
trailing
    h16 :: Parser Text
h16 = Int -> Int -> Parser Text -> Parser Text
parseBetween Int
1 Int
4 ((Char -> Bool) -> Parser Text
P.takeWhile Char -> Bool
isHexaDigit)
    ipNotElided :: ([Text], a) -> Parser Text
ipNotElided ([Text]
leading, a
lengthL) =
      Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
lengthL a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
7 Bool -> Bool -> Bool
&& Text -> Bool
isDecOctet ([Text] -> Text
forall a. [a] -> a
last [Text]
leading)) Parser Text () -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
partialIpV4
        Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
lengthL a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
8) Parser Text () -> Text -> Parser Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
forall a. Monoid a => a
mempty)
    ipElided :: (a, Int) -> Parser Text
ipElided (a
_, Int
lengthL) = do
      Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser Text ()) -> Bool -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Int
lengthL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8
      Text
elision <- Text -> Parser Text
P.string Text
"::"
      [Text]
trailing <- Parser Text
h16 Parser Text -> Parser Text -> Parser Text [Text]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`P.sepBy` Parser Text
":"
      let lengthT :: Int
lengthT = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
trailing
      let lengthTotal :: Int
lengthTotal = Int
lengthL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lengthT
      Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser Text ()) -> Bool -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Int
lengthT Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8
      Text
embeddedIpV4 <-
        Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
lengthT Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
lengthTotal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7 Bool -> Bool -> Bool
&& Text -> Bool
isDecOctet ([Text] -> Text
forall a. [a] -> a
last [Text]
trailing)) Parser Text () -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
partialIpV4
          Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
forall a. Monoid a => a
mempty
      Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
elision, (Text -> [Text] -> Text
T.intercalate Text
":" [Text]
trailing), Text
embeddedIpV4]
    partialIpV4 :: Parser Text
partialIpV4 = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text] -> Parser Text [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Parser Text
dotP, Parser Text
decOctetP, Parser Text
dotP, Parser Text
decOctetP, Parser Text
dotP, Parser Text
decOctetP]

-- h16 = 1*4HEXDIG
-- [TODO]

-- ls32 = ( h16 ":" h16 ) / IPv4address
-- [TODO]

-- IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet
ipV4AddressParser :: Parser Text
ipV4AddressParser :: Parser Text
ipV4AddressParser = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text] -> Parser Text [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Parser Text
decOctetP, Parser Text
dotP, Parser Text
decOctetP, Parser Text
dotP, Parser Text
decOctetP, Parser Text
dotP, Parser Text
decOctetP]

-- dec-octet = DIGIT                 ; 0-9
--           / %x31-39 DIGIT         ; 10-99
--           / "1" 2DIGIT            ; 100-199
--           / "2" %x30-34 DIGIT     ; 200-249
--           / "25" %x30-35          ; 250-255
decOctetP :: Parser Text
decOctetP :: Parser Text
decOctetP = do
  -- [TODO] 1-liner ?
  Text
s <- (Char -> Bool) -> Parser Text
P.takeWhile1 Char -> Bool
isDigit
  Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Bool
isDecOctet Text
s)
  Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s

isDecOctet :: Text -> Bool
isDecOctet :: Text -> Bool
isDecOctet Text
s = Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
s Bool -> Bool -> Bool
&& (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 Bool -> Bool -> Bool
|| (Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 Bool -> Bool -> Bool
&& Text
s Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
<= Text
"255"))
  where
    len :: Int
len = Text -> Int
T.length Text
s

-- pct-encoded = "%" HEXDIG HEXDIG
pctEncodedParser :: Parser Text
pctEncodedParser :: Parser Text
pctEncodedParser =
  Char -> Text -> Text
T.cons (Char -> Text -> Text) -> Parser Char -> Parser Text (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser Char
P.char Char
'%'
    Parser Text (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text
T.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
P.count Int
2 ((Char -> Bool) -> Parser Char
P.satisfy Char -> Bool
isHexaDigit)))
    Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Percent encoding"

-- unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"
isUnreserved :: Char -> Bool
isUnreserved :: Char -> Bool
isUnreserved Char
c =
  Char -> Bool
isAlphaNum Char
c
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~'

-- reserved = gen-delims / sub-delims
-- [TODO]

-- gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@"

-- sub-delims     = "!" / "$" / "&" / "'" / "(" / ")"
--                / "*" / "+" / "," / ";" / "="
subDelimsP :: Parser Text
subDelimsP :: Parser Text
subDelimsP = Char -> Text
T.singleton (Char -> Text) -> Parser Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Char
P.satisfy Char -> Bool
isSubDelims

isSubDelims :: Char -> Bool
isSubDelims :: Char -> Bool
isSubDelims Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"!$&'()*+,;=" :: String)

-- "//" iauthority ipath-abempty
iauthWithPathParser :: Parser (Maybe Authority, Path)
iauthWithPathParser :: Parser (Maybe Authority, Path)
iauthWithPathParser = do
  Parser Text -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Parser Text
P.string Text
"//")
  ((Authority, Path) -> (Maybe Authority, Path))
-> Authority -> Path -> (Maybe Authority, Path)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry ((Authority -> Maybe Authority)
-> (Authority, Path) -> (Maybe Authority, Path)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Authority -> Maybe Authority
forall a. a -> Maybe a
Just) (Authority -> Path -> (Maybe Authority, Path))
-> Parser Authority
-> Parser Text (Path -> (Maybe Authority, Path))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Authority
iauthorityParser Parser Text (Path -> (Maybe Authority, Path))
-> Parser Path -> Parser (Maybe Authority, Path)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Path
ipathAbEmptyParser

isHexaDigit :: Char -> Bool
isHexaDigit :: Char -> Bool
isHexaDigit Char
c =
  (Char -> Bool
isDigit Char
c)
    Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f')
    Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F')

dotP :: Parser Text
dotP :: Parser Text
dotP = Text -> Parser Text
P.string Text
"."

parseBetween :: Int -> Int -> Parser Text -> Parser Text
parseBetween :: Int -> Int -> Parser Text -> Parser Text
parseBetween Int
i Int
j Parser Text
p = do
  Text
s <- Parser Text
p
  let len :: Int
len = Text -> Int
T.length Text
s
  Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser Text ()) -> Bool -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
j
  Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s