{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  ./Common/IRI.hs
Copyright   :  (c) DFKI GmbH 2012
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Eugen Kuksa <eugenk@informatik.uni-bremen.de>
Stability   :  provisional
Portability :  portable

This module defines functions for handling IRIs.  It was adopted
from the Network.URI module by Graham Klyne, but is extended to IRI
support [2] and CURIE [3].

Four methods are provided for parsing different
kinds of IRI string (as noted in [1], [2]):
'parseIRI'
'parseIRIReference'


An additional method is provided for parsing an abbreviated IRI according to
[3]: 'parseIRICurie'

Additionally, classification of full, abbreviated and simple IRI is provided.

The abbreviated syntaxes [3] provide three different kinds of IRI.

References

(1) <http://www.ietf.org/rfc/rfc3986.txt>

(2) <http://www.ietf.org/rfc/rfc3987.txt>

(3) <http://www.w3.org/TR/rdfa-core/#s_curies>

-}

module Common.IRI
    ( IRI (..)
    , IRIAuth (IRIAuth)
    , nullIRI
    , iriToStringUnsecure
    , iriToStringShortUnsecure
    , hasFullIRI
    , isSimple
    , isURN
    , addSuffixToIRI
    , showTrace
    -- * Parsing
    , iriParser
    , angles
    , iriCurie
    , urnParser
    , compoundIriCurie  
    , parseCurie
    , parseIRICurie
    , parseIRIReference
    , parseIRICompoundCurie
    , parseIRI
    , ncname

    , mergeCurie
    , expandCurie
    , expandIRI
    , expandIRI'
    , relativeTo
    , relativeFrom

    -- * Conversion
    , simpleIdToIRI
    , deleteQuery
    , setAngles
   
    -- * methods from OWL2.AS
    , isNullIRI
    , iRIRange
    , showIRI
    , showIRICompact
    , showIRIFull
    , showURN
    , dummyIRI
    , mkIRI
    , mkAbbrevIRI
    , idToIRI  
    , setPrefix
    , uriToCaslId
    ) where

import Text.ParserCombinators.Parsec

import Data.Char
import Data.Data
import Data.Ord (comparing)
import Data.Map as Map (Map, lookup)
import Data.Maybe
import Data.List

-- import Control.Monad (when)

import Common.Id as Id
import Common.Lexer
import Common.Parsec
import Common.Percent
import Common.Token (comps)
import qualified Control.Monad.Fail as Fail

-- * The IRI datatype

{- | Represents a general universal resource identifier using
its component parts.

For example, for the (full) IRI

>   foo://anonymous@www.haskell.org:42/ghc?query#frag

or the abbreviated IRI

>   prefix:iFragement

or the simple IRI

>  iFragement

The @isAbbrev@ flag is set, if an iri @i@ is abbreviated. With a prefix map @pm@
  or @pm'@ it can be expanded using @expandIRI pm i@, @expandIRI' pm' i@,
  @expandCurie pm i@, and @expandCurie' pm ' i@ yielding a new IRI which stores
  both, the abbreviated and absolute IRI.
-}



data IRI = IRI
    { IRI -> Range
iriPos :: Range             -- ^ position

    -- fields used for storing an absolute IRI
    , IRI -> String
iriScheme :: String         -- ^ @foo:@
    , IRI -> Maybe IRIAuth
iriAuthority :: Maybe IRIAuth -- ^ @\/\/anonymous\@www.haskell.org:42@
    , IRI -> Id
iriPath :: Id               -- ^ local part @\/ghc@
    , IRI -> String
iriQuery :: String          -- ^ @?query@
    , IRI -> String
iriFragment :: String       -- ^ @#frag@

    -- fields used for storing a CURIE
    , IRI -> String
prefixName :: String        -- ^ Prefix name of the CURIE (@prefix@)
    , IRI -> String
iFragment :: String         -- ^ Fragment of the CURIE (@iFragment@)

    -- flags
    , IRI -> Bool
isAbbrev :: Bool            -- ^ is the IRI a CURIE or not?
    , IRI -> Bool
isBlankNode :: Bool         -- ^ is the IRI a blank node?                   
    , IRI -> Bool
hasAngles :: Bool           -- ^ IRI in angle brackets
    } deriving (Typeable, Typeable IRI
Constr
DataType
Typeable IRI =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IRI -> c IRI)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IRI)
-> (IRI -> Constr)
-> (IRI -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IRI))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IRI))
-> ((forall b. Data b => b -> b) -> IRI -> IRI)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IRI -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IRI -> r)
-> (forall u. (forall d. Data d => d -> u) -> IRI -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> IRI -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IRI -> m IRI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IRI -> m IRI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IRI -> m IRI)
-> Data IRI
IRI -> Constr
IRI -> DataType
(forall b. Data b => b -> b) -> IRI -> IRI
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IRI -> c IRI
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IRI
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IRI -> u
forall u. (forall d. Data d => d -> u) -> IRI -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IRI -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IRI -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IRI -> m IRI
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IRI -> m IRI
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IRI
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IRI -> c IRI
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IRI)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IRI)
$cIRI :: Constr
$tIRI :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> IRI -> m IRI
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IRI -> m IRI
gmapMp :: (forall d. Data d => d -> m d) -> IRI -> m IRI
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IRI -> m IRI
gmapM :: (forall d. Data d => d -> m d) -> IRI -> m IRI
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IRI -> m IRI
gmapQi :: Int -> (forall d. Data d => d -> u) -> IRI -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IRI -> u
gmapQ :: (forall d. Data d => d -> u) -> IRI -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IRI -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IRI -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IRI -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IRI -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IRI -> r
gmapT :: (forall b. Data b => b -> b) -> IRI -> IRI
$cgmapT :: (forall b. Data b => b -> b) -> IRI -> IRI
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IRI)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IRI)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c IRI)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IRI)
dataTypeOf :: IRI -> DataType
$cdataTypeOf :: IRI -> DataType
toConstr :: IRI -> Constr
$ctoConstr :: IRI -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IRI
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IRI
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IRI -> c IRI
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IRI -> c IRI
$cp1Data :: Typeable IRI
Data)

-- | Type for authority value within a IRI
data IRIAuth = IRIAuth
    { IRIAuth -> String
iriUserInfo :: String       -- ^ @anonymous\@@
    , IRIAuth -> String
iriRegName :: String        -- ^ @www.haskell.org@
    , IRIAuth -> String
iriPort :: String           -- ^ @:42@
    } deriving (IRIAuth -> IRIAuth -> Bool
(IRIAuth -> IRIAuth -> Bool)
-> (IRIAuth -> IRIAuth -> Bool) -> Eq IRIAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IRIAuth -> IRIAuth -> Bool
$c/= :: IRIAuth -> IRIAuth -> Bool
== :: IRIAuth -> IRIAuth -> Bool
$c== :: IRIAuth -> IRIAuth -> Bool
Eq, Eq IRIAuth
Eq IRIAuth =>
(IRIAuth -> IRIAuth -> Ordering)
-> (IRIAuth -> IRIAuth -> Bool)
-> (IRIAuth -> IRIAuth -> Bool)
-> (IRIAuth -> IRIAuth -> Bool)
-> (IRIAuth -> IRIAuth -> Bool)
-> (IRIAuth -> IRIAuth -> IRIAuth)
-> (IRIAuth -> IRIAuth -> IRIAuth)
-> Ord IRIAuth
IRIAuth -> IRIAuth -> Bool
IRIAuth -> IRIAuth -> Ordering
IRIAuth -> IRIAuth -> IRIAuth
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 :: IRIAuth -> IRIAuth -> IRIAuth
$cmin :: IRIAuth -> IRIAuth -> IRIAuth
max :: IRIAuth -> IRIAuth -> IRIAuth
$cmax :: IRIAuth -> IRIAuth -> IRIAuth
>= :: IRIAuth -> IRIAuth -> Bool
$c>= :: IRIAuth -> IRIAuth -> Bool
> :: IRIAuth -> IRIAuth -> Bool
$c> :: IRIAuth -> IRIAuth -> Bool
<= :: IRIAuth -> IRIAuth -> Bool
$c<= :: IRIAuth -> IRIAuth -> Bool
< :: IRIAuth -> IRIAuth -> Bool
$c< :: IRIAuth -> IRIAuth -> Bool
compare :: IRIAuth -> IRIAuth -> Ordering
$ccompare :: IRIAuth -> IRIAuth -> Ordering
$cp1Ord :: Eq IRIAuth
Ord, Int -> IRIAuth -> ShowS
[IRIAuth] -> ShowS
IRIAuth -> String
(Int -> IRIAuth -> ShowS)
-> (IRIAuth -> String) -> ([IRIAuth] -> ShowS) -> Show IRIAuth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IRIAuth] -> ShowS
$cshowList :: [IRIAuth] -> ShowS
show :: IRIAuth -> String
$cshow :: IRIAuth -> String
showsPrec :: Int -> IRIAuth -> ShowS
$cshowsPrec :: Int -> IRIAuth -> ShowS
Show, Typeable, Typeable IRIAuth
Constr
DataType
Typeable IRIAuth =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IRIAuth -> c IRIAuth)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IRIAuth)
-> (IRIAuth -> Constr)
-> (IRIAuth -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IRIAuth))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IRIAuth))
-> ((forall b. Data b => b -> b) -> IRIAuth -> IRIAuth)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IRIAuth -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IRIAuth -> r)
-> (forall u. (forall d. Data d => d -> u) -> IRIAuth -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> IRIAuth -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IRIAuth -> m IRIAuth)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IRIAuth -> m IRIAuth)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IRIAuth -> m IRIAuth)
-> Data IRIAuth
IRIAuth -> Constr
IRIAuth -> DataType
(forall b. Data b => b -> b) -> IRIAuth -> IRIAuth
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IRIAuth -> c IRIAuth
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IRIAuth
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IRIAuth -> u
forall u. (forall d. Data d => d -> u) -> IRIAuth -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IRIAuth -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IRIAuth -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IRIAuth -> m IRIAuth
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IRIAuth -> m IRIAuth
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IRIAuth
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IRIAuth -> c IRIAuth
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IRIAuth)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IRIAuth)
$cIRIAuth :: Constr
$tIRIAuth :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> IRIAuth -> m IRIAuth
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IRIAuth -> m IRIAuth
gmapMp :: (forall d. Data d => d -> m d) -> IRIAuth -> m IRIAuth
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IRIAuth -> m IRIAuth
gmapM :: (forall d. Data d => d -> m d) -> IRIAuth -> m IRIAuth
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IRIAuth -> m IRIAuth
gmapQi :: Int -> (forall d. Data d => d -> u) -> IRIAuth -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IRIAuth -> u
gmapQ :: (forall d. Data d => d -> u) -> IRIAuth -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IRIAuth -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IRIAuth -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IRIAuth -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IRIAuth -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IRIAuth -> r
gmapT :: (forall b. Data b => b -> b) -> IRIAuth -> IRIAuth
$cgmapT :: (forall b. Data b => b -> b) -> IRIAuth -> IRIAuth
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IRIAuth)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IRIAuth)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c IRIAuth)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IRIAuth)
dataTypeOf :: IRIAuth -> DataType
$cdataTypeOf :: IRIAuth -> DataType
toConstr :: IRIAuth -> Constr
$ctoConstr :: IRIAuth -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IRIAuth
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IRIAuth
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IRIAuth -> c IRIAuth
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IRIAuth -> c IRIAuth
$cp1Data :: Typeable IRIAuth
Data)

-- | Blank IRI
nullIRI :: IRI
nullIRI :: IRI
nullIRI = IRI :: Range
-> String
-> Maybe IRIAuth
-> Id
-> String
-> String
-> String
-> String
-> Bool
-> Bool
-> Bool
-> IRI
IRI
    { iriScheme :: String
iriScheme = ""
    , iriAuthority :: Maybe IRIAuth
iriAuthority = Maybe IRIAuth
forall a. Maybe a
Nothing
    , iriPath :: Id
iriPath = [Token] -> Id
mkId []
    , iriQuery :: String
iriQuery = ""
    , iriFragment :: String
iriFragment = ""
    , prefixName :: String
prefixName = ""
    , isAbbrev :: Bool
isAbbrev = Bool
False
    , isBlankNode :: Bool
isBlankNode = Bool
False
    , hasAngles :: Bool
hasAngles = Bool
False
    , iriPos :: Range
iriPos = Range
nullRange
    , iFragment :: String
iFragment = ""
    }

