{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

#if (__GLASGOW_HASKELL__ >= 802)
{-# LANGUAGE DerivingStrategies #-}
#endif

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Turtle
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013, 2014, 2018, 2020, 2022 Douglas Burke
--  License     :  GPL V2
-- 
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  CPP, DerivingStrategies, OverloadedStrings
-- 
--  This Module implements a Turtle parser, returning a
--  new 'RDFGraph' consisting of triples and namespace information parsed from
--  the supplied input string, or an error indication.
-- 
-- REFERENCES:
-- 
--  - \"Turtle, Terse RDF Triple Language\",
--    W3C Candidate Recommendation 19 February 2013 (<http://www.w3.org/TR/2013/CR-turtle-20130219/L),
--    <http://www.w3.org/TR/turtle/>
-- 
-- NOTES:
-- 
--  - Prior to version @0.9.0.4@, the parser followed the
--    W3C Working Draft 09 August 2011 (<http://www.w3.org/TR/2011/WD-turtle-20110809/>)
-- 
--  - Strings with no language tag are converted to a 'LitTag' not a
--    'TypedLitTag' with a type of @xsd:string@ (e.g. see
--    <http://www.w3.org/TR/2011/WD-turtle-20110809/#terms>).
-- 
--  - If the URI is actually an IRI (Internationalized Resource Identifiers)
--    then the parser will fail since 'Network.URI.parseURI' fails.
-- 
--  - The current (August 2013) Turtle test suite from
--    <http://www.w3.org/2013/TurtleTests/> passes except for the four
--    tests with non-ASCII local names, namely:
--    @localName_with_assigned_nfc_bmp_PN_CHARS_BASE_character_boundaries@,
--    @localName_with_assigned_nfc_PN_CHARS_BASE_character_boundaries@,
--    @localName_with_nfc_PN_CHARS_BASE_character_boundaries@,
--    and
--    @localName_with_non_leading_extras@.
-- 
--------------------------------------------------------------------------------

-- TODO:
--   - should the productions moved to an Internal module for use by
--     others - e.g. Sparql or the N3 parser?

module Swish.RDF.Parser.Turtle
    ( ParseResult
    , parseTurtle      
    , parseTurtlefromText      
    )
where

import Swish.GraphClass (arc)
import Swish.Namespace (Namespace, ScopedName)
import Swish.Namespace (makeNamespace, getNamespaceTuple
                       , getScopeNamespace, getScopedNameURI
                       , getScopeNamespace, makeURIScopedName, makeNSScopedName)
import Swish.QName (newLName, emptyLName)

import Swish.RDF.Graph
    ( RDFGraph, RDFLabel(..)
    , NamespaceMap
    , addArc 
    , setNamespaces
    , emptyRDFGraph
    )

import Swish.RDF.Vocabulary
    ( LanguageTag
    , toLangTag
    , rdfType
    , rdfFirst, rdfRest, rdfNil
    , xsdBoolean, xsdInteger, xsdDecimal, xsdDouble
    , defaultBase
    )

import Swish.RDF.Datatype (makeDatatypedLiteral)

import Swish.RDF.Parser.Utils
    ( ParseResult
    , runParserWithError
    , ignore
    , noneOf
    , char
    , ichar
    , string
    , stringT
    , sepEndBy1
    , isymbol
    , lexeme
    , whiteSpace
    , hex4  
    , hex8  
    , appendURIs
    )

import Control.Applicative
import Control.Monad (foldM)

import Data.Char (chr, isAsciiLower, isAsciiUpper, isDigit, isHexDigit, ord, toLower)

#if MIN_VERSION_base(4, 7, 0)
import Data.Functor (($>))
#endif

import Data.Maybe (fromMaybe)
import Data.Word (Word32)

import Network.URI (URI(..), parseURIReference)

import Text.ParserCombinators.Poly.StateText

import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Lazy as L

#if !MIN_VERSION_base(4, 7, 0)
($>) :: Functor f => f a -> b -> f b
($>) = flip (<$)
#endif

----------------------------------------------------------------------
-- Define parser state and helper functions
----------------------------------------------------------------------

-- | Turtle parser state
data TurtleState = TurtleState
        { TurtleState -> RDFGraph
graphState :: RDFGraph            -- Graph under construction
        , TurtleState -> NamespaceMap
prefixUris :: NamespaceMap        -- namespace prefix mapping table
        , TurtleState -> URI
baseUri    :: URI                 -- base URI
        , TurtleState -> Word32
nodeGen    :: Word32              -- blank node id generator
        } deriving
#if (__GLASGOW_HASKELL__ >= 802)
    stock
#endif
    Int -> TurtleState -> ShowS
[TurtleState] -> ShowS
TurtleState -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TurtleState] -> ShowS
$cshowList :: [TurtleState] -> ShowS
show :: TurtleState -> [Char]
$cshow :: TurtleState -> [Char]
showsPrec :: Int -> TurtleState -> ShowS
$cshowsPrec :: Int -> TurtleState -> ShowS
Show

-- | Functions to update TurtleState vector (use with stUpdate)

setPrefix :: Maybe T.Text -> URI -> TurtleState -> TurtleState
setPrefix :: Maybe Text -> URI -> TurtleState -> TurtleState
setPrefix Maybe Text
pre URI
uri TurtleState
st =  TurtleState
st { prefixUris :: NamespaceMap
prefixUris=NamespaceMap
p' }
    where
        p' :: NamespaceMap
p' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Maybe Text
pre URI
uri (TurtleState -> NamespaceMap
prefixUris TurtleState
st)

-- | Change the base
setBase :: URI -> TurtleState -> TurtleState
setBase :: URI -> TurtleState -> TurtleState
setBase URI
buri TurtleState
st = TurtleState
st { baseUri :: URI
baseUri = URI
buri }

--  Functions to access state:

-- | Return the default prefix
getDefaultPrefix :: TurtleParser Namespace
getDefaultPrefix :: TurtleParser Namespace
getDefaultPrefix = do
  TurtleState
s <- forall s. Parser s s
stGet
  case TurtleState -> Maybe Text -> Maybe URI
getPrefixURI TurtleState
s forall a. Maybe a
Nothing of
    Just URI
uri -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Text -> URI -> Namespace
makeNamespace forall a. Maybe a
Nothing URI
uri
    Maybe URI
_ -> forall (p :: * -> *) a. PolyParse p => [Char] -> p a
failBad [Char]
"No default prefix defined; how unexpected (probably a programming error)!"

--  Map prefix to URI (naming needs a scrub here)
getPrefixURI :: TurtleState -> Maybe T.Text -> Maybe URI
getPrefixURI :: TurtleState -> Maybe Text -> Maybe URI
getPrefixURI TurtleState
st Maybe Text
pre = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Maybe Text
pre (TurtleState -> NamespaceMap
prefixUris TurtleState
st)

findPrefixNamespace :: Maybe L.Text -> TurtleParser Namespace
findPrefixNamespace :: Maybe Text -> TurtleParser Namespace
findPrefixNamespace (Just Text
p) = Text -> TurtleParser Namespace
findPrefix (Text -> Text
L.toStrict Text
p)
findPrefixNamespace Maybe Text
Nothing  = TurtleParser Namespace
getDefaultPrefix

--  Return function to update graph in Turtle parser state,
--  using the supplied function of a graph
--
updateGraph :: (RDFGraph -> RDFGraph) -> TurtleState -> TurtleState
updateGraph :: (RDFGraph -> RDFGraph) -> TurtleState -> TurtleState
updateGraph RDFGraph -> RDFGraph
f TurtleState
s = TurtleState
s { graphState :: RDFGraph
graphState = RDFGraph -> RDFGraph
f (TurtleState -> RDFGraph
graphState TurtleState
s) }

----------------------------------------------------------------------
--  Define top-level parser function:
--  accepts a string and returns a graph or error
----------------------------------------------------------------------

type TurtleParser a = Parser TurtleState a

-- | Parse as Turtle (with no real base URI).
-- 
-- See 'parseTurtle' if you need to provide a base URI.
--
parseTurtlefromText ::
  L.Text -- ^ input in N3 format.
  -> ParseResult
parseTurtlefromText :: Text -> ParseResult
parseTurtlefromText = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Maybe URI -> ParseResult
parseTurtle forall a. Maybe a
Nothing

-- | Parse a string with an optional base URI.
--            
-- Unlike 'parseN3' we treat the base URI as a URI and not
-- a QName.
--
parseTurtle ::
  L.Text -- ^ input in N3 format.
  -> Maybe URI -- ^ optional base URI
  -> ParseResult
parseTurtle :: Text -> Maybe URI -> ParseResult
parseTurtle Text
txt Maybe URI
mbase = forall a. TurtleParser a -> Maybe URI -> Text -> Either [Char] a
parseAnyfromText TurtleParser RDFGraph
turtleDoc Maybe URI
mbase Text
txt

{-
hashURI :: URI
hashURI = fromJust $ parseURIReference "#"
-}

-- | The W3C turtle tests - e.g. <http://www.w3.org/2013/TurtleTests/turtle-syntax-bad-prefix-01.ttl> -
-- point out there's no default prefix mapping.
--
emptyState :: 
  Maybe URI  -- ^ starting base for the graph
  -> TurtleState
emptyState :: Maybe URI -> TurtleState
emptyState Maybe URI
mbase = 
  let pmap :: Map k a
pmap   = forall k a. Map k a
M.empty -- M.singleton Nothing hashURI
      buri :: URI
buri   = forall a. a -> Maybe a -> a
fromMaybe (ScopedName -> URI
getScopedNameURI ScopedName
defaultBase) Maybe URI
mbase
  in TurtleState
     { graphState :: RDFGraph
graphState = RDFGraph
emptyRDFGraph
     , prefixUris :: NamespaceMap
prefixUris = forall k a. Map k a
pmap
     , baseUri :: URI
baseUri    = URI
buri
     , nodeGen :: Word32
nodeGen    = Word32
0
     }
  
-- | Function to supply initial context and parse supplied term.
--
parseAnyfromText :: 
  TurtleParser a  -- ^ parser to apply
  -> Maybe URI    -- ^ base URI of the input, or @Nothing@ to use default base value
  -> L.Text       -- ^ input to be parsed
  -> Either String a
parseAnyfromText :: forall a. TurtleParser a -> Maybe URI -> Text -> Either [Char] a
parseAnyfromText TurtleParser a
parser Maybe URI
mbase = forall a b. Parser a b -> a -> Text -> Either [Char] b
runParserWithError TurtleParser a
parser (Maybe URI -> TurtleState
emptyState Maybe URI
mbase)

newBlankNode :: TurtleParser RDFLabel
newBlankNode :: TurtleParser RDFLabel
newBlankNode = do
  Word32
n <- forall s a. (s -> a) -> Parser s a
stQuery (forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtleState -> Word32
nodeGen)
  forall s. (s -> s) -> Parser s ()
stUpdate forall a b. (a -> b) -> a -> b
$ \TurtleState
s -> TurtleState
s { nodeGen :: Word32
nodeGen = Word32
n }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> RDFLabel
Blank (forall a. Show a => a -> [Char]
show Word32
n)
  
{-
This has been made tricky by the attempt to remove the default list
of prefixes from the starting point of a parse and the subsequent
attempt to add every new namespace we come across to the parser state.

So we add in the original default namespaces for testing, since
this routine is really for testing.

addTestPrefixes :: TurtleParser ()
addTestPrefixes = stUpdate $ \st -> st { prefixUris = LookupMap prefixTable } -- should append to existing map

-}

-- helper routines

comma, semiColon , fullStop :: TurtleParser ()
comma :: Parser TurtleState ()
comma = forall s. [Char] -> Parser s ()
isymbol [Char]
","
semiColon :: Parser TurtleState ()
semiColon = forall s. [Char] -> Parser s ()
isymbol [Char]
";"
fullStop :: Parser TurtleState ()
fullStop = forall s. [Char] -> Parser s ()
isymbol [Char]
"."

sQuot, dQuot, sQuot3, dQuot3 :: TurtleParser ()
sQuot :: Parser TurtleState ()
sQuot = forall s. Char -> Parser s ()
ichar Char
'\''
dQuot :: Parser TurtleState ()
dQuot = forall s. Char -> Parser s ()
ichar Char
'"'
sQuot3 :: Parser TurtleState ()
sQuot3 = forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore forall a b. (a -> b) -> a -> b
$ forall s. [Char] -> Parser s [Char]
string [Char]
"'''"
dQuot3 :: Parser TurtleState ()
dQuot3 = forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore forall a b. (a -> b) -> a -> b
$ forall s. [Char] -> Parser s [Char]
string [Char]
"\"\"\""

match :: (Ord a) => a -> [(a,a)] -> Bool
match :: forall a. Ord a => a -> [(a, a)] -> Bool
match a
v = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(a
l,a
h) -> a
v forall a. Ord a => a -> a -> Bool
>= a
l Bool -> Bool -> Bool
&& a
v forall a. Ord a => a -> a -> Bool
<= a
h)

-- a specialization of bracket that ensures white space after
-- the bracket symbol is parsed.
br :: Char -> Char -> TurtleParser a -> TurtleParser a
br :: forall a. Char -> Char -> TurtleParser a -> TurtleParser a
br Char
lsym Char
rsym =
  let f :: Char -> Parser s Char
f = forall s a. Parser s a -> Parser s a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Char -> Parser s Char
char
  in forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (forall s. Char -> Parser s Char
f Char
lsym) (forall s. Char -> Parser s Char
f Char
rsym)

-- this is a lot simpler than N3
atWord :: T.Text -> TurtleParser ()
atWord :: Text -> Parser TurtleState ()
atWord Text
s = (forall s. Char -> Parser s Char
char Char
'@' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s a. Parser s a -> Parser s a
lexeme (forall s. Text -> Parser s Text
stringT Text
s)) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

-- | Case insensitive match.
charI ::
  Char  -- ^ must be upper case
  -> TurtleParser Char
charI :: Char -> TurtleParser Char
charI Char
c = forall s. (Char -> Bool) -> Parser s Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Char
c forall a. a -> [a] -> [a]
: [ Char -> Char
toLower Char
c ])

-- | Case insensitive match.
stringI ::
  String  -- ^ must be upper case
  -> TurtleParser String
stringI :: [Char] -> TurtleParser [Char]
stringI = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> TurtleParser Char
charI

{-
Add statement to graph in the parser state; there is a special case
for the special-case literals in the grammar since we need to ensure
the necessary namespaces (in other words xsd) are added to the
namespace store.
-}

addStatement :: RDFLabel -> RDFLabel -> RDFLabel -> TurtleParser ()
addStatement :: RDFLabel -> RDFLabel -> RDFLabel -> Parser TurtleState ()
addStatement RDFLabel
s RDFLabel
p o :: RDFLabel
o@(TypedLit Text
_ ScopedName
dtype) | ScopedName
dtype forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScopedName
xsdBoolean, ScopedName
xsdInteger, ScopedName
xsdDecimal, ScopedName
xsdDouble] = do 
  TurtleState
ost <- forall s. Parser s s
stGet
  let stmt :: Arc RDFLabel
stmt = forall lb. lb -> lb -> lb -> Arc lb
arc RDFLabel
s RDFLabel
p RDFLabel
o
      oldp :: NamespaceMap
oldp = TurtleState -> NamespaceMap
prefixUris TurtleState
ost
      ogs :: RDFGraph
ogs = TurtleState -> RDFGraph
graphState TurtleState
ost
      (Maybe Text
nspre, URI
nsuri) = Namespace -> (Maybe Text, URI)
getNamespaceTuple forall a b. (a -> b) -> a -> b
$ ScopedName -> Namespace
getScopeNamespace ScopedName
dtype
      newp :: NamespaceMap
newp = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Maybe Text
nspre URI
nsuri NamespaceMap
oldp
  forall s. (s -> s) -> Parser s ()
stUpdate forall a b. (a -> b) -> a -> b
$ \TurtleState
st -> TurtleState
st { prefixUris :: NamespaceMap
prefixUris = NamespaceMap
newp, graphState :: RDFGraph
graphState = forall lb. Label lb => Arc lb -> NSGraph lb -> NSGraph lb
addArc Arc RDFLabel
stmt RDFGraph
ogs }
addStatement RDFLabel
s RDFLabel
p RDFLabel
o = forall s. (s -> s) -> Parser s ()
stUpdate ((RDFGraph -> RDFGraph) -> TurtleState -> TurtleState
updateGraph (forall lb. Label lb => Arc lb -> NSGraph lb -> NSGraph lb
addArc (forall lb. lb -> lb -> lb -> Arc lb
arc RDFLabel
s RDFLabel
p RDFLabel
o) ))

isaz, isAZ, isaZ, is09, isaZ09 :: Char -> Bool
isaz :: Char -> Bool
isaz = Char -> Bool
isAsciiLower
isAZ :: Char -> Bool
isAZ = Char -> Bool
isAsciiUpper
isaZ :: Char -> Bool
isaZ Char
c = Char -> Bool
isaz Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAZ Char
c
is09 :: Char -> Bool
is09 = Char -> Bool
isDigit
isaZ09 :: Char -> Bool
isaZ09 Char
c = Char -> Bool
isaZ Char
c Bool -> Bool -> Bool
|| Char -> Bool
is09 Char
c

{-
Since operatorLabel can be used to add a label with an 
unknown namespace, we need to ensure that the namespace
is added if not known. If the namespace prefix is already
in use then it is over-written (rather than add a new
prefix for the label).

TODO:
  - could we use the reverse lookupmap functionality to
    find if the given namespace URI is in the namespace
    list? If it is, use it's key otherwise do a
    mapReplace for the input namespace (updated to use the
    Data.Map.Map representation).
    
-}
operatorLabel :: ScopedName -> TurtleParser RDFLabel
operatorLabel :: ScopedName -> TurtleParser RDFLabel
operatorLabel ScopedName
snam = do
  TurtleState
st <- forall s. Parser s s
stGet
  let (Maybe Text
pkey, URI
pval) = Namespace -> (Maybe Text, URI)
getNamespaceTuple forall a b. (a -> b) -> a -> b
$ ScopedName -> Namespace
getScopeNamespace ScopedName
snam
      opmap :: NamespaceMap
opmap = TurtleState -> NamespaceMap
prefixUris TurtleState
st
      
      rval :: RDFLabel
rval = ScopedName -> RDFLabel
Res ScopedName
snam
      
  -- TODO: the lookup and the replacement could be fused; it may not
  --       even make sense to separate now using a Map
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Maybe Text
pkey NamespaceMap
opmap of
    Just URI
val | URI
val forall a. Eq a => a -> a -> Bool
== URI
pval -> forall (m :: * -> *) a. Monad m => a -> m a
return RDFLabel
rval
             | Bool
otherwise   -> do
               forall s. (s -> s) -> Parser s ()
stUpdate forall a b. (a -> b) -> a -> b
$ \TurtleState
s -> TurtleState
s { prefixUris :: NamespaceMap
prefixUris = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Maybe Text
pkey URI
pval NamespaceMap
opmap }
               forall (m :: * -> *) a. Monad m => a -> m a
return RDFLabel
rval
    
    Maybe URI
_ -> do
      forall s. (s -> s) -> Parser s ()
stUpdate forall a b. (a -> b) -> a -> b
$ \TurtleState
s -> TurtleState
s { prefixUris :: NamespaceMap
prefixUris = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Maybe Text
pkey URI
pval NamespaceMap
opmap }
      forall (m :: * -> *) a. Monad m => a -> m a
return RDFLabel
rval
        
findPrefix :: T.Text -> TurtleParser Namespace
findPrefix :: Text -> TurtleParser Namespace
findPrefix Text
pre = do
  TurtleState
st <- forall s. Parser s s
stGet
  case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. a -> Maybe a
Just Text
pre) (TurtleState -> NamespaceMap
prefixUris TurtleState
st) of
    Just URI
uri -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Text -> URI -> Namespace
makeNamespace (forall a. a -> Maybe a
Just Text
pre) URI
uri
    Maybe URI
Nothing  -> forall (p :: * -> *) a. PolyParse p => [Char] -> p a
failBad forall a b. (a -> b) -> a -> b
$ [Char]
"Undefined prefix '" forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
pre forall a. [a] -> [a] -> [a]
++ [Char]
":'."

-- | Add the message to the start of the error message if the
--   parser fails (a minor specialization of 'adjustErr').

{-
addErr :: Parser s a -> String -> Parser s a
addErr p m = adjustErr p (m++)
-}

(<?) ::
  Parser s a
  -> String -- ^ Error message to add (a new line is added after the message)
  -> Parser s a
<? :: forall s a. Parser s a -> [Char] -> Parser s a
(<?) Parser s a
p [Char]
m = forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
adjustErr Parser s a
p (([Char]
m forall a. [a] -> [a] -> [a]
++ [Char]
"\n") forall a. [a] -> [a] -> [a]
++)

-- Applicative's <* et al are infixl 4, with <|> infixl 3
infixl 4 <?

{-

Syntax productions; the Turtle ENBF grammar elements are from
http://www.w3.org/TR/2013/CR-turtle-20130219/#sec-grammar-grammar

The element names are converted to match Haskell syntax
and idioms where possible:

  - camel Case rather than underscores and all upper case

  - upper-case identifiers prepended by _ after above form

-}
{-
[1]	turtleDoc	::=	statement*
-}
turtleDoc :: TurtleParser RDFGraph
turtleDoc :: TurtleParser RDFGraph
turtleDoc = TurtleState -> RDFGraph
mkGr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. Parser s ()
whiteSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TurtleState ()
statement forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s. Parser s ()
eof forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s. Parser s s
stGet)
  where
    mkGr :: TurtleState -> RDFGraph