-- | check that we have a full (possibly expanded) IRI (i.e. for comparisons)
hasFullIRI :: IRI -> Bool
hasFullIRI :: IRI -> Bool
hasFullIRI i :: IRI
i = (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ IRI -> String
iriScheme IRI
i) Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> (Id -> Bool) -> Id -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Bool
isNullId (Id -> Bool) -> Id -> Bool
forall a b. (a -> b) -> a -> b
$ IRI -> Id
iriPath IRI
i)

-- | check whether the IRI is a URN (uniform resource name)
isURN :: IRI -> Bool
isURN :: IRI -> Bool
isURN i :: IRI
i = IRI -> String
iriScheme IRI
i String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "urn"

-- | gets the nid part of an urn
urnNID :: IRI -> String
urnNID :: IRI -> String
urnNID = IRIAuth -> String
iriRegName (IRIAuth -> String) -> (IRI -> IRIAuth) -> IRI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe IRIAuth -> IRIAuth
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe IRIAuth -> IRIAuth)
-> (IRI -> Maybe IRIAuth) -> IRI -> IRIAuth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> Maybe IRIAuth
iriAuthority

-- | get the nss part of an urn
urnNSS :: IRI -> String
urnNSS :: IRI -> String
urnNSS = Id -> String
forall a. Show a => a -> String
show (Id -> String) -> (IRI -> Id) -> IRI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> Id
iriPath



{- | check that we have a simple IRI that is a (possibly expanded) abbreviated IRI
without prefix -}
isSimple :: IRI -> Bool
isSimple :: IRI -> Bool
isSimple i :: IRI
i = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (IRI -> String
prefixName IRI
i) Bool -> Bool -> Bool
&& IRI -> Bool
isAbbrev IRI
i

showTrace :: IRI -> String
showTrace :: IRI -> String
showTrace i :: IRI
i = 
 "scheme:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> String
iriScheme IRI
i String -> ShowS
forall a. [a] -> [a] -> [a]
++
 (case IRI -> Maybe IRIAuth
iriAuthority IRI
i of
   Just x :: IRIAuth
x -> "\nauthority:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRIAuth -> String
forall a. Show a => a -> String
show IRIAuth
x
   _ -> "\nno authority") String -> ShowS
forall a. [a] -> [a] -> [a]
++
 "\npath:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show (IRI -> Id
iriPath IRI
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++
 "\nquery:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> String
iriQuery IRI
i String -> ShowS
forall a. [a] -> [a] -> [a]
++
 "\nfragment:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> String
iriFragment IRI
i String -> ShowS
forall a. [a] -> [a] -> [a]
++
 "\nprefix:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> String
prefixName IRI
i String -> ShowS
forall a. [a] -> [a] -> [a]
++
 "\niFragment:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> String
iFragment IRI
i String -> ShowS
forall a. [a] -> [a] -> [a]
++
 "\nisAbbrev:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show (IRI -> Bool
isAbbrev IRI
i)

{- IRI as instance of Show.  Note that for security reasons, the default
behaviour should suppress any iuserinfo field (see RFC3986, section 7.5).
But we don't do this since we use iriToStringUnsecure all over the place
anyway. -}
instance Show IRI where
    showsPrec :: Int -> IRI -> ShowS
showsPrec _ = ShowS -> IRI -> ShowS
iriToString ShowS
forall a. a -> a
id

-- equal iff expansion is equal or abbreviation is equal
instance Eq IRI where
  == :: IRI -> IRI -> Bool
(==) i :: IRI
i j :: IRI
j = IRI -> IRI -> Ordering
forall a. Ord a => a -> a -> Ordering
compare IRI
i IRI
j Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

{- | compares two IRIs

If both IRIs are absolute or are expanded, only the absolute IRIs are compared.
If both IRIs abbreviated *and* not expanded their abbreviated forms are compared.

Comparision is done componentwise for all components in any other case:
  If both IRIs, @i@ and @j@, abbreviated forms are equal but only one IRI @i@ is
  expanded they don't have to be equal and cannot be compared based on their
  abbreviated forms as the prefix of @j@ might not point to the same as the
  prefix of @i@. This cannot be resolved at the time of comparison.
-}

instance Ord IRI where
  compare :: IRI -> IRI -> Ordering
compare i :: IRI
i k :: IRI
k = case (IRI -> Bool
hasFullIRI IRI
i, IRI -> Bool
hasFullIRI IRI
k) of
    (True, True) -> (IRI -> (String, Maybe IRIAuth, Id, String, String))
-> IRI -> IRI -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\ j :: IRI
j -> 
      ( IRI -> String
iriScheme IRI
j
      , IRI -> Maybe IRIAuth
iriAuthority IRI
j
      , IRI -> Id
iriPath IRI
j
      , IRI -> String
iriQuery IRI
j
      , IRI -> String
iriFragment IRI
j)) IRI
i IRI
k
    (False, False) -> (IRI -> (String, String)) -> IRI -> IRI -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\j :: IRI
j -> (IRI -> String
prefixName IRI
j, IRI -> String
iFragment IRI
j)) IRI
i IRI
k
    _ -> (IRI
 -> (String, String, Maybe IRIAuth, Id, String, String, String))
-> IRI -> IRI -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\ j :: IRI
j ->
      (IRI -> String
prefixName IRI
j, IRI -> String
iriScheme IRI
j, IRI -> Maybe IRIAuth
iriAuthority IRI
j, IRI -> Id
iriPath IRI
j,
       IRI -> String
iriQuery IRI
j, IRI -> String
iriFragment IRI
j, IRI -> String
iFragment IRI
j)) IRI
i IRI
k

-- |converts IRI to String of expanded form. if available. Also showing Auth
iriToStringUnsecure :: IRI -> String
iriToStringUnsecure :: IRI -> String
iriToStringUnsecure i :: IRI
i = ShowS -> IRI -> ShowS
iriToString ShowS
forall a. a -> a
id IRI
i ""

{- |converts IRI to String of abbreviated form. if available.
Also showing Auth info. -}
iriToStringShortUnsecure :: IRI -> String
iriToStringShortUnsecure :: IRI -> String
iriToStringShortUnsecure i :: IRI
i = ShowS -> IRI -> ShowS
iriToStringShort ShowS
forall a. a -> a
id IRI
i ""

instance GetRange IRI where
    getRange :: IRI -> Range
getRange = IRI -> Range
iriPos

-- | Converts a Simple_ID to an IRI
simpleIdToIRI :: SIMPLE_ID -> IRI
simpleIdToIRI :: Token -> IRI
simpleIdToIRI sid :: Token
sid = IRI
nullIRI { iFragment :: String
iFragment = Id -> String
forall a. Show a => a -> String
show (Id -> String) -> Id -> String
forall a b. (a -> b) -> a -> b
$ Token -> Id
simpleIdToId Token
sid
                            , iriPos :: Range
iriPos = Token -> Range
tokPos Token
sid
                            , isAbbrev :: Bool
isAbbrev = Bool
True
                            }

-- * new functions for OWL.AS
-- | check that we have a nullIRI
isNullIRI :: IRI -> Bool
isNullIRI :: IRI -> Bool
isNullIRI i :: IRI
i = IRI
i IRI -> IRI -> Bool
forall a. Eq a => a -> a -> Bool
== IRI
nullIRI

-- | set the Range attribute of IRIs
-- setIRIRange :: Range -> IRI -> IRI
-- setIRIRange r i = i { iriPos = r }

-- | checks if a string (bound to be localPart of an IRI) contains \":\/\/\"
-- cssIRI :: String -> String
-- cssIRI i
--   | isInfixOf "://" i = "Full"
--   | otherwise = "Abbreviated"

iRIRange :: IRI -> [Pos]
iRIRange :: IRI -> [Pos]
iRIRange i :: IRI
i = let Range rs :: [Pos]
rs = IRI -> Range
iriPos IRI
i in case [Pos]
rs of
  [p :: Pos
p] -> let
    p0 :: Pos
p0 = if IRI -> Bool
hasFullIRI IRI
i then Pos -> Int -> Pos
Id.incSourceColumn Pos
p (-1) else Pos
p
    in Token -> [Pos]
tokenRange (Token -> [Pos]) -> Token -> [Pos]
forall a b. (a -> b) -> a -> b
$ String -> Range -> Token
Token (IRI -> String
showIRI IRI
i) (Range -> Token) -> Range -> Token
forall a b. (a -> b) -> a -> b
$ [Pos] -> Range
Range [Pos
p0]
  _ -> [Pos]
rs

showIRI :: IRI -> String
showIRI :: IRI -> String
showIRI i :: IRI
i 
  | IRI -> Bool
isURN IRI
i = IRI -> String
showURN IRI
i
  | IRI -> Bool
hasFullIRI IRI
i Bool -> Bool -> Bool
&& Bool -> Bool
not (IRI -> Bool
isAbbrev IRI
i)  = IRI -> String
showIRIFull IRI
i
  | Bool
otherwise = IRI -> String
showIRICompact IRI
i


showURN :: IRI -> String
showURN :: IRI -> String
showURN i :: IRI
i = IRI -> ShowS
urnToString IRI
i ""

-- | show IRI as abbreviated, when possible
showIRICompact :: IRI -> String
showIRICompact :: IRI -> String
showIRICompact i :: IRI
i
  | IRI -> Bool
hasFullIRI IRI
i Bool -> Bool -> Bool
&& Bool -> Bool
not (IRI -> Bool
isAbbrev IRI
i) = IRI -> String
showIRIFull IRI
i
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ IRI -> String
iriQuery IRI
i = ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ IRI -> String
iriQuery IRI
i
  | Bool
otherwise = IRI -> String
showIRIAbbrev IRI
i

-- | shows IRI as abbreviated
showIRIAbbrev :: IRI -> String
showIRIAbbrev :: IRI -> String
showIRIAbbrev i :: IRI
i = IRI -> ShowS
iriToStringAbbrev IRI
i ""
 -- don't duplicate code

-- | show IRI in angle brackets as full IRI
showIRIFull :: IRI -> String
showIRIFull :: IRI -> String
showIRIFull i :: IRI
i = ShowS -> IRI -> ShowS
iriToStringFull ShowS
forall a. a -> a
id IRI
i ""
  -- this should behave like show, and there we use id


-- | a default ontology name  
dummyIRI :: IRI
dummyIRI :: IRI
dummyIRI = IRI
nullIRI { 
       iriScheme :: String
iriScheme = "http:"
     , iriAuthority :: Maybe IRIAuth
iriAuthority = IRIAuth -> Maybe IRIAuth
forall a. a -> Maybe a
Just IRIAuth :: String -> String -> String -> IRIAuth
IRIAuth
                       { iriUserInfo :: String
iriUserInfo = ""
                       , iriRegName :: String
iriRegName = "hets.eu"
                       , iriPort :: String
iriPort = "" }
     , iriPath :: Id
iriPath = String -> Id
stringToId "/ontology/unamed"
    }

mkIRI :: String -> IRI
mkIRI :: String -> IRI
mkIRI s :: String
s= IRI
nullIRI {  iFragment :: String
iFragment = String
s
                  , isAbbrev :: Bool
isAbbrev = Bool
True
                 }

mkAbbrevIRI :: String -> String -> IRI
mkAbbrevIRI :: String -> String -> IRI
mkAbbrevIRI pref :: String
pref frag :: String
frag = IRI
nullIRI {prefixName :: String
prefixName= String
pref, iFragment :: String
iFragment = String
frag, isAbbrev :: Bool
isAbbrev = Bool
True}


idToIRI :: Id -> IRI
idToIRI :: Id -> IRI
idToIRI i :: Id
i =  IRI
nullIRI { iFragment :: String
iFragment = Id -> String
forall a. Show a => a -> String
show Id
i
                     , isAbbrev :: Bool
isAbbrev = Bool
True
                     }

setPrefix :: String -> IRI -> IRI
setPrefix :: String -> IRI -> IRI
setPrefix s :: String
s i :: IRI
i = IRI
i{prefixName :: String
prefixName = String
s}

-- * Parse an IRI

{- | Turn a string containing an RFC3987 IRI into an 'IRI'.
Returns 'Nothing' if the string is not a valid IRI;
(an absolute IRI with optional fragment identifier). -}
parseIRI :: String -> Maybe IRI
parseIRI :: String -> Maybe IRI
parseIRI = IRIParser () IRI -> String -> Maybe IRI
parseIRIAny IRIParser () IRI
forall st. IRIParser st IRI
iriParser