mkGr TurtleState
s = forall lb. NamespaceMap -> NSGraph lb -> NSGraph lb
setNamespaces (TurtleState -> NamespaceMap
prefixUris TurtleState
s) (TurtleState -> RDFGraph
graphState TurtleState
s)

{-
[2]	statement	::=	directive | triples '.'
-}
statement :: TurtleParser ()
statement :: Parser TurtleState ()
statement = Parser TurtleState ()
directive forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser TurtleState ()
triples forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (p :: * -> *) a. Commitment p => p a -> p a
commit Parser TurtleState ()
fullStop forall s a. Parser s a -> [Char] -> Parser s a
<? [Char]
"Missing '.' after a statement.")

{-
[3]	directive	::=	prefixID | base | sparqlPrefix | sparqlBase

With the addition of sparqlPrefix/sparqlBase (so '.' handling moved
into prefixID/base) may need to adjust use of lexeme.
-}
directive :: TurtleParser ()
directive :: Parser TurtleState ()
directive =
  forall s a. Parser s a -> Parser s a
lexeme
  (Parser TurtleState ()
prefixID forall s a. Parser s a -> [Char] -> Parser s a
<? [Char]
"Unable to parse @prefix statement."
   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TurtleState ()
base forall s a. Parser s a -> [Char] -> Parser s a
<? [Char]
"Unable to parse @base statement."
   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TurtleState ()
sparqlPrefix forall s a. Parser s a -> [Char] -> Parser s a
<? [Char]
"Unable to parse Sparql PREFIX statement."
   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TurtleState ()
sparqlBase forall s a. Parser s a -> [Char] -> Parser s a
<? [Char]
"Unable to parse Sparql BASE statement.")