{- | Parse a IRI reference to an 'IRI' value.
Returns 'Nothing' if the string is not a valid IRI reference.
(an absolute or relative IRI with optional fragment identifier). -}
parseIRIReference :: String -> Maybe IRI
parseIRIReference :: String -> Maybe IRI
parseIRIReference = IRIParser () IRI -> String -> Maybe IRI
parseIRIAny IRIParser () IRI
forall st. IRIParser st IRI
iriReference

-- | Turn a string containing a CURIE into an 'IRI'
parseCurie :: String -> Maybe IRI
parseCurie :: String -> Maybe IRI
parseCurie = IRIParser () IRI -> String -> Maybe IRI
parseIRIAny IRIParser () IRI
forall st. IRIParser st IRI
curie

{- | Turn a string containing an IRI or a CURIE into an 'IRI'.
Returns 'Nothing' if the string is not a valid IRI;
(an absolute IRI enclosed in '<' and '>' with optional fragment identifier
or a CURIE). -}
parseIRICurie :: String -> Maybe IRI
parseIRICurie :: String -> Maybe IRI
parseIRICurie = IRIParser () IRI -> String -> Maybe IRI
parseIRIAny IRIParser () IRI
forall st. IRIParser st IRI
iriCurie

parseIRICompoundCurie :: String -> Maybe IRI
parseIRICompoundCurie :: String -> Maybe IRI
parseIRICompoundCurie = IRIParser () IRI -> String -> Maybe IRI
parseIRIAny IRIParser () IRI
forall st. IRIParser st IRI
compoundIriCurie

-- Helper function for turning a string into a IRI
parseIRIAny :: IRIParser () IRI -> String -> Maybe IRI
parseIRIAny :: IRIParser () IRI -> String -> Maybe IRI
parseIRIAny parser :: IRIParser () IRI
parser iristr :: String
iristr = case IRIParser () IRI -> String -> String -> Either ParseError IRI
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (IRIParser () IRI
parser IRIParser () IRI
-> ParsecT String () Identity () -> IRIParser () IRI
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) "" String
iristr of
        Left _ -> Maybe IRI
forall a. Maybe a
Nothing
        Right u :: IRI
u -> IRI -> Maybe IRI
forall a. a -> Maybe a
Just IRI
u { iriPos :: Range
iriPos = Range
nullRange }

-- * IRI parser body based on Parsec elements and combinators

-- Parser parser type. Currently:
type IRIParser st a = GenParser Char st a

-- RFC3986, section 2.1

-- | Parse and return a 'pct-encoded' sequence
escaped :: IRIParser st String
escaped :: IRIParser st String
escaped = Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '%' ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity Char -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a]
single ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit

-- RFC3986, section 2.2

subDelims :: IRIParser st String
subDelims :: IRIParser st String
subDelims = ParsecT String st Identity Char -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a]
single (ParsecT String st Identity Char -> IRIParser st String)
-> ParsecT String st Identity Char -> IRIParser st String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
subDelim

-- RFC3986, section 2.3

{- |Returns 'True' if the character is an \"unreserved\" character in
a IRI.  These characters do not need to be escaped in a IRI.  The
only characters allowed in a IRI are either \"reserved\",
\"unreserved\", or an escape sequence (@%@ followed by two hex digits). -}
isIUnreserved :: Char -> Bool
isIUnreserved :: Char -> Bool
isIUnreserved c :: Char
c = Char -> Bool
isUnreserved Char
c Bool -> Bool -> Bool
|| Char -> Bool
isUcsChar Char
c

iunreservedChar :: IRIParser st String
iunreservedChar :: IRIParser st String
iunreservedChar = ParsecT String st Identity Char -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a]
single (ParsecT String st Identity Char -> IRIParser st String)
-> ParsecT String st Identity Char -> IRIParser st String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIUnreserved

iriWithPos :: IRIParser st IRI -> IRIParser st IRI
iriWithPos :: IRIParser st IRI -> IRIParser st IRI
iriWithPos parser :: IRIParser st IRI
parser = do
  Pos
p <- GenParser Char st Pos
forall tok st. GenParser tok st Pos
getPos
  IRI
i <- IRIParser st IRI
parser
  Pos
q <- GenParser Char st Pos
forall tok st. GenParser tok st Pos
getPos
  IRI -> IRIParser st IRI
forall (m :: * -> *) a. Monad m => a -> m a
return (IRI -> IRIParser st IRI) -> IRI -> IRIParser st IRI
forall a b. (a -> b) -> a -> b
$ IRI
i {iriPos :: Range
iriPos = Range -> Range -> Range
appRange ([Pos] -> Range
Range [Pos
p, Pos
q]) (Range -> Range) -> Range -> Range
forall a b. (a -> b) -> a -> b
$ IRI -> Range
iriPos IRI
i}


-- BEGIN CURIE

-- | Parses an IRI reference enclosed in '<', '>' or a CURIE
iriCurie :: IRIParser st IRI
iriCurie :: IRIParser st IRI
iriCurie = IRIParser st IRI -> IRIParser st IRI
forall st. IRIParser st IRI -> IRIParser st IRI
angles IRIParser st IRI
forall st. IRIParser st IRI
iriParser IRIParser st IRI -> IRIParser st IRI -> IRIParser st IRI
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st IRI
forall st. IRIParser st IRI
curie 

compoundIriCurie :: IRIParser st IRI
compoundIriCurie :: IRIParser st IRI
compoundIriCurie = IRIParser st IRI -> IRIParser st IRI
forall st. IRIParser st IRI -> IRIParser st IRI
angles IRIParser st IRI
forall st. IRIParser st IRI
iriParser IRIParser st IRI -> IRIParser st IRI -> IRIParser st IRI
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st IRI
forall st. IRIParser st IRI
compoundCurie

angles :: IRIParser st IRI -> IRIParser st IRI
angles :: IRIParser st IRI -> IRIParser st IRI
angles p :: IRIParser st IRI
p = Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '<' ParsecT String st Identity Char
-> IRIParser st IRI -> IRIParser st IRI
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (IRI -> IRI) -> IRIParser st IRI -> IRIParser st IRI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ i :: IRI
i -> IRI
i { hasAngles :: Bool
hasAngles = Bool
True }) IRIParser st IRI
p IRIParser st IRI
-> ParsecT String st Identity Char -> IRIParser st IRI
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '>'

-- | Parses a CURIE possibly followed by components of a compound Id
compoundCurie :: IRIParser st IRI
compoundCurie :: IRIParser st IRI
compoundCurie = do
      IRI
i <- IRIParser st IRI
forall st. IRIParser st IRI
curie
      (c :: [Id]
c, p :: Range
p) <- ([Id], Range)
-> ParsecT String st Identity ([Id], Range)
-> ParsecT String st Identity ([Id], Range)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option ([], Range
nullRange) (([String], [String]) -> ParsecT String st Identity ([Id], Range)
forall st. ([String], [String]) -> GenParser Char st ([Id], Range)
comps ([], []))
      IRI -> IRIParser st IRI
forall (m :: * -> *) a. Monad m => a -> m a
return IRI
i { iFragment :: String
iFragment = Id -> String
forall a. Show a => a -> String
show (Id -> String) -> Id -> String
forall a b. (a -> b) -> a -> b
$ Id -> ([Id], Range) -> Id
addComponents (String -> Id
stringToId (String -> Id) -> String -> Id
forall a b. (a -> b) -> a -> b
$ IRI -> String
iFragment IRI
i) ([Id]
c,Range
p),
                 isBlankNode :: Bool
isBlankNode = IRI -> String
prefixName IRI
i String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "_" }

-- | Parses a CURIE according to <http://www.w3.org/TR/rdfa-core/#s_curies> and
--   the following exceptions:
--    - the prefix may be empty (java OWL API allows this)
--    - for the empty prefix, the colon can be omitted (":A" == "A")
curie :: IRIParser st IRI
curie :: IRIParser st IRI
curie = IRIParser st IRI -> IRIParser st IRI
forall st. IRIParser st IRI -> IRIParser st IRI
iriWithPos (IRIParser st IRI -> IRIParser st IRI)
-> IRIParser st IRI -> IRIParser st IRI
forall a b. (a -> b) -> a -> b
$ do
    String
pn <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (ParsecT String st Identity String
 -> ParsecT String st Identity String)
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
        String
n <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" ParsecT String st Identity String
forall st. GenParser Char st String
ncname 
                              
        String
_ <- String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ":"
        String -> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String st Identity String)
-> String -> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ String
n -- ++ c Don't add the colon to the prefix!
      )
    IRI
i <- Bool -> IRIParser st IRI
forall st. Bool -> IRIParser st IRI
referenceAux Bool
False
    IRI -> IRIParser st IRI
forall (m :: * -> *) a. Monad m => a -> m a
return IRI
nullIRI { prefixName :: String
prefixName = String
pn, iFragment :: String
iFragment = ShowS -> IRI -> ShowS
iriToString ShowS
forall a. a -> a
id IRI
i ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [], isAbbrev :: Bool
isAbbrev = Bool
True }

-- reference :: IRIParser st IRI
-- reference = referenceAux True

dolChar :: IRIParser st String
dolChar :: IRIParser st String
dolChar = Bool -> String -> IRIParser st String
forall st. Bool -> String -> IRIParser st String
ucharAux Bool
True "@:"

referenceAux :: Bool -> IRIParser st IRI
referenceAux :: Bool -> IRIParser st IRI
referenceAux allowEmpty :: Bool
allowEmpty = IRIParser st IRI -> IRIParser st IRI
forall st. IRIParser st IRI -> IRIParser st IRI
iriWithPos (IRIParser st IRI -> IRIParser st IRI)
-> IRIParser st IRI -> IRIParser st IRI
forall a b. (a -> b) -> a -> b
$ do
  String
up <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (ParsecT String st Identity Char
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m a -> m [a]
single (ParsecT String st Identity Char
 -> ParsecT String st Identity String)
-> ParsecT String st Identity Char
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/')
        ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" ((ParsecT String st Identity String
forall st. GenParser Char st String
dolChar ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
-> ParsecT String st Identity Char
-> ParsecT String st Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count 1 ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++>
                        ParsecT String st Identity [String]
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity String
-> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity String
 -> ParsecT String st Identity [String])
-> ParsecT String st Identity String
-> ParsecT String st Identity [String]
forall a b. (a -> b) -> a -> b
$ Bool -> String -> ParsecT String st Identity String
forall st. Bool -> String -> IRIParser st String
ucharAux Bool
True "@:/.-"))
  String
uq <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" ParsecT String st Identity String
forall st. GenParser Char st String
uiquery
  String
uf <- (if Bool
allowEmpty Bool -> Bool -> Bool
|| Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
up) Bool -> Bool -> Bool
|| Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
uq)
         then String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" else ParsecT String st Identity String
-> ParsecT String st Identity String
forall a. a -> a
id) ParsecT String st Identity String
forall st. GenParser Char st String
uifragment
  let iri :: IRI
iri = IRI
nullIRI
          { iriPath :: Id
iriPath = String -> Id
stringToId String
up
          , iriQuery :: String
iriQuery = String
uq
          , iriFragment :: String
iriFragment = String
uf
          , isAbbrev :: Bool
isAbbrev = Bool
True  
          }
  IRI -> IRIParser st IRI
forall (m :: * -> *) a. Monad m => a -> m a
return IRI
iri

urnParser :: IRIParser st IRI
urnParser :: IRIParser st IRI
urnParser = let ldh :: ParsecT String u Identity Char
ldh = ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "-." in IRIParser st IRI -> IRIParser st IRI
forall st. IRIParser st IRI -> IRIParser st IRI
iriWithPos (IRIParser st IRI -> IRIParser st IRI)
-> IRIParser st IRI -> IRIParser st IRI
forall a b. (a -> b) -> a -> b
$
  do
    -- The leading scheme (urn:) is case-insensitive.
    String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "uU" ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "rR" ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "nN" ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':'
    String
nid <- ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String st Identity Char
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:>
      ParsecT String st Identity Char
-> ParsecT String st Identity ()
-> ParsecT String st Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String st Identity Char
forall u. ParsecT String u Identity Char
ldh (ParsecT String st Identity () -> ParsecT String st Identity ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity () -> ParsecT String st Identity ())
-> (ParsecT String st Identity () -> ParsecT String st Identity ())
-> ParsecT String st Identity ()
-> ParsecT String st Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT String st Identity () -> ParsecT String st Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT String st Identity () -> ParsecT String st Identity ())
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall a b. (a -> b) -> a -> b
$ (ParsecT String st Identity Char
forall u. ParsecT String u Identity Char
ldh ParsecT String st Identity Char
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity Char -> ParsecT String st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT String st Identity Char
forall u. ParsecT String u Identity Char
ldh)) ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++>
      (ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String st Identity Char
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> String -> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return "") 
    Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':'
    String
nss <- ParsecT String st Identity [String]
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity [String]
 -> ParsecT String st Identity String)
-> ParsecT String st Identity [String]
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity String
-> ParsecT String st Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String st Identity String
forall st. String -> IRIParser st String
uchar "/[]")
    String
rComponent <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (ParsecT String st Identity String
 -> ParsecT String st Identity String)
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "?+" ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> ParsecT String st Identity [String]
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity String
-> ParsecT String st Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String st Identity String
 -> ParsecT String st Identity [String])
-> ParsecT String st Identity String
-> ParsecT String st Identity [String]
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity String
forall st. String -> IRIParser st String
uchar "/?")
    String
qComponent <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (ParsecT String st Identity String
 -> ParsecT String st Identity String)
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "?=" ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> ParsecT String st Identity [String]
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity String
-> ParsecT String st Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String st Identity String
 -> ParsecT String st Identity [String])
-> ParsecT String st Identity String
-> ParsecT String st Identity [String]
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity String
forall st. String -> IRIParser st String
uchar "/?")
    String
fragment <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" ParsecT String st Identity String
forall st. GenParser Char st String
uifragment
    IRI -> IRIParser st IRI
forall (m :: * -> *) a. Monad m => a -> m a
return IRI
nullIRI
              { iriScheme :: String
iriScheme = "urn"
              , iriAuthority :: Maybe IRIAuth
iriAuthority = IRIAuth -> Maybe IRIAuth
forall a. a -> Maybe a
Just IRIAuth :: String -> String -> String -> IRIAuth
IRIAuth
                { iriUserInfo :: String
iriUserInfo = ""
                , iriRegName :: String
iriRegName = String
nid
                , iriPort :: String
iriPort = ""
                }
              , iriPath :: Id
iriPath = String -> Id
stringToId String
nss
              , iriQuery :: String
iriQuery = String
rComponent String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
qComponent
              , iriFragment :: String
iriFragment = String
fragment
              }
  


  

    
  
{- | Prefix part of CURIE in @prefix_part:reference@
  <http://www.w3.org/TR/2009/REC-xml-names-20091208/#NT-NCName> -}
ncname :: GenParser Char st String
ncname :: GenParser Char st String
ncname = GenParser Char st Char
forall u. ParsecT String u Identity Char
nameStartChar GenParser Char st Char
-> GenParser Char st String -> GenParser Char st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> GenParser Char st Char -> GenParser Char st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many GenParser Char st Char
forall u. ParsecT String u Identity Char
nameChar

nameStartChar :: GenParser Char st Char
nameStartChar :: GenParser Char st Char
nameStartChar = (Char -> Bool) -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
nameStartCharP

nameChar :: GenParser Char st Char
nameChar :: GenParser Char st Char
nameChar = (Char -> Bool) -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
nameCharP

{- NOTE: Usually ':' is allowed. Here, only ncname uses nameStartChar, however.
Thus we disallow ':' -}
nameStartCharP :: Char -> Bool
nameStartCharP :: Char -> Bool
nameStartCharP c :: Char
c =
  (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_') Bool -> Bool -> Bool
||       -- W3C: (c `elem` ":_") ||
  Char -> Bool
pnCharsBaseP Char
c

nameCharP :: Char -> Bool
nameCharP :: Char -> Bool
nameCharP c :: Char
c = Char -> Bool
nameStartCharP Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "-." Bool -> Bool -> Bool
|| Char -> Bool
pnCharsPAux Char
c

-- END CURIE

-- BEGIN SPARQL

{- http://www.w3.org/TR/2008/REC-rdf-sparql-query-20080115/
Section 4.1 -}

pnCharsBaseP :: Char -> Bool
pnCharsBaseP :: Char -> Bool
pnCharsBaseP c :: Char
c =
  let n :: Int
n = Char -> Int
ord Char
c in
  Char -> Bool
isAlphaChar Char
c Bool -> Bool -> Bool
||
  (0x00C0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x00D6) Bool -> Bool -> Bool
||
  (0x00D8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x00F6) Bool -> Bool -> Bool
||
  (0x00F8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x02FF) Bool -> Bool -> Bool
||
  (0x0370 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x037D) Bool -> Bool -> Bool
||
  (0x037F Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x1FFF) Bool -> Bool -> Bool
||
  (0x200C Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x200D) Bool -> Bool -> Bool
||
  (0x2070 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x218F) Bool -> Bool -> Bool
||
  (0x2C00 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x2FEF) Bool -> Bool -> Bool
||
  (0x3001 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xD7FF) Bool -> Bool -> Bool
||
  (0xF900 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xFDCF) Bool -> Bool -> Bool
||
  (0xFDF0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xFFFD) Bool -> Bool -> Bool
||
  (0x10000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xEFFFF)

pnCharsPAux :: Char -> Bool
pnCharsPAux :: Char -> Bool
pnCharsPAux c :: Char
c =
  let n :: Int
n = Char -> Int
ord Char
c in
  Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
||
  (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0x00B7) Bool -> Bool -> Bool
||
  (0x0300 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x036F) Bool -> Bool -> Bool
||
  (0x203F Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x2040)

-- RFC3987, section 2.2

-- IRI         = scheme ":" ihier-part [ "?" iquery ] [ "#" ifragment ]

{- ihier-part   = "//" iauthority ipath-abempty
/ ipath-absolute
/ ipath-rootless
/ ipath-empty -}

iriParser :: IRIParser st IRI
iriParser :: IRIParser st IRI
iriParser = IRIParser st IRI -> IRIParser st IRI -> IRIParser st IRI
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) (IRIParser st IRI -> IRIParser st IRI
forall tok st a. GenParser tok st a -> GenParser tok st a
try IRIParser st IRI
forall st. IRIParser st IRI
urnParser) (IRIParser st IRI -> IRIParser st IRI)
-> IRIParser st IRI -> IRIParser st IRI
forall a b. (a -> b) -> a -> b
$ IRIParser st IRI -> IRIParser st IRI
forall st. IRIParser st IRI -> IRIParser st IRI
iriWithPos (IRIParser st IRI -> IRIParser st IRI)
-> IRIParser st IRI -> IRIParser st IRI
forall a b. (a -> b) -> a -> b
$ do
  String
us <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (ParsecT String st Identity String
 -> ParsecT String st Identity String)
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String st Identity String
forall st. GenParser Char st String
uscheme
  (ua :: Maybe IRIAuth
ua, up :: Id
up) <- IRIParser st (Maybe IRIAuth, Id)
forall st. IRIParser st (Maybe IRIAuth, Id)
ihierPart
  String
uq <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" ParsecT String st Identity String
forall st. GenParser Char st String
uiquery
  String
uf <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" ParsecT String st Identity String
forall st. GenParser Char st String
uifragment
  IRI -> IRIParser st IRI
forall (m :: * -> *) a. Monad m => a -> m a
return IRI
nullIRI
            { iriScheme :: String
iriScheme = String
us
            , iriAuthority :: Maybe IRIAuth
iriAuthority = Maybe IRIAuth
ua
            , iriPath :: Id
iriPath = Id
up
            , iriQuery :: String
iriQuery = String
uq
            , iriFragment :: String
iriFragment = String
uf
            }

ihierPart :: IRIParser st (Maybe IRIAuth, Id)
ihierPart :: IRIParser st (Maybe IRIAuth, Id)
ihierPart = IRIParser st (Maybe IRIAuth, Id)
forall st. IRIParser st (Maybe IRIAuth, Id)
ihierOrIrelativePart
    IRIParser st (Maybe IRIAuth, Id)
-> IRIParser st (Maybe IRIAuth, Id)
-> IRIParser st (Maybe IRIAuth, Id)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Id -> (Maybe IRIAuth, Id))
-> ParsecT String st Identity Id
-> IRIParser st (Maybe IRIAuth, Id)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ s :: Id
s -> (Maybe IRIAuth
forall a. Maybe a
Nothing, Id
s)) ParsecT String st Identity Id
forall st. IRIParser st Id
ihierPartNoAuth

ihierOrIrelativePart :: IRIParser st (Maybe IRIAuth, Id)
ihierOrIrelativePart :: IRIParser st (Maybe IRIAuth, Id)
ihierOrIrelativePart =
  GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "//") GenParser Char st String
-> IRIParser st (Maybe IRIAuth, Id)
-> IRIParser st (Maybe IRIAuth, Id)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity (Maybe IRIAuth)
-> ParsecT String st Identity Id
-> IRIParser st (Maybe IRIAuth, Id)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m (a, b)
pair ParsecT String st Identity (Maybe IRIAuth)
forall st. IRIParser st (Maybe IRIAuth)
uiauthority ParsecT String st Identity Id
forall st. IRIParser st Id
ipathAbEmpty

ihierPartNoAuth :: IRIParser st Id
ihierPartNoAuth :: IRIParser st Id
ihierPartNoAuth = IRIParser st Id
forall st. IRIParser st Id
ipathAbs IRIParser st Id -> IRIParser st Id -> IRIParser st Id
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st Id
forall st. IRIParser st Id
ipathRootLessId IRIParser st Id -> IRIParser st Id -> IRIParser st Id
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Id -> IRIParser st Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> IRIParser st Id) -> Id -> IRIParser st Id
forall a b. (a -> b) -> a -> b
$ String -> Id
stringToId "")

-- RFC3986, section 3.1

uscheme :: IRIParser st String
uscheme :: IRIParser st String
uscheme = (Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAlphaChar ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity Char -> IRIParser st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSchemeChar) IRIParser st String -> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> IRIParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ":"

-- RFC3987, section 2.2

uiauthority :: IRIParser st (Maybe IRIAuth)
uiauthority :: IRIParser st (Maybe IRIAuth)
uiauthority = do
  String
uu <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (ParsecT String st Identity String
-> ParsecT String st Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String st Identity String
forall st. GenParser Char st String
iuserinfo)
  String
uh <- ParsecT String st Identity String
forall st. GenParser Char st String
ihost
  String
up <- String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" ParsecT String st Identity String
forall st. GenParser Char st String
port
  Maybe IRIAuth -> IRIParser st (Maybe IRIAuth)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe IRIAuth -> IRIParser st (Maybe IRIAuth))
-> Maybe IRIAuth -> IRIParser st (Maybe IRIAuth)
forall a b. (a -> b) -> a -> b
$ IRIAuth -> Maybe IRIAuth
forall a. a -> Maybe a
Just IRIAuth :: String -> String -> String -> IRIAuth
IRIAuth
            { iriUserInfo :: String
iriUserInfo = String
uu
            , iriRegName :: String
iriRegName = String
uh
            , iriPort :: String
iriPort = String
up
            }

-- RFC3987, section 2.2

iuserinfo :: IRIParser st String
iuserinfo :: IRIParser st String
iuserinfo = ParsecT String st Identity [String] -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (IRIParser st String -> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (IRIParser st String -> ParsecT String st Identity [String])
-> IRIParser st String -> ParsecT String st Identity [String]
forall a b. (a -> b) -> a -> b
$ String -> IRIParser st String
forall st. String -> IRIParser st String
uchar ";:&=+$,") IRIParser st String -> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> IRIParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "@"

-- RFC3987, section 2.2

ihost :: IRIParser st String
ihost :: IRIParser st String
ihost = IRIParser st String
forall st. GenParser Char st String
ipLiteral IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st String -> IRIParser st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try IRIParser st String
forall st. GenParser Char st String
ipv4address IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st String
forall st. GenParser Char st String
iregName

ipLiteral :: IRIParser st String
ipLiteral :: IRIParser st String
ipLiteral = Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '[' ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> (IRIParser st String
forall st. GenParser Char st String
ipv6address IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st String
forall st. GenParser Char st String
ipvFuture) IRIParser st String -> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> IRIParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "]"
    IRIParser st String -> String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "IP address literal"