{-
[4]	prefixID	::=	'@prefix' PNAME_NS IRIREF '.'
-}
prefixID :: TurtleParser ()
prefixID :: Parser TurtleState ()
prefixID = do
  Text -> Parser TurtleState ()
atWord Text
"prefix"
  Maybe Text
p <- forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ forall s a. Parser s a -> Parser s a
lexeme Parser TurtleState (Maybe Text)
_pnameNS
  URI
u <- forall s a. Parser s a -> Parser s a
lexeme TurtleParser URI
_iriRef
  Parser TurtleState ()
fullStop
  forall s. (s -> s) -> Parser s ()
stUpdate forall a b. (a -> b) -> a -> b
$ Maybe Text -> URI -> TurtleState -> TurtleState
setPrefix (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
L.toStrict Maybe Text
p) URI
u

{-
[5]	base	::=	'@base' IRIREF '.'
-}
base :: TurtleParser ()
base :: Parser TurtleState ()
base = do
  Text -> Parser TurtleState ()
atWord Text
"base"
  URI
b <- forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ forall s a. Parser s a -> Parser s a
lexeme TurtleParser URI
_iriRef
  Parser TurtleState ()
fullStop
  forall s. (s -> s) -> Parser s ()
stUpdate forall a b. (a -> b) -> a -> b
$ URI -> TurtleState -> TurtleState
setBase URI
b

{-
[5s]	sparqlBase	::=	"BASE" IRIREF
-}
sparqlBase :: TurtleParser ()
sparqlBase :: Parser TurtleState ()
sparqlBase = forall s a. Parser s a -> Parser s a
lexeme ([Char] -> TurtleParser [Char]
stringI [Char]
"BASE") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (p :: * -> *) a. Commitment p => p a -> p a
commit TurtleParser URI
_iriRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. (s -> s) -> Parser s ()
stUpdate forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> TurtleState -> TurtleState
setBase

{-
[6s]	sparqlPrefix	::=	"PREFIX" PNAME_NS IRIREF
-}
sparqlPrefix :: TurtleParser ()
sparqlPrefix :: Parser TurtleState ()
sparqlPrefix = do
  forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore forall a b. (a -> b) -> a -> b
$ forall s a. Parser s a -> Parser s a
lexeme forall a b. (a -> b) -> a -> b
$ [Char] -> TurtleParser [Char]
stringI [Char]
"PREFIX"
  Maybe Text
p <- forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ forall s a. Parser s a -> Parser s a
lexeme Parser TurtleState (Maybe Text)
_pnameNS
  URI
u <- forall s a. Parser s a -> Parser s a
lexeme TurtleParser URI
_iriRef
  forall s. (s -> s) -> Parser s ()
stUpdate forall a b. (a -> b) -> a -> b
$ Maybe Text -> URI -> TurtleState -> TurtleState
setPrefix (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
L.toStrict Maybe Text
p) URI
u

{-
[6]	triples	::=	subject predicateObjectList | blankNodePropertyList predicateObjectList?
-}

triples :: TurtleParser ()
triples :: Parser TurtleState ()
triples =
  (TurtleParser RDFLabel
subject forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RDFLabel -> Parser TurtleState ()
predicateObjectList)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (TurtleParser RDFLabel
blankNodePropertyList forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDFLabel -> Parser TurtleState ()
predicateObjectList)

{-
[7]	predicateObjectList	::=	verb objectList (';' (verb objectList)?)*
-}

predicateObjectList :: RDFLabel -> TurtleParser ()
predicateObjectList :: RDFLabel -> Parser TurtleState ()
predicateObjectList RDFLabel
subj = 
  let term :: Parser TurtleState ()
term = TurtleParser RDFLabel
verb forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RDFLabel -> RDFLabel -> Parser TurtleState ()
objectList RDFLabel
subj
  in forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore forall a b. (a -> b) -> a -> b
$ forall s a b. Parser s a -> Parser s b -> Parser s [a]
sepEndBy1 Parser TurtleState ()
term (forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 Parser TurtleState ()
semiColon)

{-
[8]	objectList	::=	object (',' object)*
-}

objectList :: RDFLabel -> RDFLabel -> TurtleParser ()
objectList :: RDFLabel -> RDFLabel -> Parser TurtleState ()
objectList RDFLabel
subj RDFLabel
prd = forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 TurtleParser RDFLabel
object Parser TurtleState ()
comma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RDFLabel -> RDFLabel -> RDFLabel -> Parser TurtleState ()
addStatement RDFLabel
subj RDFLabel
prd)

{-
[9]	verb	::=	predicate | 'a'
-}

verb :: TurtleParser RDFLabel
verb :: TurtleParser RDFLabel
verb = TurtleParser RDFLabel
predicate forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall s a. Parser s a -> Parser s a
lexeme (forall s. Char -> Parser s Char
char Char
'a') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ScopedName -> TurtleParser RDFLabel
operatorLabel ScopedName
rdfType)
   
{-       
[10]	subject	::=	iri | BlankNode | collection
-}

subject :: TurtleParser RDFLabel
subject :: TurtleParser RDFLabel
subject = (ScopedName -> RDFLabel
Res forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser ScopedName
iri) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
blankNode forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
collection

{-
[11]	predicate	::=	iri
-}

predicate :: TurtleParser RDFLabel
predicate :: TurtleParser RDFLabel
predicate = ScopedName -> RDFLabel
Res forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser ScopedName
iri

{-
[12]	object	::=	iri | BlankNode | collection | blankNodePropertyList | literal
-}

object :: TurtleParser RDFLabel
object :: TurtleParser RDFLabel
object = (ScopedName -> RDFLabel
Res forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser ScopedName
iri) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
blankNode forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
collection forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         TurtleParser RDFLabel
blankNodePropertyList forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
literal

{-
[13]	literal	::=	RDFLiteral | NumericLiteral | BooleanLiteral
-}

literal :: TurtleParser RDFLabel
literal :: TurtleParser RDFLabel
literal = forall s a. Parser s a -> Parser s a
lexeme forall a b. (a -> b) -> a -> b
$ TurtleParser RDFLabel
rdfLiteral forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
numericLiteral forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
booleanLiteral

{-
[14]	blankNodePropertyList	::=	'[' predicateObjectList ']'
-}

blankNodePropertyList :: TurtleParser RDFLabel
blankNodePropertyList :: TurtleParser RDFLabel
blankNodePropertyList = do
  RDFLabel
bNode <- TurtleParser RDFLabel
newBlankNode
  forall a. Char -> Char -> TurtleParser a -> TurtleParser a
br Char
'[' Char
']' forall a b. (a -> b) -> a -> b
$ forall s a. Parser s a -> Parser s a
lexeme (RDFLabel -> Parser TurtleState ()
predicateObjectList RDFLabel
bNode)
  forall (m :: * -> *) a. Monad m => a -> m a
return RDFLabel
bNode

{-
[15]	collection	::=	'(' object* ')'
-}
collection :: TurtleParser RDFLabel
collection :: TurtleParser RDFLabel
collection = do
  [RDFLabel]
os <- forall a. Char -> Char -> TurtleParser a -> TurtleParser a
br Char
'(' Char
')' forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
many TurtleParser RDFLabel
object
  RDFLabel
eNode <- ScopedName -> TurtleParser RDFLabel
operatorLabel ScopedName
rdfNil
  case [RDFLabel]
os of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return RDFLabel
eNode
    
    (RDFLabel
x:[RDFLabel]
xs) -> do
      RDFLabel
sNode <- TurtleParser RDFLabel
newBlankNode
      RDFLabel
first <- ScopedName -> TurtleParser RDFLabel
operatorLabel ScopedName
rdfFirst
      RDFLabel -> RDFLabel -> RDFLabel -> Parser TurtleState ()
addStatement RDFLabel
sNode RDFLabel
first RDFLabel
x
      RDFLabel
lNode <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM RDFLabel -> RDFLabel -> TurtleParser RDFLabel
addElem RDFLabel
sNode [RDFLabel]
xs
      RDFLabel
rest <- ScopedName -> TurtleParser RDFLabel
operatorLabel ScopedName
rdfRest
      RDFLabel -> RDFLabel -> RDFLabel -> Parser TurtleState ()
addStatement RDFLabel
lNode RDFLabel
rest RDFLabel
eNode
      forall (m :: * -> *) a. Monad m => a -> m a
return RDFLabel
sNode

    where      
      addElem :: RDFLabel -> RDFLabel -> TurtleParser RDFLabel
addElem RDFLabel
prevNode RDFLabel
curElem = do
        RDFLabel
bNode <- TurtleParser RDFLabel
newBlankNode
        RDFLabel
first <- ScopedName -> TurtleParser RDFLabel
operatorLabel ScopedName
rdfFirst
        RDFLabel