ipvFuture :: IRIParser st String
ipvFuture :: IRIParser st String
ipvFuture = Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char 'v' ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '.'
    ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity Char -> IRIParser st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIpvFutureChar)

isIpvFutureChar :: Char -> Bool
isIpvFutureChar :: Char -> Bool
isIpvFutureChar c :: Char
c = Char -> Bool
isUnreserved Char
c Bool -> Bool -> Bool
|| Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c (':' Char -> ShowS
forall a. a -> [a] -> [a]
: String
subDelim)

ipv6address :: IRIParser st String
ipv6address :: IRIParser st String
ipv6address = do
    [String]
hs <- Int -> Int -> IRIParser st String -> GenParser Char st [String]
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax 0 7 IRIParser st String
forall st. GenParser Char st String
h4c
    ShowS -> IRIParser st String -> IRIParser st String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
hs String -> ShowS
forall a. [a] -> [a] -> [a]
++) (IRIParser st String -> IRIParser st String)
-> IRIParser st String -> IRIParser st String
forall a b. (a -> b) -> a -> b
$ case [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
hs of
      7 -> IRIParser st String
forall st. GenParser Char st String
h4 IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> IRIParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ":"
      6 -> IRIParser st String
forall st. GenParser Char st String
ipv4address IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':' ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> (IRIParser st String
forall st. GenParser Char st String
h4 IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> IRIParser st String
forall (m :: * -> *) a. Monad m => a -> m a
return "")
      0 -> String -> IRIParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "::" IRIParser st String -> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> Int -> IRIParser st String
forall st. Int -> IRIParser st String
ipv6rest 7
      n :: Int
n -> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':' ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> Int -> IRIParser st String
forall st. Int -> IRIParser st String
ipv6rest (7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
  IRIParser st String -> String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "IPv6 address"

ipv6rest :: Int -> IRIParser st String
ipv6rest :: Int -> IRIParser st String
ipv6rest m :: Int
m = do
    [String]
fs <- Int -> Int -> IRIParser st String -> GenParser Char st [String]
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax 0 (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) IRIParser st String
forall st. GenParser Char st String
h4c
    ShowS -> IRIParser st String -> IRIParser st String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
fs String -> ShowS
forall a. [a] -> [a] -> [a]
++) (IRIParser st String -> IRIParser st String)
-> IRIParser st String -> IRIParser st String
forall a b. (a -> b) -> a -> b
$ if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
fs then
       IRIParser st String
forall st. GenParser Char st String
ipv4address IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st String
forall st. GenParser Char st String
h4 IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> IRIParser st String
forall (m :: * -> *) a. Monad m => a -> m a
return ""
       else if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
fs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 then IRIParser st String
forall st. GenParser Char st String
h4 else
        IRIParser st String
forall st. GenParser Char st String
ipv4address IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st String
forall st. GenParser Char st String
h4

h4c :: IRIParser st String
h4c :: IRIParser st String
h4c = IRIParser st String -> IRIParser st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (IRIParser st String -> IRIParser st String)
-> IRIParser st String -> IRIParser st String
forall a b. (a -> b) -> a -> b
$ IRIParser st String
forall st. GenParser Char st String
h4 IRIParser st String -> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> IRIParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ":"

h4 :: IRIParser st String
h4 :: IRIParser st String
h4 = Int -> Int -> GenParser Char st Char -> IRIParser st String
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax 1 4 GenParser Char st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit

ipv4address :: IRIParser st String
ipv4address :: IRIParser st String
ipv4address = IRIParser st String -> IRIParser st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (IRIParser st String
forall st. GenParser Char st String
decOctet IRIParser st String -> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> IRIParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "."
    IRIParser st String -> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> IRIParser st String
forall st. GenParser Char st String
decOctet) IRIParser st String -> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> IRIParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "."
    IRIParser st String -> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> IRIParser st String
forall st. GenParser Char st String
decOctet IRIParser st String -> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> IRIParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "."
    IRIParser st String -> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> IRIParser st String
forall st. GenParser Char st String
decOctet

decOctet :: IRIParser st String
decOctet :: IRIParser st String
decOctet = do
  String
a1 <- Int -> Int -> GenParser Char st Char -> IRIParser st String
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax 1 3 GenParser Char st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  if (String -> Int
forall a. Read a => String -> a
read String
a1 :: Int) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 255 then
            String -> IRIParser st String
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "Decimal octet value too large"
          else
            String -> IRIParser st String
forall (m :: * -> *) a. Monad m => a -> m a
return String
a1

iregName :: IRIParser st String
iregName :: IRIParser st String
iregName =
    ParsecT String st Identity [String] -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (Int
-> Int
-> IRIParser st String
-> ParsecT String st Identity [String]
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax 0 255 (IRIParser st String -> ParsecT String st Identity [String])
-> IRIParser st String -> ParsecT String st Identity [String]
forall a b. (a -> b) -> a -> b
$ IRIParser st String
forall st. GenParser Char st String
iunreservedChar IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st String
forall st. GenParser Char st String
escaped IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st String
forall st. GenParser Char st String
subDelims)
    IRIParser st String -> String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "Registered name"

-- RFC3986, section 3.2.3

port :: IRIParser st String
port :: IRIParser st String
port = Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ':' ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity Char -> IRIParser st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

-- RFC3987, section 2.2

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

{- ipath-abempty  = *( "/" iisegment )
ipath-absolute = "/" [ iisegment-nz *( "/" iisegment ) ]
ipath-noscheme = iisegment-nz-nc *( "/" iisegment )
ipath-rootless = iisegment-nz *( "/" iisegment )
ipath-empty    = 0<iipchar> -}

{- iisegment       = *iipchar
iisegment-nz    = 1*iipchar
iisegment-nz-nc = 1*( iunreserved / pct-encoded / sub-delims
/ "@" )
; non-zero-length isegment without any colon ":" -}

{- iipchar         = iunreserved / pct-encoded / sub-delims / ":"
/ "@" -}

-- idParser :: IRIParser st Id
-- idParser = mixId ([],[]) ([],[])

ipathAbEmpty :: IRIParser st Id
ipathAbEmpty :: IRIParser st Id
ipathAbEmpty = do
  String
s <- ParsecT String st Identity [String]
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity [String]
 -> ParsecT String st Identity String)
-> ParsecT String st Identity [String]
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity String
-> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity String
forall st. GenParser Char st String
slashIsegment
  Id -> IRIParser st Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> IRIParser st Id) -> Id -> IRIParser st Id
forall a b. (a -> b) -> a -> b
$ String -> Id
stringToId String
s

-- ipathAbEmpty1 :: Bool -> IRIParser st Id
-- ipathAbEmpty1 slash = do
--   when slash $ do char '/'; return ()
--   si <- isegmentorId "/"
--   case si of
--     Left s ->     do char '/'
--                      i <- ipathAbEmpty1 False
--                      return $ prependString s i
--               <|> do return $ stringToId ""
--     Right i -> return i

-- isegmentorId :: String -> IRIParser st (Either String Id)
-- isegmentorId lead =
--       do s <- isegment
--          return (Left ('/':s))
-- --  <|> do id <- idParser
-- --         return (Right (prependString "/" id))
  
ipathAbs :: IRIParser st Id
ipathAbs :: IRIParser st Id
ipathAbs = do
  String
s <- Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/' ParsecT String st Identity Char
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" ParsecT String st Identity String
forall st. GenParser Char st String
ipathRootLess
  Id -> IRIParser st Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> IRIParser st Id) -> Id -> IRIParser st Id
forall a b. (a -> b) -> a -> b
$ String -> Id
stringToId String
s

ipathRootLessId :: IRIParser st Id
ipathRootLessId :: IRIParser st Id
ipathRootLessId = do
  String
s <- IRIParser st String
forall st. GenParser Char st String
ipathRootLess
  Id -> IRIParser st Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> IRIParser st Id) -> Id -> IRIParser st Id
forall a b. (a -> b) -> a -> b
$ String -> Id
stringToId String
s

ipathRootLess :: IRIParser st String
ipathRootLess :: IRIParser st String
ipathRootLess = ParsecT String st Identity [String] -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity [String] -> IRIParser st String)
-> ParsecT String st Identity [String] -> IRIParser st String
forall a b. (a -> b) -> a -> b
$ IRIParser st String
forall st. GenParser Char st String
isegmentNz IRIParser st String
-> ParsecT String st Identity [String]
-> ParsecT String st Identity [String]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> IRIParser st String -> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many IRIParser st String
forall st. GenParser Char st String
slashIsegment

ipathNoScheme :: IRIParser st Id
ipathNoScheme :: IRIParser st Id
ipathNoScheme =  do
  String
s <- ParsecT String st Identity [String]
-> ParsecT String st Identity String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity [String]
 -> ParsecT String st Identity String)
-> ParsecT String st Identity [String]
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity String
forall st. GenParser Char st String
isegmentNzc ParsecT String st Identity String
-> ParsecT String st Identity [String]
-> ParsecT String st Identity [String]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity String
-> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity String
forall st. GenParser Char st String
slashIsegment
  Id -> IRIParser st Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> IRIParser st Id) -> Id -> IRIParser st Id
forall a b. (a -> b) -> a -> b
$ String -> Id
stringToId String
s

slashIsegment :: IRIParser st String
slashIsegment :: IRIParser st String
slashIsegment = Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '/' ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> IRIParser st String
forall st. GenParser Char st String
isegment

isegment :: IRIParser st String
isegment :: IRIParser st String
isegment = ParsecT String st Identity [String] -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity [String] -> IRIParser st String)
-> ParsecT String st Identity [String] -> IRIParser st String
forall a b. (a -> b) -> a -> b
$ IRIParser st String -> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many IRIParser st String
forall st. GenParser Char st String
ipchar

isegmentNz :: IRIParser st String
isegmentNz :: IRIParser st String
isegmentNz = ParsecT String st Identity [String] -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity [String] -> IRIParser st String)
-> ParsecT String st Identity [String] -> IRIParser st String
forall a b. (a -> b) -> a -> b
$ IRIParser st String -> ParsecT String st Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 IRIParser st String
forall st. GenParser Char st String
ipchar

isegmentNzc :: IRIParser st String
isegmentNzc :: IRIParser st String
isegmentNzc = ParsecT String st Identity [String] -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity [String] -> IRIParser st String)
-> (IRIParser st String -> ParsecT String st Identity [String])
-> IRIParser st String
-> IRIParser st String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRIParser st String -> ParsecT String st Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (IRIParser st String -> IRIParser st String)
-> IRIParser st String -> IRIParser st String
forall a b. (a -> b) -> a -> b
$ String -> IRIParser st String
forall st. String -> IRIParser st String
uchar "@"

ipchar :: IRIParser st String
ipchar :: IRIParser st String
ipchar = String -> IRIParser st String
forall st. String -> IRIParser st String
uchar ":@"

uchar :: String -> IRIParser st String
uchar :: String -> IRIParser st String
uchar = Bool -> String -> IRIParser st String
forall st. Bool -> String -> IRIParser st String
ucharAux Bool
False

-- helper function for ipchar and friends
ucharAux :: Bool -> String -> IRIParser st String
ucharAux :: Bool -> String -> IRIParser st String
ucharAux dolCurie :: Bool
dolCurie extras :: String
extras =
        IRIParser st String
forall st. GenParser Char st String
iunreservedChar
    IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st String
forall st. GenParser Char st String
escaped
    IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity Char -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a]
single (String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf (String -> ParsecT String st Identity Char)
-> String -> ParsecT String st Identity Char
forall a b. (a -> b) -> a -> b
$ String
extras String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Bool
dolCurie then String
dolDelim else String
subDelim)

-- RFC3987, section 2.2

uiquery :: IRIParser st String
uiquery :: IRIParser st String
uiquery = Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '?' ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity [String] -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (IRIParser st String -> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many IRIParser st String
forall st. GenParser Char st String
iqueryPart)

iqueryPart :: IRIParser st String
iqueryPart :: IRIParser st String
iqueryPart = ParsecT String st Identity Char -> IRIParser st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String st Identity Char
forall u. ParsecT String u Identity Char
iprivate IRIParser st String -> IRIParser st String -> IRIParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> IRIParser st String
forall st. String -> IRIParser st String
uchar ":@/?"