rest <- ScopedName -> TurtleParser RDFLabel
operatorLabel ScopedName
rdfRest
        RDFLabel -> RDFLabel -> RDFLabel -> Parser TurtleState ()
addStatement RDFLabel
prevNode RDFLabel
rest RDFLabel
bNode
        RDFLabel -> RDFLabel -> RDFLabel -> Parser TurtleState ()
addStatement RDFLabel
bNode RDFLabel
first RDFLabel
curElem
        forall (m :: * -> *) a. Monad m => a -> m a
return RDFLabel
bNode

{-
[16]	NumericLiteral	::=	INTEGER | DECIMAL | DOUBLE

NOTE: We swap the order from this production

I have removed the conversion to a canonical form for
the double production, since it makes running the W3C
tests for Turtle harder (since it assumes that "1E0"
is passed through as is). It is also funny to
create a "canonical" form for only certain data types.
-}
numericLiteral :: TurtleParser RDFLabel
numericLiteral :: TurtleParser RDFLabel
numericLiteral =
  let f :: ScopedName -> Text -> RDFLabel
f ScopedName
t Text
v = ScopedName -> Text -> RDFLabel
makeDatatypedLiteral ScopedName
t (Text -> Text
L.toStrict Text
v)
  in (ScopedName -> Text -> RDFLabel
f ScopedName
xsdDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser Text
_double)
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     (ScopedName -> Text -> RDFLabel
f ScopedName
xsdDecimal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser Text
_decimal)
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     (ScopedName -> Text -> RDFLabel
f ScopedName
xsdInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser Text
_integer)

{-
[128s]	RDFLiteral	::=	String (LANGTAG | '^^' iri)?

TODO: remove 'Lit lbl' form, since dtype=xsd:string in this case.
-}
rdfLiteral :: TurtleParser RDFLabel
rdfLiteral :: TurtleParser RDFLabel
rdfLiteral = do
  Text
lbl <- Text -> Text
L.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser Text
turtleString
  Maybe (Either LanguageTag ScopedName)
opt <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser TurtleState LanguageTag
_langTag forall s a. Parser s a -> [Char] -> Parser s a
<? [Char]
"Unable to parse the language tag"))
                   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                   (forall s. [Char] -> Parser s [Char]
string [Char]
"^^" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (p :: * -> *) a. Commitment p => p a -> p a
commit TurtleParser ScopedName
iri forall s a. Parser s a -> [Char] -> Parser s a
<? [Char]
"Unable to parse the datatype of the literal"))))
  forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall s. Parser s ()
whiteSpace
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (Either LanguageTag ScopedName)
opt of
             Just (Left LanguageTag
lcode)  -> Text -> LanguageTag -> RDFLabel
LangLit Text
lbl LanguageTag
lcode
             Just (Right ScopedName
dtype) -> Text -> ScopedName -> RDFLabel
TypedLit Text
lbl ScopedName
dtype
             Maybe (Either LanguageTag ScopedName)
_                  -> Text -> RDFLabel
Lit Text
lbl

{-
[133s]	BooleanLiteral	::=	'true' | 'false'
-}
booleanLiteral :: TurtleParser RDFLabel
booleanLiteral :: TurtleParser RDFLabel
booleanLiteral = ScopedName -> Text -> RDFLabel
makeDatatypedLiteral ScopedName
xsdBoolean forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Parser s a -> Parser s a
lexeme (forall s. [Char] -> Parser s [Char]
string [Char]
"true" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. [Char] -> Parser s [Char]
string [Char]
"false")

{-
[17]	String	::=	STRING_LITERAL_QUOTE | STRING_LITERAL_SINGLE_QUOTE | STRING_LITERAL_LONG_SINGLE_QUOTE | STRING_LITERAL_LONG_QUOTE
-}
turtleString :: TurtleParser L.Text
turtleString :: TurtleParser Text
turtleString = 
  forall s a. Parser s a -> Parser s a
lexeme (
    TurtleParser Text
_stringLiteralLongQuote forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser Text
_stringLiteralQuote forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    TurtleParser Text
_stringLiteralLongSingleQuote forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser Text
_stringLiteralSingleQuote
    ) forall s a. Parser s a -> [Char] -> Parser s a
<? [Char]
"Unable to parse a string literal"

{-
[135s]	iri	::=	IRIREF | PrefixedName
-}
iri :: TurtleParser ScopedName
iri :: TurtleParser ScopedName
iri = forall s a. Parser s a -> Parser s a
lexeme (
  (URI -> ScopedName
makeURIScopedName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser URI
_iriRef)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  TurtleParser ScopedName
prefixedName)

{-
[136s]	PrefixedName	::=	PNAME_LN | PNAME_NS
-}
prefixedName :: TurtleParser ScopedName
prefixedName :: TurtleParser ScopedName
prefixedName = 
  TurtleParser ScopedName
_pnameLN forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
  forall a b c. (a -> b -> c) -> b -> a -> c
flip Namespace -> LName -> ScopedName
makeNSScopedName LName
emptyLName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser TurtleState (Maybe Text)
_pnameNS forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text -> TurtleParser Namespace
findPrefixNamespace)

{-
[137s]	BlankNode	::=	BLANK_NODE_LABEL | ANON
-}
blankNode :: TurtleParser RDFLabel
blankNode :: TurtleParser RDFLabel
blankNode = forall s a. Parser s a -> Parser s a
lexeme (TurtleParser RDFLabel
_blankNodeLabel forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
_anon)

{--- Productions for terminals ---}