-- RFC3987, section 2.2

uifragment :: IRIParser st String
uifragment :: IRIParser st String
uifragment = Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '#' ParsecT String st Identity Char
-> IRIParser st String -> IRIParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity [String] -> IRIParser st String
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (IRIParser st String -> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (IRIParser st String -> ParsecT String st Identity [String])
-> IRIParser st String -> ParsecT String st Identity [String]
forall a b. (a -> b) -> a -> b
$ String -> IRIParser st String
forall st. String -> IRIParser st String
uchar ":@/?[]")

-- Reference, Relative and Absolute IRI forms

-- RFC3987, section 2.2

iriReference :: IRIParser st IRI
iriReference :: IRIParser st IRI
iriReference = IRIParser st IRI
forall st. IRIParser st IRI
iriParser IRIParser st IRI -> IRIParser st IRI -> IRIParser st IRI
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> IRIParser st IRI
forall st. IRIParser st IRI
irelativeRef

-- RFC3987, section 2.2

-- irelative-ref  = irelative-part [ "?" iquery ] [ "#" ifragment ]

{- irelative-part = "//" iauthority ipath-abempty
/ ipath-absolute -}

irelativeRef :: IRIParser st IRI
irelativeRef :: IRIParser st IRI
irelativeRef = IRIParser st IRI -> IRIParser st IRI
forall st. IRIParser st IRI -> IRIParser st IRI
iriWithPos (IRIParser st IRI -> IRIParser st IRI)
-> IRIParser st IRI -> IRIParser st IRI
forall a b. (a -> b) -> a -> b
$ do
  GenParser Char st String -> GenParser Char st ()
forall a tok st.
Show a =>
GenParser tok st a -> GenParser tok st ()
notMatching GenParser Char st String
forall st. GenParser Char st String
uscheme
  (ua :: Maybe IRIAuth
ua, up :: Id
up) <- IRIParser st (Maybe IRIAuth, Id)
forall st. IRIParser st (Maybe IRIAuth, Id)
irelativePart
  String
uq <- String -> GenParser Char st String -> GenParser Char st String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" GenParser Char st String
forall st. GenParser Char st String
uiquery
  String
uf <- String -> GenParser Char st String -> GenParser Char st String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" GenParser Char st String
forall st. GenParser Char st String
uifragment
  IRI -> IRIParser st IRI
forall (m :: * -> *) a. Monad m => a -> m a
return IRI
nullIRI
            { iriAuthority :: Maybe IRIAuth
iriAuthority = Maybe IRIAuth
ua
            , iriPath :: Id
iriPath = Id
up
            , iriQuery :: String
iriQuery = String
uq
            , iriFragment :: String
iriFragment = String
uf
            }

irelativePart :: IRIParser st (Maybe IRIAuth, Id)
irelativePart :: IRIParser st (Maybe IRIAuth, Id)
irelativePart = IRIParser st (Maybe IRIAuth, Id)
forall st. IRIParser st (Maybe IRIAuth, Id)
ihierOrIrelativePart
  IRIParser st (Maybe IRIAuth, Id)
-> IRIParser st (Maybe IRIAuth, Id)
-> IRIParser st (Maybe IRIAuth, Id)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Id -> (Maybe IRIAuth, Id))
-> ParsecT String st Identity Id
-> IRIParser st (Maybe IRIAuth, Id)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ s :: Id
s -> (Maybe IRIAuth
forall a. Maybe a
Nothing, Id
s)) (ParsecT String st Identity Id
forall st. IRIParser st Id
ipathAbs ParsecT String st Identity Id
-> ParsecT String st Identity Id -> ParsecT String st Identity Id
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity Id
forall st. IRIParser st Id
ipathNoScheme ParsecT String st Identity Id
-> ParsecT String st Identity Id -> ParsecT String st Identity Id
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Id -> ParsecT String st Identity Id
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Id
stringToId ""))

-- RFC3987, section 2.2 omitted absoluteIRI

-- Imports from RFC 2234

    {- NOTE: can't use isAlphaNum etc. because these deal with ISO 8859
    (and possibly Unicode!) chars.
    [[[Above was a comment originally in GHC Network/IRI.hs:
    when IRIs are introduced then most codepoints above 128(?) should
    be treated as unreserved, and higher codepoints for letters should
    certainly be allowed.
    ]]] -}

isAlphaChar :: Char -> Bool
isAlphaChar :: Char -> Bool
isAlphaChar c :: Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
c

isAlphaNumChar :: Char -> Bool
isAlphaNumChar :: Char -> Bool
isAlphaNumChar c :: Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
c

isSchemeChar :: Char -> Bool
isSchemeChar :: Char -> Bool
isSchemeChar c :: Char
c = Char -> Bool
isAlphaNumChar Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "+-."

isUcsChar :: Char -> Bool
isUcsChar :: Char -> Bool
isUcsChar c :: Char
c =
  let n :: Int
n = Char -> Int
ord Char
c
  in (0xA0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xD7FF) Bool -> Bool -> Bool
||
     (0xF900 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xFDCF) Bool -> Bool -> Bool
||
     (0xFDF0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xFFEF) Bool -> Bool -> Bool
||
     (0x10000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x1FFFD) Bool -> Bool -> Bool
||
     (0x20000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x2FFFD) Bool -> Bool -> Bool
||
     (0x30000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x3FFFD) Bool -> Bool -> Bool
||
     (0x40000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x4FFFD) Bool -> Bool -> Bool
||
     (0x50000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x5FFFD) Bool -> Bool -> Bool
||
     (0x60000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x6FFFD) Bool -> Bool -> Bool
||
     (0x70000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x7FFFD) Bool -> Bool -> Bool
||
     (0x80000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x8FFFD) Bool -> Bool -> Bool
||
     (0x90000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x9FFFD) Bool -> Bool -> Bool
||
     (0xA0000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xAFFFD) Bool -> Bool -> Bool
||
     (0xB0000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xBFFFD) Bool -> Bool -> Bool
||
     (0xC0000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xCFFFD) Bool -> Bool -> Bool
||
     (0xD0000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xDFFFD) Bool -> Bool -> Bool
||
     (0xE1000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xEFFFD) Bool -> Bool -> Bool
||
     -- The following line is a custom extension. It is *not* part of the IRI
     -- standard, but necessary for the TPTP library (all THF examples) to
     -- work:
     Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '^'

isIprivate :: Char -> Bool
isIprivate :: Char -> Bool
isIprivate c :: Char
c =
  let n :: Int
n = Char -> Int
ord Char
c
  in (0xE000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xF8FF) Bool -> Bool -> Bool
||
     (0xF000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xFFFD) Bool -> Bool -> Bool
||
     (0x100000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x10FFFD)

iprivate :: IRIParser st Char
iprivate :: IRIParser st Char
iprivate = (Char -> Bool) -> IRIParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIprivate

-- Additional parser combinators for common patterns

countMinMax :: Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax :: Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax m :: Int
m n :: Int
n p :: GenParser t s a
p | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = GenParser t s a
p GenParser t s a -> GenParser t s [a] -> GenParser t s [a]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> Int -> Int -> GenParser t s a -> GenParser t s [a]
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) GenParser t s a
p
countMinMax _ n :: Int
n _ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [a] -> GenParser t s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
countMinMax _ n :: Int
n p :: GenParser t s a
p = [a] -> GenParser t s [a] -> GenParser t s [a]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (GenParser t s [a] -> GenParser t s [a])
-> GenParser t s [a] -> GenParser t s [a]
forall a b. (a -> b) -> a -> b
$ GenParser t s a
p GenParser t s a -> GenParser t s [a] -> GenParser t s [a]
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> Int -> Int -> GenParser t s a -> GenParser t s [a]
forall t s a. Int -> Int -> GenParser t s a -> GenParser t s [a]
countMinMax 0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) GenParser t s a
p

notMatching :: Show a => GenParser tok st a -> GenParser tok st ()
notMatching :: GenParser tok st a -> GenParser tok st ()
notMatching p :: GenParser tok st a
p = do
    a
a <- GenParser tok st a -> GenParser tok st a
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser tok st a
p
    String -> GenParser tok st ()
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (a -> String
forall a. Show a => a -> String
show a
a)
 GenParser tok st () -> GenParser tok st () -> GenParser tok st ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> () -> GenParser tok st ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * Reconstruct a IRI string


{- | Turn an 'IRI' into a string.
Uses a supplied function to map the iuserinfo part of the IRI.
The Show instance for IRI uses a mapping that hides any password
that may be present in the IRI.  Use this function with argument @id@
to preserve the password in the formatted output. -}
iriToString :: (String -> String) -> IRI -> ShowS
iriToString :: ShowS -> IRI -> ShowS
iriToString iuserinfomap :: ShowS
iuserinfomap i :: IRI
i
  | IRI -> Bool
isURN IRI
i = IRI -> ShowS
urnToString IRI
i
  | IRI -> Bool
hasFullIRI IRI
i Bool -> Bool -> Bool
&& Bool -> Bool
not (IRI -> Bool
isAbbrev IRI
i) = ShowS -> IRI -> ShowS
iriToStringFull ShowS
iuserinfomap IRI
i
  | Bool
otherwise = IRI -> ShowS
iriToStringAbbrev IRI
i


urnToString :: IRI -> ShowS
urnToString :: IRI -> ShowS
urnToString i :: IRI
i = (("urn:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> String
urnNID IRI
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> String
urnNSS IRI
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> String
iriQuery IRI
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> String
iriFragment IRI
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++)

iriToStringShort :: (String -> String) -> IRI -> ShowS
iriToStringShort :: ShowS -> IRI -> ShowS
iriToStringShort iuserinfomap :: ShowS
iuserinfomap i :: IRI
i
  | IRI -> Bool
isAbbrev IRI
i = IRI -> ShowS
iriToStringAbbrev IRI
i
  | IRI -> Bool
hasFullIRI IRI
i = ShowS -> IRI -> ShowS
iriToStringFull ShowS
iuserinfomap IRI
i
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ IRI -> String
iriQuery IRI
i = ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IRI -> String
iriQuery IRI
i String -> ShowS
forall a. [a] -> [a] -> [a]
++)
  | Bool
otherwise = IRI -> ShowS
iriToStringAbbrev IRI
i

iriToStringFull :: (String -> String) -> IRI -> ShowS
iriToStringFull :: ShowS -> IRI -> ShowS
iriToStringFull iuserinfomap :: ShowS
iuserinfomap (IRI { iriScheme :: IRI -> String
iriScheme = String
scheme
                                  , iriAuthority :: IRI -> Maybe IRIAuth
iriAuthority = Maybe IRIAuth
authority
                                  , iriPath :: IRI -> Id
iriPath = Id
path
                                  , iriQuery :: IRI -> String
iriQuery = String
query
                                  , iriFragment :: IRI -> String
iriFragment = String
fragment
                                  , hasAngles :: IRI -> Bool
hasAngles = Bool
b
                                  }) s :: String
s = 
  (if Bool
b then "<" else "") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
scheme
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> Maybe IRIAuth -> ShowS
iriAuthToString ShowS
iuserinfomap Maybe IRIAuth
authority ""
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
query String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fragment String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
b then ">" else "") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

{- | @iriToStringAbbrev i@ Shows @i@ in abbreviated form

In a previous implementation the iFragment of abbreviated IRIs were stored in
  the path, query and fragement. For backward compatibility, these components
  are used if the @iFragment i@ is empty.
-}
iriToStringAbbrev :: IRI -> ShowS
iriToStringAbbrev :: IRI -> ShowS
iriToStringAbbrev (IRI { prefixName :: IRI -> String
prefixName = String
pname
                       , iriPath :: IRI -> Id
iriPath = Id
aPath
                       , iriQuery :: IRI -> String
iriQuery = String
aQuery
                       , iriFragment :: IRI -> String
iriFragment = String
aFragment
                       , iFragment :: IRI -> String
iFragment = String
aIFragment
                       }) =
  let pref :: String
pref = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pname then "" else String
pname String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" in
    if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
aIFragment then
      (String
pref String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id -> String
forall a. Show a => a -> String
show Id
aPath String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
aQuery String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
aFragment String -> ShowS
forall a. [a] -> [a] -> [a]
++)
    else
      (String
pref String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
aIFragment String -> ShowS
forall a. [a] -> [a] -> [a]
++)

iriToStringAbbrevMerge :: IRI -> ShowS
iriToStringAbbrevMerge :: IRI -> ShowS
iriToStringAbbrevMerge (IRI { iriPath :: IRI -> Id
iriPath = Id
aPath
                            , iriQuery :: IRI -> String
iriQuery = String
aQuery
                            , iriFragment :: IRI -> String
iriFragment = String
aFragment
                            }) =
  (Id -> String
forall a. Show a => a -> String
show Id
aPath String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
aQuery String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
aFragment String -> ShowS
forall a. [a] -> [a] -> [a]
++)

iriAuthToString :: (String -> String) -> Maybe IRIAuth -> ShowS
iriAuthToString :: ShowS -> Maybe IRIAuth -> ShowS
iriAuthToString _ Nothing = ShowS
forall a. a -> a
id          -- shows ""
iriAuthToString iuserinfomap :: ShowS
iuserinfomap
        (Just IRIAuth { iriUserInfo :: IRIAuth -> String
iriUserInfo = String
uinfo
                      , iriRegName :: IRIAuth -> String
iriRegName = String
regname
                      , iriPort :: IRIAuth -> String
iriPort = String
iport
                      } ) =
    ("//" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
uinfo then ShowS
forall a. a -> a
id else (ShowS
iuserinfomap String
uinfo String -> ShowS
forall a. [a] -> [a] -> [a]
++))
             ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
regname String -> ShowS
forall a. [a] -> [a] -> [a]
++)
             ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
iport String -> ShowS
forall a. [a] -> [a] -> [a]
++)

-- * Resolving a relative IRI relative to a base IRI

isDefined :: String -> Bool
isDefined :: String -> Bool
isDefined = Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

{- | Returns a new 'IRI' which represents the value of the
first 'IRI' interpreted as relative to the second 'IRI'.
For example:

> "foo" `relativeTo` "http://bar.org/" = "http://bar.org/foo"

-}
relativeTo :: IRI -> IRI -> Maybe IRI
relativeTo :: IRI -> IRI -> Maybe IRI
relativeTo ref :: IRI
ref base :: IRI
base
    | String -> Bool
isDefined ( IRI -> String
iriScheme IRI
ref ) =
        IRI -> Maybe IRI
just_isegments IRI
ref
    | Maybe IRIAuth -> Bool
forall a. Maybe a -> Bool
isJust ( IRI -> Maybe IRIAuth
iriAuthority IRI
ref ) =
        IRI -> Maybe IRI
just_isegments IRI
ref { iriScheme :: String
iriScheme = IRI -> String
iriScheme IRI
base }
    | String -> Bool