{-
[18]	IRIREF	::=	'<' ([^#x00-#x20<>\"{}|^`\] | UCHAR)* '>'
-}
_iriRef :: TurtleParser URI
_iriRef :: TurtleParser URI
_iriRef = do
  -- ignore $ char '<'
  -- why a, I using manyFinally' here? '>' shouldn't overlap
  -- with iriRefChar.
  -- ustr <- manyFinally' iriRefChar (char '>')
  [Char]
ustr <- forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (forall s. Char -> Parser s Char
char Char
'<') (forall (p :: * -> *) a. Commitment p => p a -> p a
commit (forall s. Char -> Parser s Char
char Char
'>')) (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many TurtleParser Char
iriRefChar)
  case [Char] -> Maybe URI
parseURIReference [Char]
ustr of
    Maybe URI
Nothing -> forall (p :: * -> *) a. PolyParse p => [Char] -> p a
failBad forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid URI: <" forall a. [a] -> [a] -> [a]
++ [Char]
ustr forall a. [a] -> [a] -> [a]
++ [Char]
">"
    Just URI
uref -> do
      TurtleState
s <- forall s. Parser s s
stGet
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ URI -> URI -> Either [Char] URI
appendURIs (TurtleState -> URI
baseUri TurtleState
s) URI
uref

iriRefChar :: TurtleParser Char
iriRefChar :: TurtleParser Char
iriRefChar = forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
isIRIChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser Char
_uchar

isIRIChar :: Char -> Bool
isIRIChar :: Char -> Bool
isIRIChar Char
c =
  Char
c forall a. Ord a => a -> a -> Bool
> Int -> Char
chr Int
0x20
  Bool -> Bool -> Bool
&& 
  Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ([Char]
"<>\"{}|^`\\"::String)

{-
[139s]	PNAME_NS	::=	PN_PREFIX? ':'
-}
_pnameNS :: TurtleParser (Maybe L.Text)
_pnameNS :: Parser TurtleState (Maybe Text)
_pnameNS = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional TurtleParser Text
_pnPrefix forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s. Char -> Parser s Char
char Char
':'

{-
[140s]	PNAME_LN	::=	PNAME_NS PN_LOCAL
-}
_pnameLN :: TurtleParser ScopedName
_pnameLN :: TurtleParser ScopedName
_pnameLN = do
  Namespace
ns <- Parser TurtleState (Maybe Text)
_pnameNS forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text -> TurtleParser Namespace
findPrefixNamespace
  Text
l <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
L.toStrict TurtleParser Text
_pnLocal
  case Text -> Maybe LName
newLName Text
l of
    Just LName
lname -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Namespace -> LName -> ScopedName
makeNSScopedName Namespace
ns LName
lname
    Maybe LName
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid local name: '" forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
l forall a. [a] -> [a] -> [a]
++ [Char]
"'"

{-
[141s]	BLANK_NODE_LABEL	::=	'_:' (PN_CHARS_U | [0-9]) ((PN_CHARS | '.')* PN_CHARS)?
-}
_blankNodeLabel :: TurtleParser RDFLabel
_blankNodeLabel :: TurtleParser RDFLabel
_blankNodeLabel = do
  forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore forall a b. (a -> b) -> a -> b
$ forall s. [Char] -> Parser s [Char]
string [Char]
"_:"
  Char
fChar <- TurtleParser Char
_pnCharsU forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
is09
  Text
rest <- TurtleParser Text
_pnRest
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> RDFLabel
Blank forall a b. (a -> b) -> a -> b
$ Char
fChar forall a. a -> [a] -> [a]
: Text -> [Char]
L.unpack Text
rest

{-
Extracted from BLANK_NODE_LABEL and PN_PREFIX

<PN_REST> :== ( ( PN_CHARS | '.' )* PN_CHARS )?

We assume below that the match is only ever done for small strings, so
the cost isn't likely to be large. Let's see how well this assumption
holds up.

-}

_pnRest :: TurtleParser L.Text
_pnRest :: TurtleParser Text
_pnRest = TurtleParser Char -> TurtleParser Text
noTrailingDot TurtleParser Char
_pnChars

{-
There are two productions which look like

  ( (parser | '.')* parser )?

Unfortunately one of them has parser returning a Char and the
other has the parser returning multiple characters, so separate
out for now; hopefully can combine

Have decided to try replacing this with sepEndBy1, treating the '.'
as a separator, since this is closer to the EBNF. However, this
then eats up multiple '.' characters.

noTrailingDot ::
  TurtleParser Char -- ^ This *should not* match '.'
  -> TurtleParser L.Text
noTrailingDot p = do
  terms <- sepEndBy1 (many p) (char '.')
  return $ L.pack $ intercalate "." terms

noTrailingDotM ::
  TurtleParser L.Text -- ^ This *should not* match '.'
  -> TurtleParser L.Text
noTrailingDotM p = do
  terms <- sepEndBy1 (many p) (char '.')
  return $ L.intercalate "." $ map L.concat terms

-}

noTrailing ::
  TurtleParser a      -- ^ parser for '.'
  -> ([a] -> String)  -- ^ Collect fragments into a string
  -> TurtleParser a   -- ^ This *should not* match '.'
  -> TurtleParser L.Text
noTrailing :: forall a.
TurtleParser a
-> ([a] -> [Char]) -> TurtleParser a -> TurtleParser Text
noTrailing TurtleParser a
dotParser [a] -> [Char]
conv TurtleParser a
parser = do
  [a]
lbl <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (TurtleParser a
parser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser a
dotParser)
  let (Int
nret, [Char]
lclean) = [Char] -> (Int, [Char])
clean forall a b. (a -> b) -> a -> b
$ [a] -> [Char]
conv [a]
lbl
      
      -- a simple difference list implementation
      edl :: a -> a
edl = forall a. a -> a
id
      snocdl :: a -> ([a] -> c) -> [a] -> c
snocdl a
x [a] -> c
xs = [a] -> c
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xforall a. a -> [a] -> [a]
:)
      appenddl :: (b -> c) -> (a -> b) -> a -> c
appenddl = forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
      replicatedl :: Int -> a -> [a] -> [a]
replicatedl Int
n a
x = (forall a. Int -> a -> [a]
replicate Int
n a
x forall a. [a] -> [a] -> [a]
++)
  
      -- this started out as a simple automaton/transducer from
      -- http://www.haskell.org/pipermail/haskell-cafe/2011-September/095347.html
      -- but then I decided to complicate it
      -- 
      clean :: String -> (Int, String)
      clean :: [Char] -> (Int, [Char])
clean = forall {b}. Int -> ([Char] -> b) -> [Char] -> (Int, b)
go Int
0 forall a. a -> a
edl
        where
          go :: Int -> ([Char] -> b) -> [Char] -> (Int, b)
go Int
n [Char] -> b
acc [] = (Int
n, [Char] -> b
acc [])
          go Int
n [Char] -> b
acc (Char
'.':[Char]
xs) = Int -> ([Char] -> b) -> [Char] -> (Int, b)
go (Int
n forall a. Num a => a -> a -> a
+ Int
1) [Char] -> b
acc [Char]
xs 
          go Int
0 [Char] -> b
acc (Char
x:[Char]
xs) = Int -> ([Char] -> b) -> [Char] -> (Int, b)
go Int
0 (forall {a} {c}. a -> ([a] -> c) -> [a] -> c
snocdl Char
x [Char] -> b
acc) [Char]
xs
          go Int
n [Char] -> b
acc (Char
x:[Char]
xs) = Int -> ([Char] -> b) -> [Char] -> (Int, b)
go Int
0 (forall b c a. (b -> c) -> (a -> b) -> a -> c
appenddl [Char] -> b
acc (forall {a} {c}. a -> ([a] -> c) -> [a] -> c
snocdl Char
x (forall {a}. Int -> a -> [a] -> [a]
replicatedl Int
n Char
'.'))) [Char]
xs

  forall s. Text -> Parser s ()
reparse forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> Text
L.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nret) Text
"."
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Text
L.pack [Char]
lclean

noTrailingDot ::
  TurtleParser Char -- ^ This *should not* match '.'
  -> TurtleParser L.Text
noTrailingDot :: TurtleParser Char -> TurtleParser Text
noTrailingDot = forall a.
TurtleParser a
-> ([a] -> [Char]) -> TurtleParser a -> TurtleParser Text
noTrailing (forall s. Char -> Parser s Char
char Char
'.') forall a. a -> a
id

noTrailingDotM ::
  TurtleParser L.Text -- ^ This *should not* match '.'
  -> TurtleParser L.Text
noTrailingDotM :: TurtleParser Text -> TurtleParser Text
noTrailingDotM  = forall a.
TurtleParser a
-> ([a] -> [Char]) -> TurtleParser a -> TurtleParser Text
noTrailing (forall s. Char -> Parser s Char
char Char
'.' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
".") (Text -> [Char]
L.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
L.concat)

{-
[144s]	LANGTAG	::=	'@' [a-zA-Z]+ ('-' [a-zA-Z0-9]+)*

Note that toLangTag may fail since it does some extra
validation not done by the parser (mainly on the length of the
primary and secondary tags).

NOTE: This parser does not accept multiple secondary tags which RFC3066
does.

-}
_langTag :: TurtleParser LanguageTag
_langTag :: Parser TurtleState LanguageTag
_langTag = do
    forall s. Char -> Parser s ()
ichar Char
'@'
    Text
h <- forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
isaZ
    Maybe Text
mt <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Text -> Text
L.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Char -> Parser s Char
char Char
'-' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
isaZ09)
    let lbl :: Text
lbl = Text -> Text
L.toStrict forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
L.append Text
h forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
L.empty Maybe Text
mt
    case Text -> Maybe LanguageTag
toLangTag Text
lbl of
        Just LanguageTag
lt -> forall (m :: * -> *) a. Monad m => a -> m a
return LanguageTag
lt
        Maybe LanguageTag
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Invalid language tag: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
lbl) -- should this be failBad?

-- Returns True for + and False for -.
_leadingSign :: TurtleParser (Maybe Bool)
_leadingSign :: TurtleParser (Maybe Bool)
_leadingSign = do
  Maybe Char
ms <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. (Char -> Bool) -> Parser s Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"+-"::String)))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a. Eq a => a -> a -> Bool
== Char
'+') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe Char
ms

{-
For when we tried to create a canonical representation.
addSign :: Maybe Bool -> L.Text -> L.Text
addSign (Just False) t = L.cons '-' t
addSign _            t = t
-}

addSign :: Maybe Bool -> L.Text -> L.Text
addSign :: Maybe Bool -> Text -> Text
addSign (Just Bool
True) Text
t = Char -> Text -> Text
L.cons Char
'+' Text
t
addSign (Just Bool
_)    Text
t = Char -> Text -> Text
L.cons Char
'-' Text
t
addSign Maybe Bool
_           Text
t = Text
t

{-
[19]	INTEGER	::=	[+-]? [0-9]+

We try to produce a canonical form for the
numbers.
-}

_integer :: TurtleParser L.Text
_integer :: TurtleParser Text
_integer = do
  Maybe Bool
ms <- TurtleParser (Maybe Bool)
_leadingSign
  Text
rest <- forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
is09
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Bool -> Text -> Text
addSign Maybe Bool
ms Text
rest

{-
[20]	DECIMAL	::=	[+-]? [0-9]* '.' [0-9]+
-}

_decimal :: TurtleParser L.Text
_decimal :: TurtleParser Text
_decimal = do
  Maybe Bool
ms <- TurtleParser (Maybe Bool)
_leadingSign
  Text
leading <- forall s. (Char -> Bool) -> Parser s Text
manySatisfy Char -> Bool
is09
  forall s. Char -> Parser s ()
ichar Char
'.'
  Text
trailing <- forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
is09
  let ans2 :: Text
ans2 = Char -> Text -> Text
L.cons Char
'.' Text
trailing
      ans :: Text
ans = if Text -> Bool
L.null Text
leading
            -- then L.cons '0' ans2 -- create a 'canonical' version
            then Text
ans2
            else Text -> Text -> Text
L.append Text
leading Text
ans2
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Bool -> Text -> Text
addSign Maybe Bool
ms Text
ans
  
{-
[21]	DOUBLE	::=	[+-]? ([0-9]+ '.' [0-9]* EXPONENT | '.' [0-9]+ EXPONENT | [0-9]+ EXPONENT)

-}
_d1 :: TurtleParser L.Text
_d1 :: TurtleParser Text
_d1 = do
  Text
a <- forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
is09
  forall s. Char -> Parser s ()
ichar Char
'.'
  Text
b <- forall s. (Char -> Bool) -> Parser s Text
manySatisfy Char -> Bool
is09
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
a Text -> Text -> Text
`L.append` (Char
'.' Char -> Text -> Text
`L.cons` Text
b)

_d2 :: TurtleParser L.Text
_d2 :: TurtleParser Text
_d2 = do
  forall s. Char -> Parser s ()
ichar Char
'.'
  Text
b <- forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
is09
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char
'.' Char -> Text -> Text
`L.cons` Text
b

_d3 :: TurtleParser L.Text
_d3 :: TurtleParser Text
_d3 = forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
is09

_double :: TurtleParser L.Text
_double :: TurtleParser Text
_double = do
  Maybe Bool
ms <- TurtleParser (Maybe Bool)
_leadingSign
  Text
leading <- TurtleParser Text
_d1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser Text
_d2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser Text
_d3
  Text
e <- TurtleParser Text
_exponent
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Bool -> Text -> Text
addSign Maybe Bool
ms forall a b. (a -> b) -> a -> b
$ Text
leading Text -> Text -> Text
`L.append` Text
e

{-
[154s]	EXPONENT	::=	[eE] [+-]? [0-9]+
-}
_exponent :: TurtleParser L.Text
_exponent :: TurtleParser Text
_exponent = do
  Char
e <- forall s. Char -> Parser s Char
char Char
'e' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. Char -> Parser s Char
char Char
'E'
  Maybe Bool
ms <- TurtleParser (Maybe Bool)
_leadingSign
  Char -> Text -> Text
L.cons Char
e forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Bool -> Text -> Text
addSign Maybe Bool
ms forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser Text
_integer