isDefined (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Id -> String
getFstString (Id -> String) -> Id -> String
forall a b. (a -> b) -> a -> b
$ IRI -> Id
iriPath IRI
ref = 
            IRI -> Maybe IRI
just_isegments IRI
ref
                { iriScheme :: String
iriScheme = IRI -> String
iriScheme IRI
base
                , iriAuthority :: Maybe IRIAuth
iriAuthority = IRI -> Maybe IRIAuth
iriAuthority IRI
base
                , iriPath :: Id
iriPath = if String -> Char
forall a. [a] -> a
head (Id -> String
getFstString (Id -> String) -> Id -> String
forall a b. (a -> b) -> a -> b
$ IRI -> Id
iriPath IRI
ref) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/' 
                            then IRI -> Id
iriPath IRI
ref
                            else String -> Id
stringToId (String -> Id) -> String -> Id
forall a b. (a -> b) -> a -> b
$ IRI -> IRI -> String
mergePaths IRI
base IRI
ref
                }
    | String -> Bool
isDefined ( IRI -> String
iriQuery IRI
ref ) =
        IRI -> Maybe IRI
just_isegments IRI
ref
            { iriScheme :: String
iriScheme = IRI -> String
iriScheme IRI
base
            , iriAuthority :: Maybe IRIAuth
iriAuthority = IRI -> Maybe IRIAuth
iriAuthority IRI
base
            , iriPath :: Id
iriPath = IRI -> Id
iriPath IRI
base
            }
    | Bool
otherwise =
        IRI -> Maybe IRI
just_isegments IRI
ref
            { iriScheme :: String
iriScheme = IRI -> String
iriScheme IRI
base
            , iriAuthority :: Maybe IRIAuth
iriAuthority = IRI -> Maybe IRIAuth
iriAuthority IRI
base
            , iriPath :: Id
iriPath = IRI -> Id
iriPath IRI
base
            , iriQuery :: String
iriQuery = IRI -> String
iriQuery IRI
base
            }
    where
        getFstString :: Id -> String
getFstString anId :: Id
anId = case Id -> [Token]
getTokens Id
anId of 
           (Token s :: String
s _):_ -> String
s
           _ -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "can't get first string from an empty id"        
        just_isegments :: IRI -> Maybe IRI
just_isegments u :: IRI
u =
            IRI -> Maybe IRI
forall a. a -> Maybe a
Just (IRI -> Maybe IRI) -> IRI -> Maybe IRI
forall a b. (a -> b) -> a -> b
$ IRI
u { iriPath :: Id
iriPath = Id -> Id
removeDotSegments (IRI -> Id
iriPath IRI
u) }
        mergePaths :: IRI -> IRI -> String
mergePaths b :: IRI
b r :: IRI
r
            | Maybe IRIAuth -> Bool
forall a. Maybe a -> Bool
isJust (IRI -> Maybe IRIAuth
iriAuthority IRI
b) Bool -> Bool -> Bool
&& String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pbs = '/' Char -> ShowS
forall a. a -> [a] -> [a]
: String
prs
            | Bool
otherwise = ShowS
dropLast String
pbs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prs
            where
                pb :: Id
pb = IRI -> Id
iriPath IRI
b
                pr :: Id
pr = IRI -> Id
iriPath IRI
r
                pbs :: String
pbs = Id -> String
getFstString Id
pb
                prs :: String
prs = Id -> String
getFstString Id
pr
        dropLast :: ShowS
dropLast = (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
splitLast -- reverse . dropWhile (/='/') . reverse

-- Remove dot isegments, but protect leading '/' character
removeDotSegments :: Id -> Id
removeDotSegments :: Id -> Id
removeDotSegments i :: Id
i = case Id -> [Token]
getTokens Id
i of
  [] -> String -> Id
forall a. HasCallStack => String -> a
error (String -> Id) -> String -> Id
forall a b. (a -> b) -> a -> b
$ "Common/IRI.hs: Cannot remove dots from empty id:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
i
  (Token s :: String
s r :: Range
r):_ -> let 
    t' :: Token
t' = String -> Range -> Token
Token (ShowS
removeDotSegmentsString String
s) Range
r
   in Token -> Id
simpleIdToId Token
t' 

removeDotSegmentsString :: String -> String
removeDotSegmentsString :: ShowS
removeDotSegmentsString ('/' : ps :: String
ps) = '/' Char -> ShowS
forall a. a -> [a] -> [a]
: String -> [String] -> String
elimDots String
ps []
removeDotSegmentsString ps :: String
ps = String -> [String] -> String
elimDots String
ps []

-- Second arg accumulates isegments processed so far in reverse order
elimDots :: String -> [String] -> String
elimDots :: String -> [String] -> String
elimDots "" rs :: [String]
rs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
rs)
elimDots "." rs :: [String]
rs = String -> [String] -> String
elimDots "" [String]
rs
elimDots ( '.' : '/' : ps :: String
ps) rs :: [String]
rs = String -> [String] -> String
elimDots String
ps [String]
rs
elimDots ".." rs :: [String]
rs = String -> [String] -> String
elimDots [] (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop 1 [String]
rs)
elimDots ( '.' : '.' : '/' : ps :: String
ps) rs :: [String]
rs = String -> [String] -> String
elimDots String
ps (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop 1 [String]
rs)
elimDots ps :: String
ps rs :: [String]
rs = String -> [String] -> String
elimDots String
ps1 (String
r String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rs)
    where
        (r :: String
r, ps1 :: String
ps1) = String -> (String, String)
nextSegment String
ps

{- Returns the next isegment and the rest of the path from a path string.
Each isegment ends with the next '/' or the end of string. -}
nextSegment :: String -> (String, String)
nextSegment :: String -> (String, String)
nextSegment ps :: String
ps =
    case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/') String
ps of
        (r :: String
r, '/' : ps1 :: String
ps1) -> (String
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/", String
ps1)
        (r :: String
r, _) -> (String
r, [])

-- Split last (name) isegment from path, returning (path,name)
splitLast :: String -> (String, String)
splitLast :: String -> (String, String)
splitLast path :: String
path = (ShowS
forall a. [a] -> [a]
reverse String
revpath, ShowS
forall a. [a] -> [a]
reverse String
revname)
    where
        (revname :: String
revname, revpath :: String
revpath) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
path

-- * Finding a IRI relative to a base IRI

{- | Returns a new 'IRI' which represents the relative location of
the first 'IRI' with respect to the second 'IRI'.  Thus, the
values supplied are expected to be absolute IRIs, and the result
returned may be a relative IRI.

Example:

> "http://example.com/Root/sub1/name2#frag"
>   `relativeFrom` "http://example.com/Root/sub2/name2#frag"
>   == "../sub1/name2#frag"

There is no single correct implementation of this function,
but any acceptable implementation must satisfy the following:

> (uabs `relativeFrom` ubase) `relativeTo` ubase == uabs

For any valid absolute IRI.
(cf. <http://lists.w3.org/Archives/Public/iri/2003Jan/0008.html>
<http://lists.w3.org/Archives/Public/iri/2003Jan/0005.html>) -}
relativeFrom :: IRI -> IRI -> IRI
relativeFrom :: IRI -> IRI -> IRI
relativeFrom uabs :: IRI
uabs base :: IRI
base
    | (IRI -> String) -> IRI -> IRI -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
diff IRI -> String
iriScheme IRI
uabs IRI
base = IRI
uabs
    | (IRI -> Maybe IRIAuth) -> IRI -> IRI -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
diff IRI -> Maybe IRIAuth
iriAuthority IRI
uabs IRI
base = IRI
uabs { iriScheme :: String
iriScheme = "" }
    | (IRI -> Id) -> IRI -> IRI -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
diff IRI -> Id
iriPath IRI
uabs IRI
base = IRI
uabs
        { iriScheme :: String
iriScheme = ""
        , iriAuthority :: Maybe IRIAuth
iriAuthority = Maybe IRIAuth
forall a. Maybe a
Nothing
        , iriPath :: Id
iriPath = let
                      i1 :: Id
i1 = IRI -> Id
iriPath IRI
uabs
                      i2 :: Id
i2 = IRI -> Id
iriPath IRI
base
                    in case (Id -> [Token]
getTokens Id
i1, Id -> [Token]
getTokens Id
i2) of
                        ((Token s1 :: String
s1 _):_ , (Token s2 :: String
s2 _):_) ->  
                             String -> Id
stringToId (String -> Id) -> String -> Id
forall a b. (a -> b) -> a -> b
$ String -> ShowS
relPathFrom 
                                  (ShowS
removeBodyDotSegments String
s1)
                                  (ShowS
removeBodyDotSegments String
s2)
                        _ -> String -> Id
forall a. HasCallStack => String -> a
error (String -> Id) -> String -> Id
forall a b. (a -> b) -> a -> b
$ "empty id:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
i1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
i2
        }
    | (IRI -> String) -> IRI -> IRI -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
diff IRI -> String
iriQuery IRI
uabs IRI
base = IRI
uabs
        { iriScheme :: String
iriScheme = ""
        , iriAuthority :: Maybe IRIAuth
iriAuthority = Maybe IRIAuth
forall a. Maybe a
Nothing
        , iriPath :: Id
iriPath = [Token] -> Id
mkId []
        }
    | Bool
otherwise = IRI
uabs          -- Always carry fragment from uabs
        { iriScheme :: String
iriScheme = ""
        , iriAuthority :: Maybe IRIAuth
iriAuthority = Maybe IRIAuth
forall a. Maybe a
Nothing
        , iriPath :: Id
iriPath = [Token] -> Id
mkId []
        , iriQuery :: String
iriQuery = ""
        }
    where
        diff :: Eq b => (a -> b) -> a -> a -> Bool
        diff :: (a -> b) -> a -> a -> Bool
diff sel :: a -> b
sel u1 :: a
u1 u2 :: a
u2 = a -> b
sel a
u1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= a -> b
sel a
u2
        -- Remove dot isegments except the final isegment
        removeBodyDotSegments :: ShowS
removeBodyDotSegments p :: String
p = ShowS
removeDotSegmentsString String
p1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p2
            where
               (p1 :: String
p1, p2 :: String
p2) = String -> (String, String)
splitLast String
p

relPathFrom :: String -> String -> String
relPathFrom :: String -> ShowS
relPathFrom [] _ = "/"
relPathFrom pabs :: String
pabs [] = String
pabs
relPathFrom pabs :: String
pabs base :: String
base =                 -- Construct a relative path isegments
    if String
sa1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
sb1                       -- if the paths share a leading isegment
        then if String
sa1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "/"              -- other than a leading '/'
            then if String
sa2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
sb2
                then String -> ShowS
relPathFrom1 String
ra2 String
rb2
                else String
pabs
            else String -> ShowS
relPathFrom1 String
ra1 String
rb1
        else String
pabs
    where
        (sa1 :: String
sa1, ra1 :: String
ra1) = String -> (String, String)
nextSegment String
pabs
        (sb1 :: String
sb1, rb1 :: String
rb1) = String -> (String, String)
nextSegment String
base
        (sa2 :: String
sa2, ra2 :: String
ra2) = String -> (String, String)
nextSegment String
ra1
        (sb2 :: String
sb2, rb2 :: String
rb2) = String -> (String, String)
nextSegment String
rb1

{- relPathFrom1 strips off trailing names from the supplied paths,
and calls difPathFrom to find the relative path from base to
target -}
relPathFrom1 :: String -> String -> String
relPathFrom1 :: String -> ShowS
relPathFrom1 pabs :: String
pabs base :: String
base = String
relName
    where
        (sa :: String
sa, na :: String
na) = String -> (String, String)
splitLast String
pabs
        (sb :: String
sb, nb :: String
nb) = String -> (String, String)
splitLast String
base
        rp :: String
rp = String -> ShowS
relSegsFrom String
sa String
sb
        relName :: String
relName = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rp then
                      if String
na String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
nb then ""
                      else if String -> Bool
forall (t :: * -> *). Foldable t => t Char -> Bool
protect String
na then "./" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
na
                      else String
na
                  else
                      String
rp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
na
        -- Precede name with some path if it is null or contains a ':'
        protect :: t Char -> Bool
protect n :: t Char
n = t Char -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Char
n Bool -> Bool -> Bool
|| ':' Char -> t Char -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
n

{- relSegsFrom discards any common leading isegments from both paths,
then invokes difSegsFrom to calculate a relative path from the end
of the base path to the end of the target path.
The final name is handled separately, so this deals only with
"directory" segtments. -}
relSegsFrom :: String -> String -> String
relSegsFrom :: String -> ShowS
relSegsFrom [] [] = ""      -- paths are identical
relSegsFrom sabs :: String
sabs base :: String
base =
    if String
sa1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
sb1
        then String -> ShowS
relSegsFrom String
ra1 String
rb1
        else String -> ShowS
difSegsFrom String
sabs String
base
    where
        (sa1 :: String
sa1, ra1 :: String
ra1) = String -> (String, String)
nextSegment String
sabs
        (sb1 :: String
sb1, rb1 :: String
rb1) = String -> (String, String)
nextSegment String
base

{- difSegsFrom calculates a path difference from base to target,
not including the final name at the end of the path
(i.e. results always ends with '/')

This function operates under the invariant that the supplied
value of sabs is the desired path relative to the beginning of
base.  Thus, when base is empty, the desired path has been found. -}
difSegsFrom :: String -> String -> String
difSegsFrom :: String -> ShowS
difSegsFrom sabs :: String
sabs "" = String
sabs
difSegsFrom sabs :: String
sabs base :: String
base = String -> ShowS
difSegsFrom ("../" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sabs) ((String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
nextSegment String
base)

-- * Other normalization functions


{- | @expandIRI pm iri@ returns the expanded @iri@ with a declaration from @pm@.
If no declaration is found, return @iri@ unchanged. -}
expandIRI :: Map String IRI -> IRI -> IRI
expandIRI :: Map String IRI -> IRI -> IRI
expandIRI pm :: Map String IRI
pm iri :: IRI
iri = IRI -> Maybe IRI -> IRI
forall a. a -> Maybe a -> a
fromMaybe IRI
iri (Maybe IRI -> IRI) -> Maybe IRI -> IRI
forall a b. (a -> b) -> a -> b
$ Map String IRI -> IRI -> Maybe IRI
expandCurie Map String IRI
pm IRI
iri


{- | Same as @expandIRI@ but with a @Map String String@ as prefix map. See @expandCurie'@ for more details. -}
expandIRI' :: Map String String -> IRI -> IRI
expandIRI' :: Map String String -> IRI -> IRI
expandIRI' pm :: Map String String
pm iri :: IRI
iri = IRI -> Maybe IRI -> IRI
forall a. a -> Maybe a -> a
fromMaybe IRI
iri (Maybe IRI -> IRI) -> Maybe IRI -> IRI
forall a b. (a -> b) -> a -> b
$ Map String String -> IRI -> Maybe IRI
expandCurie' Map String String
pm IRI
iri

{- |Expands a CURIE to an IRI. @Nothing@ iff there is no IRI @i@ assigned
to the prefix of @c@ or the concatenation of @i@ and @iriPath c@
is not a valid IRI. -}
expandCurie :: Map String IRI -> IRI -> Maybe IRI
expandCurie :: Map String IRI -> IRI -> Maybe IRI
expandCurie pm :: Map String IRI
pm iri :: IRI
iri
    | IRI -> Bool
hasFullIRI IRI
iri = IRI -> Maybe IRI
forall a. a -> Maybe a
Just IRI
iri
    | IRI -> Bool
isAbbrev IRI
iri = do
        IRI
def <- String -> Map String IRI -> Maybe IRI
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (IRI -> String
prefixName IRI
iri) Map String IRI
pm
        let defS :: String
defS = ShowS -> IRI -> ShowS
iriToStringFull ShowS
forall a. a -> a
id (Bool -> IRI -> IRI
setAngles Bool
False IRI
def) ""
        IRI
expanded <- String -> Maybe IRI
parseIRI (String -> Maybe IRI) -> String -> Maybe IRI
forall a b. (a -> b) -> a -> b
$ String
defS String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> String
iFragment IRI
iri
        IRI -> Maybe IRI
forall (m :: * -> *) a. Monad m => a -> m a
return (IRI -> Maybe IRI) -> IRI -> Maybe IRI
forall a b. (a -> b) -> a -> b
$ IRI
expanded
            { iFragment :: String
iFragment = IRI -> String
iFragment IRI
iri
            , prefixName :: String
prefixName = IRI -> String
prefixName IRI
iri
            , isAbbrev :: Bool
isAbbrev = Bool
True }
    | Bool
otherwise = IRI -> Maybe IRI
forall a. a -> Maybe a
Just IRI
iri

{- | Same as @expandCurie@ but with @Map String String@ as prefix map.

If the prefixmap maps prefix names to the string representation of absolut iris,
expansion can be done more efficient than using @expandCurie@.
-}
expandCurie' :: Map String String -> IRI -> Maybe IRI
expandCurie' :: Map String String -> IRI -> Maybe IRI
expandCurie' pm :: Map String String
pm iri :: IRI
iri
    | IRI -> Bool
hasFullIRI IRI
iri = IRI -> Maybe IRI
forall a. a -> Maybe a
Just IRI
iri
    | IRI -> Bool
isAbbrev IRI
iri = do
        String
def <- String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (IRI -> String
prefixName IRI
iri) Map String String
pm
        -- remove surrounding angle brackets if needed
        let def' :: String
def' =
              if "<" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
def Bool -> Bool -> Bool
&& ">" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
def then
                ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
init ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
def
              else 
                String
def
        IRI
expanded <- String -> Maybe IRI
parseIRI (String -> Maybe IRI) -> String -> Maybe IRI
forall a b. (a -> b) -> a -> b
$ String
def' String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> String
iFragment IRI
iri
        IRI -> Maybe IRI
forall (m :: * -> *) a. Monad m => a -> m a
return (IRI -> Maybe IRI) -> IRI -> Maybe IRI
forall a b. (a -> b) -> a -> b
$ IRI
expanded
            { iFragment :: String
iFragment = IRI -> String
iFragment IRI
iri
            , prefixName :: String
prefixName = IRI -> String
prefixName IRI
iri
            , isAbbrev :: Bool
isAbbrev = Bool
True }
    | Bool
otherwise = IRI -> Maybe IRI
forall a. a -> Maybe a
Just IRI
iri

setAngles :: Bool -> IRI -> IRI
setAngles :: Bool -> IRI -> IRI
setAngles b :: Bool
b i :: IRI
i = IRI
i { hasAngles :: Bool
hasAngles = Bool
b }

{- |'mergeCurie' merges the CURIE @c@ into IRI @i@, appending their string
representations -}
mergeCurie :: IRI -> IRI -> Maybe IRI
mergeCurie :: IRI -> IRI -> Maybe IRI
mergeCurie c :: IRI
c i :: IRI
i =
  let s :: String
s = ShowS -> IRI -> ShowS
iriToStringFull ShowS
forall a. a -> a
id (Bool -> IRI -> IRI
setAngles Bool
False IRI
i) ""
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ IRI -> ShowS
iriToStringAbbrevMerge IRI
c ""
  in String -> Maybe IRI
parseIRICurie (String -> Maybe IRI) -> String -> Maybe IRI
forall a b. (a -> b) -> a -> b
$ if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ IRI -> String
iriScheme IRI
i then String
s else '<' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ ">"

deleteQuery :: IRI -> IRI
deleteQuery :: IRI -> IRI
deleteQuery i :: IRI
i = IRI
i { iriQuery :: String
iriQuery = "" }

{-| @addSuffixToIRI s iri@ adds a suffix @s@ to @iri@.

@s@ is added to the @iFragement@ if @iri@ is abbreviated.
@s@ is added to the query or the path of @iri@ if @iri@ contains an absolute IRI
  (either being an absolute IRI or being an expanded abbreviated IRI)
 -}
addSuffixToIRI :: String -> IRI -> IRI
addSuffixToIRI :: String -> IRI -> IRI
addSuffixToIRI s :: String
s i :: IRI
i =
  let abbr :: IRI -> IRI
abbr j :: IRI
j = IRI
j { iFragment :: String
iFragment = IRI -> String
iFragment IRI
j String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s }
      full :: IRI -> IRI
full j :: IRI
j = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ IRI -> String
iriQuery IRI
j then
          IRI
j { iriQuery :: String
iriQuery = IRI -> String
iriQuery IRI
j String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s }
        else  
          IRI
j { iriPath :: Id
iriPath  = Id -> Id -> Id
appendId (IRI -> Id
iriPath IRI
j) (String -> Id
stringToId String
s) }
  in
    case (IRI -> Bool
hasFullIRI IRI
i, IRI -> Bool
isAbbrev IRI
i) of
      (True, True) -> IRI -> IRI
full (IRI -> IRI) -> (IRI -> IRI) -> IRI -> IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRI -> IRI
abbr (IRI -> IRI) -> IRI -> IRI
forall a b. (a -> b) -> a -> b
$ IRI
i
      (True, False) -> IRI -> IRI
full IRI
i
      (False, True) -> IRI -> IRI
abbr IRI
i
      (False, False) -> IRI -> IRI
abbr IRI
i
      
    
      

-- | Extracts Id from URI
uriToCaslId :: IRI -> Id
uriToCaslId :: IRI -> Id
uriToCaslId urI :: IRI
urI = 
 let urS :: String
urS = IRI -> String
showIRI IRI
urI
     urS' :: String
urS' = (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 
            (\c :: Char
c ->  if Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
||
                       Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| 
                       Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'' Bool -> Bool -> Bool
||
                       Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_'
                   then [Char
c]
                   else "_u" ) String
urS
 in case String
urS' of
      x :: Char
x : t :: String
t -> 
         if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' then String -> Id
genName (String -> Id) -> String -> Id
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_') String
t
         else if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isAlpha Char
x then String -> Id
genName String
urS' 
              else String -> Id
stringToId String
urS'
      _ -> String -> Id
forall a. HasCallStack => String -> a
error "translating empty IRI" 
           -- should never happen