{-
[22]	STRING_LITERAL_QUOTE	::=	'"' ([^#x22#x5C#xA#xD] | ECHAR | UCHAR)* '"'
[23]	STRING_LITERAL_SINGLE_QUOTE	::=	"'" ([^#x27#x5C#xA#xD] | ECHAR | UCHAR)* "'"
[24]	STRING_LITERAL_LONG_SINGLE_QUOTE	::=	"'''" (("'" | "''")? [^'\] | ECHAR | UCHAR)* "'''"
[25]	STRING_LITERAL_LONG_QUOTE	::=	'"""' (('"' | '""')? [^"\] | ECHAR | UCHAR)* '"""'

Since ECHAR | UCHAR is common to all these we pull it out to
create the _protChar parser.
-}

_protChar :: TurtleParser Char
_protChar :: TurtleParser Char
_protChar = forall s. Char -> Parser s Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (TurtleParser Char
_echar' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser Char
_uchar')

_exclSLQ, _exclSLSQ :: String
_exclSLQ :: [Char]
_exclSLQ = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr [Int
0x22, Int
0x5c, Int
0x0a, Int
0x0d]
_exclSLSQ :: [Char]
_exclSLSQ = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr [Int
0x27, Int
0x5c, Int
0x0a, Int
0x0d]

_stringLiteralQuote, _stringLiteralSingleQuote :: TurtleParser L.Text
_stringLiteralQuote :: TurtleParser Text
_stringLiteralQuote = forall a. TurtleParser a -> TurtleParser Char -> TurtleParser Text
_stringIt Parser TurtleState ()
dQuot ([Char] -> TurtleParser Char
_tChars [Char]
_exclSLQ)
_stringLiteralSingleQuote :: TurtleParser Text
_stringLiteralSingleQuote = forall a. TurtleParser a -> TurtleParser Char -> TurtleParser Text
_stringIt Parser TurtleState ()
sQuot ([Char] -> TurtleParser Char
_tChars [Char]
_exclSLSQ)

_stringLiteralLongQuote, _stringLiteralLongSingleQuote :: TurtleParser L.Text
_stringLiteralLongQuote :: TurtleParser Text
_stringLiteralLongQuote = forall a. TurtleParser a -> TurtleParser Text -> TurtleParser Text
_stringItLong Parser TurtleState ()
dQuot3 (Char -> TurtleParser Text
_tCharsLong Char
'"')
_stringLiteralLongSingleQuote :: TurtleParser Text
_stringLiteralLongSingleQuote = forall a. TurtleParser a -> TurtleParser Text -> TurtleParser Text
_stringItLong Parser TurtleState ()
sQuot3 (Char -> TurtleParser Text
_tCharsLong Char
'\'')

_stringIt :: TurtleParser a -> TurtleParser Char -> TurtleParser L.Text
_stringIt :: forall a. TurtleParser a -> TurtleParser Char -> TurtleParser Text
_stringIt TurtleParser a
sep TurtleParser Char
chars = [Char] -> Text
L.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket TurtleParser a
sep TurtleParser a
sep (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many TurtleParser Char
chars)

_stringItLong :: TurtleParser a -> TurtleParser L.Text -> TurtleParser L.Text
_stringItLong :: forall a. TurtleParser a -> TurtleParser Text -> TurtleParser Text
_stringItLong TurtleParser a
sep TurtleParser Text
chars = [Text] -> Text
L.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket TurtleParser a
sep TurtleParser a
sep (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many TurtleParser Text
chars)

_tChars :: String -> TurtleParser Char
_tChars :: [Char] -> TurtleParser Char
_tChars [Char]
excl = TurtleParser Char
_protChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. [Char] -> Parser s Char
noneOf [Char]
excl

oneOrTwo :: Char -> TurtleParser L.Text
oneOrTwo :: Char -> TurtleParser Text
oneOrTwo Char
c = do
  forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore forall a b. (a -> b) -> a -> b
$ forall s. Char -> Parser s Char
char Char
c
  Maybe Char
mb <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. Char -> Parser s Char
char Char
c)
  case Maybe Char
mb of
    Just Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Text
L.pack [Char
c,Char
c]
    Maybe Char
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char -> Text
L.singleton Char
c

_multiQuote :: Char -> TurtleParser L.Text
_multiQuote :: Char -> TurtleParser Text
_multiQuote Char
c = do
  Maybe Text
mq <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> TurtleParser Text
oneOrTwo Char
c)
  Char
r <- forall s. [Char] -> Parser s Char
noneOf (Char
c forall a. a -> [a] -> [a]
: [Char]
"\\")
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
L.empty Maybe Text
mq Text -> Char -> Text
`L.snoc` Char
r
                
_tCharsLong :: Char -> TurtleParser L.Text
_tCharsLong :: Char -> TurtleParser Text
_tCharsLong Char
c =
  Char -> Text
L.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser Char
_protChar
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> TurtleParser Text
_multiQuote Char
c

{-
[26]	UCHAR	::=	'\u' HEX HEX HEX HEX | '\U' HEX HEX HEX HEX HEX HEX HEX HEX
-}
_uchar :: TurtleParser Char
_uchar :: TurtleParser Char
_uchar = forall s. Char -> Parser s Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TurtleParser Char
_uchar'

_uchar' :: TurtleParser Char
_uchar' :: TurtleParser Char
_uchar' =
  (forall s. Char -> Parser s Char
char Char
'u' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a. Parser a Char
hex4 forall s a. Parser s a -> [Char] -> Parser s a
<? [Char]
"Expected 4 hex characters after \\u"))
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (forall s. Char -> Parser s Char
char Char
'U' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a. Parser a Char
hex8 forall s a. Parser s a -> [Char] -> Parser s a
<? [Char]
"Expected 8 hex characters after \\U"))

{-
[159s]	ECHAR	::=	'\' [tbnrf\"']

Since ECHAR is only used by the string productions
in the form ECHAR | UCHAR, the check for the leading
\ has been moved out (see _protChar)

_echar :: TurtleParser Char
_echar = char '\\' *> _echar'
-}

_echar' :: TurtleParser Char
_echar' :: TurtleParser Char
_echar' = 
  (forall s. Char -> Parser s Char
char Char
't' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\t') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (forall s. Char -> Parser s Char
char Char
'b' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\b') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (forall s. Char -> Parser s Char
char Char
'n' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\n') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (forall s. Char -> Parser s Char
char Char
'r' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\r') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (forall s. Char -> Parser s Char
char Char
'f' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\f') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (forall s. Char -> Parser s Char
char Char
'\\' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\\') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (forall s. Char -> Parser s Char
char Char
'"' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'"') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (forall s. Char -> Parser s Char
char Char
'\'' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\'')

{-
[161s]	WS	::=	#x20 | #x9 | #xD | #xA
-}

_ws :: TurtleParser ()
_ws :: Parser TurtleState ()
_ws = forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore forall a b. (a -> b) -> a -> b
$ forall s. (Char -> Bool) -> Parser s Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
_wsChars)

_wsChars :: String
_wsChars :: [Char]
_wsChars = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr [Int
0x20, Int
0x09, Int
0x0d, Int
0x0a]

{-
[162s]	ANON	::=	'[' WS* ']'
-}

_anon :: TurtleParser RDFLabel
_anon :: TurtleParser RDFLabel
_anon =
  forall a. Char -> Char -> TurtleParser a -> TurtleParser a
br Char
'[' Char
']' (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TurtleState ()
_ws) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TurtleParser RDFLabel
newBlankNode

{-
[163s]	PN_CHARS_BASE	::=	[A-Z] | [a-z] | [#x00C0-#x00D6] | [#x00D8-#x00F6] | [#x00F8-#x02FF] | [#x0370-#x037D] | [#x037F-#x1FFF] | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF]

TODO: may want to make this a Char -> Bool selector for
use with manySatisfy rather than a combinator.
-}

_pnCharsBase :: TurtleParser Char
_pnCharsBase :: TurtleParser Char
_pnCharsBase = 
  let f :: Char -> Bool
f Char
c = let i :: Int
i = Char -> Int
ord Char
c
            in Char -> Bool
isaZ Char
c Bool -> Bool -> Bool
|| 
               forall a. Ord a => a -> [(a, a)] -> Bool
match Int
i [(Int
0xc0, Int
0xd6), (Int
0xd8, Int
0xf6), (Int
0xf8, Int
0x2ff),
                        (Int
0x370, Int
0x37d), (Int
0x37f, Int
0x1fff), (Int
0x200c, Int
0x200d),
                        (Int
0x2070, Int
0x218f), (Int
0x2c00, Int
0x2fef), (Int
0x3001, Int
0xd7ff),
                        (Int
0xf900, Int
0xfdcf), (Int
0xfdf0, Int
0xfffd), (Int
0x10000, Int
0xeffff)]
  in forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
f

{-
[164s]	PN_CHARS_U	::=	PN_CHARS_BASE | '_'
[166s]	PN_CHARS	::=	PN_CHARS_U | '-' | [0-9] | #x00B7 | [#x0300-#x036F] | [#x203F-#x2040]
-}

_pnCharsU, _pnChars :: TurtleParser Char
_pnCharsU :: TurtleParser Char
_pnCharsU = TurtleParser Char
_pnCharsBase forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. Char -> Parser s Char
char Char
'_'
_pnChars :: TurtleParser Char
_pnChars =
  let f :: Char -> Bool
f Char
c = let i :: Int
i = Char -> Int
ord Char
c
            in forall a. Ord a => a -> [(a, a)] -> Bool
match Int
i [(Int
0x300, Int
0x36f), (Int
0x203f, Int
0x2040)]
  in TurtleParser Char
_pnCharsU forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. Char -> Parser s Char
char Char
'-' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
is09 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     forall s. Char -> Parser s Char
char (Int -> Char
chr Int
0xb7) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
f

{-
[167s]	PN_PREFIX	::=	PN_CHARS_BASE ((PN_CHARS | '.')* PN_CHARS)?
[168s]	PN_LOCAL	::=	(PN_CHARS_U | ':' | [0-9] | PLX) ((PN_CHARS | '.' | ':' | PLX)* (PN_CHARS | ':' | PLX))?
-}

_pnPrefix :: TurtleParser L.Text
_pnPrefix :: TurtleParser Text
_pnPrefix = Char -> Text -> Text
L.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser Char
_pnCharsBase forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TurtleParser Text
_pnRest

_pnLocal :: TurtleParser L.Text
_pnLocal :: TurtleParser Text
_pnLocal = do
  Text
s <- Char -> Text
L.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TurtleParser Char
_pnCharsU forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. Char -> Parser s Char
char Char
':' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
is09)
       forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser Text
_plx
  Text
e <- TurtleParser Text -> TurtleParser Text
noTrailingDotM (Char -> Text
L.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TurtleParser Char
_pnChars forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s. Char -> Parser s Char
char Char
':') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser Text
_plx)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
s Text -> Text -> Text
`L.append` Text
e

{-
[169s]	PLX	::=	PERCENT | PN_LOCAL_ESC
[170s]	PERCENT	::=	'%' HEX HEX
[171s]	HEX	::=	[0-9] | [A-F] | [a-f]
[172s]	PN_LOCAL_ESC	::=	'\' ('_' | '~' | '.' | '-' | '!' | '$' | '&' | "'" | '(' | ')' | '*' | '+' | ',' | ';' | '=' | '/' | '?' | '#' | '@' | '%')

We do not convert hex-encoded values into the characters, which
means we have to deal with Text rather than Char for these
parsers, which is annoying.
-}

_plx, _percent :: TurtleParser L.Text
_plx :: TurtleParser Text
_plx = TurtleParser Text
_percent forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Text
L.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser Char
_pnLocalEsc)

_percent :: TurtleParser Text
_percent = do
  forall s. Char -> Parser s ()
ichar Char
'%'
  Char
a <- TurtleParser Char
_hex
  Char -> Text -> Text
L.cons Char
'%' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
L.cons Char
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
L.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TurtleParser Char
_hex

_hex, _pnLocalEsc :: TurtleParser Char
_hex :: TurtleParser Char
_hex = forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
isHexDigit
_pnLocalEsc :: TurtleParser Char
_pnLocalEsc = forall s. Char -> Parser s Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s. (Char -> Bool) -> Parser s Char
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
_pnLocalEscChars)
  
_pnLocalEscChars :: String
_pnLocalEscChars :: [Char]
_pnLocalEscChars = [Char]
"_~.-!$&'()*+,;=/?#@%"

--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2013, 2014, 2018, 2020, 2022 Douglas Burke
--  All rights reserved.
--
--  This file is part of Swish.
--
--  Swish is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  Swish is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with Swish; if not, write to:
--    The Free Software Foundation, Inc.,
--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--
--------------------------------------------------------------------------------