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

--------------------------------------------------------------------------------
--  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 Douglas Burke
--  License     :  GPL V2
-- 
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  CPP, 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 Int -> TurtleState -> ShowS
[TurtleState] -> ShowS
TurtleState -> String
(Int -> TurtleState -> ShowS)
-> (TurtleState -> String)
-> ([TurtleState] -> ShowS)
-> Show TurtleState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TurtleState] -> ShowS
$cshowList :: [TurtleState] -> ShowS
show :: TurtleState -> String
$cshow :: TurtleState -> String
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' = Maybe Text -> URI -> NamespaceMap -> NamespaceMap
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 <- Parser TurtleState TurtleState
forall s. Parser s s
stGet
  case TurtleState -> Maybe Text -> Maybe URI
getPrefixURI TurtleState
s Maybe Text
forall a. Maybe a
Nothing of
    Just URI
uri -> Namespace -> TurtleParser Namespace
forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> TurtleParser Namespace)
-> Namespace -> TurtleParser Namespace
forall a b. (a -> b) -> a -> b
$ Maybe Text -> URI -> Namespace
makeNamespace Maybe Text
forall a. Maybe a
Nothing URI
uri
    Maybe URI
_ -> String -> TurtleParser Namespace
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad String
"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 = Maybe Text -> NamespaceMap -> Maybe URI
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 = (Text -> Maybe URI -> ParseResult)
-> Maybe URI -> Text -> ParseResult
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Maybe URI -> ParseResult
parseTurtle Maybe URI
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 = TurtleParser RDFGraph -> Maybe URI -> Text -> ParseResult
forall a. TurtleParser a -> Maybe URI -> Text -> Either String 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   = Map k a
forall k a. Map k a
M.empty -- M.singleton Nothing hashURI
      buri :: URI
buri   = URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe (ScopedName -> URI
getScopedNameURI ScopedName
defaultBase) Maybe URI
mbase
  in TurtleState :: RDFGraph -> NamespaceMap -> URI -> Word32 -> TurtleState
TurtleState
     { graphState :: RDFGraph
graphState = RDFGraph
emptyRDFGraph
     , prefixUris :: NamespaceMap
prefixUris = NamespaceMap
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 :: TurtleParser a -> Maybe URI -> Text -> Either String a
parseAnyfromText TurtleParser a
parser Maybe URI
mbase = TurtleParser a -> TurtleState -> Text -> Either String a
forall a b. Parser a b -> a -> Text -> Either String b
runParserWithError TurtleParser a
parser (Maybe URI -> TurtleState
emptyState Maybe URI
mbase)

newBlankNode :: TurtleParser RDFLabel
newBlankNode :: TurtleParser RDFLabel
newBlankNode = do
  Word32
n <- (TurtleState -> Word32) -> Parser TurtleState Word32
forall s a. (s -> a) -> Parser s a
stQuery (Word32 -> Word32
forall a. Enum a => a -> a
succ (Word32 -> Word32)
-> (TurtleState -> Word32) -> TurtleState -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtleState -> Word32
nodeGen)
  (TurtleState -> TurtleState) -> Parser TurtleState ()
forall s. (s -> s) -> Parser s ()
stUpdate ((TurtleState -> TurtleState) -> Parser TurtleState ())
-> (TurtleState -> TurtleState) -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ \TurtleState
s -> TurtleState
s { nodeGen :: Word32
nodeGen = Word32
n }
  RDFLabel -> TurtleParser RDFLabel
forall (m :: * -> *) a. Monad m => a -> m a
return (RDFLabel -> TurtleParser RDFLabel)
-> RDFLabel -> TurtleParser RDFLabel
forall a b. (a -> b) -> a -> b
$ String -> RDFLabel
Blank (Word32 -> String
forall a. Show a => a -> String
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 = String -> Parser TurtleState ()
forall s. String -> Parser s ()
isymbol String
","
semiColon :: Parser TurtleState ()
semiColon = String -> Parser TurtleState ()
forall s. String -> Parser s ()
isymbol String
";"
fullStop :: Parser TurtleState ()
fullStop = String -> Parser TurtleState ()
forall s. String -> Parser s ()
isymbol String
"."

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

match :: (Ord a) => a -> [(a,a)] -> Bool
match :: a -> [(a, a)] -> Bool
match a
v = ((a, a) -> Bool) -> [(a, a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(a
l,a
h) -> a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
l Bool -> Bool -> Bool
&& a
v a -> a -> Bool
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 :: Char -> Char -> TurtleParser a -> TurtleParser a
br Char
lsym Char
rsym =
  let f :: Char -> Parser s Char
f = Parser s Char -> Parser s Char
forall s a. Parser s a -> Parser s a
lexeme (Parser s Char -> Parser s Char)
-> (Char -> Parser s Char) -> Char -> Parser s Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parser s Char
forall s. Char -> Parser s Char
char
  in Parser TurtleState Char
-> Parser TurtleState Char -> TurtleParser a -> TurtleParser a
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
f Char
lsym) (Char -> Parser TurtleState Char
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 = (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'@' Parser TurtleState Char
-> Parser TurtleState Text -> Parser TurtleState Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TurtleState Text -> Parser TurtleState Text
forall s a. Parser s a -> Parser s a
lexeme (Text -> Parser TurtleState Text
forall s. Text -> Parser s Text
stringT Text
s)) Parser TurtleState Text -> () -> Parser TurtleState ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

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

-- | Case insensitive match.
stringI ::
  String  -- ^ must be upper case
  -> TurtleParser String
stringI :: String -> Parser TurtleState String
stringI = (Char -> Parser TurtleState Char)
-> String -> Parser TurtleState String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Parser TurtleState 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 ScopedName -> [ScopedName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScopedName
xsdBoolean, ScopedName
xsdInteger, ScopedName
xsdDecimal, ScopedName
xsdDouble] = do 
  TurtleState
ost <- Parser TurtleState TurtleState
forall s. Parser s s
stGet
  let stmt :: Arc RDFLabel
stmt = RDFLabel -> RDFLabel -> RDFLabel -> Arc RDFLabel
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 (Namespace -> (Maybe Text, URI)) -> Namespace -> (Maybe Text, URI)
forall a b. (a -> b) -> a -> b
$ ScopedName -> Namespace
getScopeNamespace ScopedName
dtype
      newp :: NamespaceMap
newp = Maybe Text -> URI -> NamespaceMap -> NamespaceMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Maybe Text
nspre URI
nsuri NamespaceMap
oldp
  (TurtleState -> TurtleState) -> Parser TurtleState ()
forall s. (s -> s) -> Parser s ()
stUpdate ((TurtleState -> TurtleState) -> Parser TurtleState ())
-> (TurtleState -> TurtleState) -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ \TurtleState
st -> TurtleState
st { prefixUris :: NamespaceMap
prefixUris = NamespaceMap
newp, graphState :: RDFGraph
graphState = Arc RDFLabel -> RDFGraph -> RDFGraph
forall lb. Label lb => Arc lb -> NSGraph lb -> NSGraph lb
addArc Arc RDFLabel
stmt RDFGraph
ogs }
addStatement RDFLabel
s RDFLabel
p RDFLabel
o = (TurtleState -> TurtleState) -> Parser TurtleState ()
forall s. (s -> s) -> Parser s ()
stUpdate ((RDFGraph -> RDFGraph) -> TurtleState -> TurtleState
updateGraph (Arc RDFLabel -> RDFGraph -> RDFGraph
forall lb. Label lb => Arc lb -> NSGraph lb -> NSGraph lb
addArc (RDFLabel -> RDFLabel -> RDFLabel -> Arc RDFLabel
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 <- Parser TurtleState TurtleState
forall s. Parser s s
stGet
  let (Maybe Text
pkey, URI
pval) = Namespace -> (Maybe Text, URI)
getNamespaceTuple (Namespace -> (Maybe Text, URI)) -> Namespace -> (Maybe Text, URI)
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 Maybe Text -> NamespaceMap -> Maybe URI
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Maybe Text
pkey NamespaceMap
opmap of
    Just URI
val | URI
val URI -> URI -> Bool
forall a. Eq a => a -> a -> Bool
== URI
pval -> RDFLabel -> TurtleParser RDFLabel
forall (m :: * -> *) a. Monad m => a -> m a
return RDFLabel
rval
             | Bool
otherwise   -> do
               (TurtleState -> TurtleState) -> Parser TurtleState ()
forall s. (s -> s) -> Parser s ()
stUpdate ((TurtleState -> TurtleState) -> Parser TurtleState ())
-> (TurtleState -> TurtleState) -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ \TurtleState
s -> TurtleState
s { prefixUris :: NamespaceMap
prefixUris = Maybe Text -> URI -> NamespaceMap -> NamespaceMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Maybe Text
pkey URI
pval NamespaceMap
opmap }
               RDFLabel -> TurtleParser RDFLabel
forall (m :: * -> *) a. Monad m => a -> m a
return RDFLabel
rval
    
    Maybe URI
_ -> do
      (TurtleState -> TurtleState) -> Parser TurtleState ()
forall s. (s -> s) -> Parser s ()
stUpdate ((TurtleState -> TurtleState) -> Parser TurtleState ())
-> (TurtleState -> TurtleState) -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ \TurtleState
s -> TurtleState
s { prefixUris :: NamespaceMap
prefixUris = Maybe Text -> URI -> NamespaceMap -> NamespaceMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Maybe Text
pkey URI
pval NamespaceMap
opmap }
      RDFLabel -> TurtleParser RDFLabel
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 <- Parser TurtleState TurtleState
forall s. Parser s s
stGet
  case Maybe Text -> NamespaceMap -> Maybe URI
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pre) (TurtleState -> NamespaceMap
prefixUris TurtleState
st) of
    Just URI
uri -> Namespace -> TurtleParser Namespace
forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> TurtleParser Namespace)
-> Namespace -> TurtleParser Namespace
forall a b. (a -> b) -> a -> b
$ Maybe Text -> URI -> Namespace
makeNamespace (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pre) URI
uri
    Maybe URI
Nothing  -> String -> TurtleParser Namespace
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String -> TurtleParser Namespace)
-> String -> TurtleParser Namespace
forall a b. (a -> b) -> a -> b
$ String
"Undefined prefix '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
pre String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":'."

-- | 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
<? :: Parser s a -> String -> Parser s a
(<?) Parser s a
p String
m = Parser s a -> ShowS -> Parser s a
forall (p :: * -> *) a. Commitment p => p a -> ShowS -> p a
adjustErr Parser s a
p ((String
mString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n")String -> ShowS
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 (TurtleState -> RDFGraph)
-> Parser TurtleState TurtleState -> TurtleParser RDFGraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser TurtleState ()
forall s. Parser s ()
whiteSpace Parser TurtleState ()
-> Parser TurtleState [()] -> Parser TurtleState [()]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TurtleState () -> Parser TurtleState [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TurtleState ()
statement Parser TurtleState [()]
-> Parser TurtleState () -> Parser TurtleState ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TurtleState ()
forall s. Parser s ()
eof Parser TurtleState ()
-> Parser TurtleState TurtleState -> Parser TurtleState TurtleState
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TurtleState TurtleState
forall s. Parser s s
stGet)
  where
    mkGr :: TurtleState -> RDFGraph
mkGr TurtleState
s = NamespaceMap -> RDFGraph -> RDFGraph
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 Parser TurtleState ()
-> Parser TurtleState () -> Parser TurtleState ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser TurtleState ()
triples Parser TurtleState ()
-> Parser TurtleState () -> Parser TurtleState ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TurtleState () -> Parser TurtleState ()
forall (p :: * -> *) a. Commitment p => p a -> p a
commit Parser TurtleState ()
fullStop Parser TurtleState () -> String -> Parser TurtleState ()
forall s a. Parser s a -> String -> Parser s a
<? String
"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 =
  Parser TurtleState () -> Parser TurtleState ()
forall s a. Parser s a -> Parser s a
lexeme
  (Parser TurtleState ()
prefixID Parser TurtleState () -> String -> Parser TurtleState ()
forall s a. Parser s a -> String -> Parser s a
<? String
"Unable to parse @prefix statement."
   Parser TurtleState ()
-> Parser TurtleState () -> Parser TurtleState ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TurtleState ()
base Parser TurtleState () -> String -> Parser TurtleState ()
forall s a. Parser s a -> String -> Parser s a
<? String
"Unable to parse @base statement."
   Parser TurtleState ()
-> Parser TurtleState () -> Parser TurtleState ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TurtleState ()
sparqlPrefix Parser TurtleState () -> String -> Parser TurtleState ()
forall s a. Parser s a -> String -> Parser s a
<? String
"Unable to parse Sparql PREFIX statement."
   Parser TurtleState ()
-> Parser TurtleState () -> Parser TurtleState ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TurtleState ()
sparqlBase Parser TurtleState () -> String -> Parser TurtleState ()
forall s a. Parser s a -> String -> Parser s a
<? String
"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 <- Parser TurtleState (Maybe Text) -> Parser TurtleState (Maybe Text)
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser TurtleState (Maybe Text)
 -> Parser TurtleState (Maybe Text))
-> Parser TurtleState (Maybe Text)
-> Parser TurtleState (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Parser TurtleState (Maybe Text) -> Parser TurtleState (Maybe Text)
forall s a. Parser s a -> Parser s a
lexeme Parser TurtleState (Maybe Text)
_pnameNS
  URI
u <- Parser TurtleState URI -> Parser TurtleState URI
forall s a. Parser s a -> Parser s a
lexeme Parser TurtleState URI
_iriRef
  Parser TurtleState ()
fullStop
  (TurtleState -> TurtleState) -> Parser TurtleState ()
forall s. (s -> s) -> Parser s ()
stUpdate ((TurtleState -> TurtleState) -> Parser TurtleState ())
-> (TurtleState -> TurtleState) -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> URI -> TurtleState -> TurtleState
setPrefix ((Text -> Text) -> Maybe Text -> Maybe Text
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 <- Parser TurtleState URI -> Parser TurtleState URI
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser TurtleState URI -> Parser TurtleState URI)
-> Parser TurtleState URI -> Parser TurtleState URI
forall a b. (a -> b) -> a -> b
$ Parser TurtleState URI -> Parser TurtleState URI
forall s a. Parser s a -> Parser s a
lexeme Parser TurtleState URI
_iriRef
  Parser TurtleState ()
fullStop
  (TurtleState -> TurtleState) -> Parser TurtleState ()
forall s. (s -> s) -> Parser s ()
stUpdate ((TurtleState -> TurtleState) -> Parser TurtleState ())
-> (TurtleState -> TurtleState) -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ URI -> TurtleState -> TurtleState
setBase URI
b

{-
[5s]	sparqlBase	::=	"BASE" IRIREF
-}
sparqlBase :: TurtleParser ()
sparqlBase :: Parser TurtleState ()
sparqlBase = Parser TurtleState String -> Parser TurtleState String
forall s a. Parser s a -> Parser s a
lexeme (String -> Parser TurtleState String
stringI String
"BASE") Parser TurtleState String
-> Parser TurtleState URI -> Parser TurtleState URI
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser TurtleState URI -> Parser TurtleState URI
forall (p :: * -> *) a. Commitment p => p a -> p a
commit Parser TurtleState URI
_iriRef Parser TurtleState URI
-> (URI -> Parser TurtleState ()) -> Parser TurtleState ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TurtleState -> TurtleState) -> Parser TurtleState ()
forall s. (s -> s) -> Parser s ()
stUpdate ((TurtleState -> TurtleState) -> Parser TurtleState ())
-> (URI -> TurtleState -> TurtleState)
-> URI
-> Parser TurtleState ()
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
  Parser TurtleState String -> Parser TurtleState ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser TurtleState String -> Parser TurtleState ())
-> Parser TurtleState String -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ Parser TurtleState String -> Parser TurtleState String
forall s a. Parser s a -> Parser s a
lexeme (Parser TurtleState String -> Parser TurtleState String)
-> Parser TurtleState String -> Parser TurtleState String
forall a b. (a -> b) -> a -> b
$ String -> Parser TurtleState String
stringI String
"PREFIX"
  Maybe Text
p <- Parser TurtleState (Maybe Text) -> Parser TurtleState (Maybe Text)
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser TurtleState (Maybe Text)
 -> Parser TurtleState (Maybe Text))
-> Parser TurtleState (Maybe Text)
-> Parser TurtleState (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Parser TurtleState (Maybe Text) -> Parser TurtleState (Maybe Text)
forall s a. Parser s a -> Parser s a
lexeme Parser TurtleState (Maybe Text)
_pnameNS
  URI
u <- Parser TurtleState URI -> Parser TurtleState URI
forall s a. Parser s a -> Parser s a
lexeme Parser TurtleState URI
_iriRef
  (TurtleState -> TurtleState) -> Parser TurtleState ()
forall s. (s -> s) -> Parser s ()
stUpdate ((TurtleState -> TurtleState) -> Parser TurtleState ())
-> (TurtleState -> TurtleState) -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> URI -> TurtleState -> TurtleState
setPrefix ((Text -> Text) -> Maybe Text -> Maybe Text
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 TurtleParser RDFLabel
-> (RDFLabel -> Parser TurtleState ()) -> Parser TurtleState ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RDFLabel -> Parser TurtleState ()
predicateObjectList)
  Parser TurtleState ()
-> Parser TurtleState () -> Parser TurtleState ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (TurtleParser RDFLabel
blankNodePropertyList TurtleParser RDFLabel
-> (RDFLabel -> Parser TurtleState ()) -> Parser TurtleState ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser TurtleState (Maybe ()) -> Parser TurtleState ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser TurtleState (Maybe ()) -> Parser TurtleState ())
-> (RDFLabel -> Parser TurtleState (Maybe ()))
-> RDFLabel
-> Parser TurtleState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser TurtleState () -> Parser TurtleState (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser TurtleState () -> Parser TurtleState (Maybe ()))
-> (RDFLabel -> Parser TurtleState ())
-> RDFLabel
-> Parser TurtleState (Maybe ())
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 TurtleParser RDFLabel
-> (RDFLabel -> Parser TurtleState ()) -> Parser TurtleState ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RDFLabel -> RDFLabel -> Parser TurtleState ()
objectList RDFLabel
subj
  in Parser TurtleState [()] -> Parser TurtleState ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser TurtleState [()] -> Parser TurtleState ())
-> Parser TurtleState [()] -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ Parser TurtleState ()
-> Parser TurtleState [()] -> Parser TurtleState [()]
forall s a b. Parser s a -> Parser s b -> Parser s [a]
sepEndBy1 Parser TurtleState ()
term (Parser TurtleState () -> Parser TurtleState [()]
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 = TurtleParser RDFLabel
-> Parser TurtleState () -> Parser TurtleState [RDFLabel]
forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
sepBy1 TurtleParser RDFLabel
object Parser TurtleState ()
comma Parser TurtleState [RDFLabel]
-> ([RDFLabel] -> Parser TurtleState ()) -> Parser TurtleState ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RDFLabel -> Parser TurtleState ())
-> [RDFLabel] -> Parser TurtleState ()
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 TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser TurtleState Char -> Parser TurtleState Char
forall s a. Parser s a -> Parser s a
lexeme (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'a') Parser TurtleState Char
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
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 (ScopedName -> RDFLabel)
-> Parser TurtleState ScopedName -> TurtleParser RDFLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TurtleState ScopedName
iri) TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
blankNode TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
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 (ScopedName -> RDFLabel)
-> Parser TurtleState ScopedName -> TurtleParser RDFLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TurtleState ScopedName
iri

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

object :: TurtleParser RDFLabel
object :: TurtleParser RDFLabel
object = (ScopedName -> RDFLabel
Res (ScopedName -> RDFLabel)
-> Parser TurtleState ScopedName -> TurtleParser RDFLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TurtleState ScopedName
iri) TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
blankNode TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
collection TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         TurtleParser RDFLabel
blankNodePropertyList TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
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 = TurtleParser RDFLabel -> TurtleParser RDFLabel
forall s a. Parser s a -> Parser s a
lexeme (TurtleParser RDFLabel -> TurtleParser RDFLabel)
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
forall a b. (a -> b) -> a -> b
$ TurtleParser RDFLabel
rdfLiteral TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser RDFLabel
numericLiteral TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
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
  Char -> Char -> Parser TurtleState () -> Parser TurtleState ()
forall a. Char -> Char -> TurtleParser a -> TurtleParser a
br Char
'[' Char
']' (Parser TurtleState () -> Parser TurtleState ())
-> Parser TurtleState () -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ Parser TurtleState () -> Parser TurtleState ()
forall s a. Parser s a -> Parser s a
lexeme (RDFLabel -> Parser TurtleState ()
predicateObjectList RDFLabel
bNode)
  RDFLabel -> TurtleParser RDFLabel
forall (m :: * -> *) a. Monad m => a -> m a
return RDFLabel
bNode

{-
[15]	collection	::=	'(' object* ')'
-}
collection :: TurtleParser RDFLabel
collection :: TurtleParser RDFLabel
collection = do
  [RDFLabel]
os <- Char
-> Char
-> Parser TurtleState [RDFLabel]
-> Parser TurtleState [RDFLabel]
forall a. Char -> Char -> TurtleParser a -> TurtleParser a
br Char
'(' Char
')' (Parser TurtleState [RDFLabel] -> Parser TurtleState [RDFLabel])
-> Parser TurtleState [RDFLabel] -> Parser TurtleState [RDFLabel]
forall a b. (a -> b) -> a -> b
$ TurtleParser RDFLabel -> Parser TurtleState [RDFLabel]
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
    [] -> RDFLabel -> TurtleParser RDFLabel
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 <- (RDFLabel -> RDFLabel -> TurtleParser RDFLabel)
-> RDFLabel -> [RDFLabel] -> TurtleParser RDFLabel
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
      RDFLabel -> TurtleParser RDFLabel
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
        RDFLabel -> TurtleParser RDFLabel
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 (Text -> RDFLabel)
-> Parser TurtleState Text -> TurtleParser RDFLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TurtleState Text
_double)
     TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     (ScopedName -> Text -> RDFLabel
f ScopedName
xsdDecimal (Text -> RDFLabel)
-> Parser TurtleState Text -> TurtleParser RDFLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TurtleState Text
_decimal)
     TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     (ScopedName -> Text -> RDFLabel
f ScopedName
xsdInteger (Text -> RDFLabel)
-> Parser TurtleState Text -> TurtleParser RDFLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TurtleState 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 (Text -> Text)
-> Parser TurtleState Text -> Parser TurtleState Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TurtleState Text
turtleString
  Maybe (Either LanguageTag ScopedName)
opt <- Parser TurtleState (Either LanguageTag ScopedName)
-> Parser TurtleState (Maybe (Either LanguageTag ScopedName))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((LanguageTag -> Either LanguageTag ScopedName
forall a b. a -> Either a b
Left (LanguageTag -> Either LanguageTag ScopedName)
-> Parser TurtleState LanguageTag
-> Parser TurtleState (Either LanguageTag ScopedName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser TurtleState LanguageTag
_langTag Parser TurtleState LanguageTag
-> String -> Parser TurtleState LanguageTag
forall s a. Parser s a -> String -> Parser s a
<? String
"Unable to parse the language tag"))
                   Parser TurtleState (Either LanguageTag ScopedName)
-> Parser TurtleState (Either LanguageTag ScopedName)
-> Parser TurtleState (Either LanguageTag ScopedName)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                   (String -> Parser TurtleState String
forall s. String -> Parser s String
string String
"^^" Parser TurtleState String
-> Parser TurtleState (Either LanguageTag ScopedName)
-> Parser TurtleState (Either LanguageTag ScopedName)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ScopedName -> Either LanguageTag ScopedName
forall a b. b -> Either a b
Right (ScopedName -> Either LanguageTag ScopedName)
-> Parser TurtleState ScopedName
-> Parser TurtleState (Either LanguageTag ScopedName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser TurtleState ScopedName -> Parser TurtleState ScopedName
forall (p :: * -> *) a. Commitment p => p a -> p a
commit Parser TurtleState ScopedName
iri Parser TurtleState ScopedName
-> String -> Parser TurtleState ScopedName
forall s a. Parser s a -> String -> Parser s a
<? String
"Unable to parse the datatype of the literal"))))
  Parser TurtleState (Maybe ()) -> Parser TurtleState ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser TurtleState (Maybe ()) -> Parser TurtleState ())
-> Parser TurtleState (Maybe ()) -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ Parser TurtleState () -> Parser TurtleState (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser TurtleState ()
forall s. Parser s ()
whiteSpace
  RDFLabel -> TurtleParser RDFLabel
forall (m :: * -> *) a. Monad m => a -> m a
return (RDFLabel -> TurtleParser RDFLabel)
-> RDFLabel -> TurtleParser RDFLabel
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 (Text -> RDFLabel) -> (String -> Text) -> String -> RDFLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RDFLabel)
-> Parser TurtleState String -> TurtleParser RDFLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TurtleState String -> Parser TurtleState String
forall s a. Parser s a -> Parser s a
lexeme (String -> Parser TurtleState String
forall s. String -> Parser s String
string String
"true" Parser TurtleState String
-> Parser TurtleState String -> Parser TurtleState String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser TurtleState String
forall s. String -> Parser s String
string String
"false")

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

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

{-
[136s]	PrefixedName	::=	PNAME_LN | PNAME_NS
-}
prefixedName :: TurtleParser ScopedName
prefixedName :: Parser TurtleState ScopedName
prefixedName = 
  Parser TurtleState ScopedName
_pnameLN Parser TurtleState ScopedName
-> Parser TurtleState ScopedName -> Parser TurtleState ScopedName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
  (Namespace -> LName -> ScopedName)
-> LName -> Namespace -> ScopedName
forall a b c. (a -> b -> c) -> b -> a -> c
flip Namespace -> LName -> ScopedName
makeNSScopedName LName
emptyLName (Namespace -> ScopedName)
-> TurtleParser Namespace -> Parser TurtleState ScopedName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser TurtleState (Maybe Text)
_pnameNS Parser TurtleState (Maybe Text)
-> (Maybe Text -> TurtleParser Namespace) -> TurtleParser Namespace
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 = TurtleParser RDFLabel -> TurtleParser RDFLabel
forall s a. Parser s a -> Parser s a
lexeme (TurtleParser RDFLabel
_blankNodeLabel TurtleParser RDFLabel
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
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 :: Parser TurtleState URI
_iriRef = do
  -- ignore $ char '<'
  -- why a, I using manyFinally' here? '>' shouldn't overlap
  -- with iriRefChar.
  -- ustr <- manyFinally' iriRefChar (char '>')
  String
ustr <- Parser TurtleState Char
-> Parser TurtleState Char
-> Parser TurtleState String
-> Parser TurtleState String
forall (p :: * -> *) bra ket a.
PolyParse p =>
p bra -> p ket -> p a -> p a
bracket (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'<') (Parser TurtleState Char -> Parser TurtleState Char
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'>')) (Parser TurtleState Char -> Parser TurtleState String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TurtleState Char
iriRefChar)
  case String -> Maybe URI
parseURIReference String
ustr of
    Maybe URI
Nothing -> String -> Parser TurtleState URI
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String -> Parser TurtleState URI)
-> String -> Parser TurtleState URI
forall a b. (a -> b) -> a -> b
$ String
"Invalid URI: <" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ustr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
    Just URI
uref -> do
      TurtleState
s <- Parser TurtleState TurtleState
forall s. Parser s s
stGet
      (String -> Parser TurtleState URI)
-> (URI -> Parser TurtleState URI)
-> Either String URI
-> Parser TurtleState URI
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser TurtleState URI
forall (m :: * -> *) a. MonadFail m => String -> m a
fail URI -> Parser TurtleState URI
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String URI -> Parser TurtleState URI)
-> Either String URI -> Parser TurtleState URI
forall a b. (a -> b) -> a -> b
$ URI -> URI -> Either String URI
appendURIs (TurtleState -> URI
baseUri TurtleState
s) URI
uref

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

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

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

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

{-
[141s]	BLANK_NODE_LABEL	::=	'_:' (PN_CHARS_U | [0-9]) ((PN_CHARS | '.')* PN_CHARS)?
-}
_blankNodeLabel :: TurtleParser RDFLabel
_blankNodeLabel :: TurtleParser RDFLabel
_blankNodeLabel = do
  Parser TurtleState String -> Parser TurtleState ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser TurtleState String -> Parser TurtleState ())
-> Parser TurtleState String -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ String -> Parser TurtleState String
forall s. String -> Parser s String
string String
"_:"
  Char
fChar <- Parser TurtleState Char
_pnCharsU Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser TurtleState Char
forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
is09
  Text
rest <- Parser TurtleState Text
_pnRest
  RDFLabel -> TurtleParser RDFLabel
forall (m :: * -> *) a. Monad m => a -> m a
return (RDFLabel -> TurtleParser RDFLabel)
-> RDFLabel -> TurtleParser RDFLabel
forall a b. (a -> b) -> a -> b
$ String -> RDFLabel
Blank (String -> RDFLabel) -> String -> RDFLabel
forall a b. (a -> b) -> a -> b
$ Char
fChar Char -> ShowS
forall a. a -> [a] -> [a]
: Text -> String
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 :: Parser TurtleState Text
_pnRest = Parser TurtleState Char -> Parser TurtleState Text
noTrailingDot Parser TurtleState 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 :: TurtleParser a
-> ([a] -> String) -> TurtleParser a -> Parser TurtleState Text
noTrailing TurtleParser a
dotParser [a] -> String
conv TurtleParser a
parser = do
  [a]
lbl <- TurtleParser a -> Parser TurtleState [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (TurtleParser a
parser TurtleParser a -> TurtleParser a -> TurtleParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TurtleParser a
dotParser)
  let (Int
nret, String
lclean) = String -> (Int, String)
clean (String -> (Int, String)) -> String -> (Int, String)
forall a b. (a -> b) -> a -> b
$ [a] -> String
conv [a]
lbl
      
      -- a simple difference list implementation
      edl :: a -> a
edl = a -> a
forall a. a -> a
id
      snocdl :: a -> ([a] -> c) -> [a] -> c
snocdl a
x [a] -> c
xs = [a] -> c
xs ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
      appenddl :: (b -> c) -> (a -> b) -> a -> c
appenddl = (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
      replicatedl :: Int -> a -> [a] -> [a]
replicatedl Int
n a
x = (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
n a
x [a] -> [a] -> [a]
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 :: String -> (Int, String)
clean = Int -> ShowS -> String -> (Int, String)
forall c. Int -> (String -> c) -> String -> (Int, c)
go Int
0 ShowS
forall a. a -> a
edl
        where
          go :: Int -> (String -> c) -> String -> (Int, c)
go Int
n String -> c
acc [] = (Int
n, String -> c
acc [])
          go Int
n String -> c
acc (Char
'.':String
xs) = Int -> (String -> c) -> String -> (Int, c)
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String -> c
acc String
xs 
          go Int
0 String -> c
acc (Char
x:String
xs) = Int -> (String -> c) -> String -> (Int, c)
go Int
0 (Char -> (String -> c) -> String -> c
forall a c. a -> ([a] -> c) -> [a] -> c
snocdl Char
x String -> c
acc) String
xs
          go Int
n String -> c
acc (Char
x:String
xs) = Int -> (String -> c) -> String -> (Int, c)
go Int
0 ((String -> c) -> ShowS -> String -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
appenddl String -> c
acc (Char -> ShowS -> ShowS
forall a c. a -> ([a] -> c) -> [a] -> c
snocdl Char
x (Int -> Char -> ShowS
forall a. Int -> a -> [a] -> [a]
replicatedl Int
n Char
'.'))) String
xs

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

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

noTrailingDotM ::
  TurtleParser L.Text -- ^ This *should not* match '.'
  -> TurtleParser L.Text
noTrailingDotM :: Parser TurtleState Text -> Parser TurtleState Text
noTrailingDotM  = Parser TurtleState Text
-> ([Text] -> String)
-> Parser TurtleState Text
-> Parser TurtleState Text
forall a.
TurtleParser a
-> ([a] -> String) -> TurtleParser a -> Parser TurtleState Text
noTrailing (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'.' Parser TurtleState Char -> Text -> Parser TurtleState Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
".") (Text -> String
L.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
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
    Char -> Parser TurtleState ()
forall s. Char -> Parser s ()
ichar Char
'@'
    Text
h <- Parser TurtleState Text -> Parser TurtleState Text
forall (p :: * -> *) a. Commitment p => p a -> p a
commit (Parser TurtleState Text -> Parser TurtleState Text)
-> Parser TurtleState Text -> Parser TurtleState Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser TurtleState Text
forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
isaZ
    Maybe Text
mt <- Parser TurtleState Text -> Parser TurtleState (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Text -> Text
L.cons (Char -> Text -> Text)
-> Parser TurtleState Char -> Parser TurtleState (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'-' Parser TurtleState (Text -> Text)
-> Parser TurtleState Text -> Parser TurtleState Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> Parser TurtleState Text
forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
isaZ09)
    let lbl :: Text
lbl = Text -> Text
L.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
L.append Text
h (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
L.empty Maybe Text
mt
    case Text -> Maybe LanguageTag
toLangTag Text
lbl of
        Just LanguageTag
lt -> LanguageTag -> Parser TurtleState LanguageTag
forall (m :: * -> *) a. Monad m => a -> m a
return LanguageTag
lt
        Maybe LanguageTag
_ -> String -> Parser TurtleState LanguageTag
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid language tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
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 <- Parser TurtleState Char -> Parser TurtleState (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Char -> Bool) -> Parser TurtleState Char
forall s. (Char -> Bool) -> Parser s Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"+-"::String)))
  Maybe Bool -> TurtleParser (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool -> TurtleParser (Maybe Bool))
-> Maybe Bool -> TurtleParser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'+') (Char -> Bool) -> Maybe Char -> Maybe Bool
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 :: Parser TurtleState Text
_integer = do
  Maybe Bool
ms <- TurtleParser (Maybe Bool)
_leadingSign
  Text
rest <- (Char -> Bool) -> Parser TurtleState Text
forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
is09
  Text -> Parser TurtleState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser TurtleState Text)
-> Text -> Parser TurtleState Text
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 :: Parser TurtleState Text
_decimal = do
  Maybe Bool
ms <- TurtleParser (Maybe Bool)
_leadingSign
  Text
leading <- (Char -> Bool) -> Parser TurtleState Text
forall s. (Char -> Bool) -> Parser s Text
manySatisfy Char -> Bool
is09
  Char -> Parser TurtleState ()
forall s. Char -> Parser s ()
ichar Char
'.'
  Text
trailing <- (Char -> Bool) -> Parser TurtleState Text
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
  Text -> Parser TurtleState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser TurtleState Text)
-> Text -> Parser TurtleState Text
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 :: Parser TurtleState Text
_d1 = do
  Text
a <- (Char -> Bool) -> Parser TurtleState Text
forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
is09
  Char -> Parser TurtleState ()
forall s. Char -> Parser s ()
ichar Char
'.'
  Text
b <- (Char -> Bool) -> Parser TurtleState Text
forall s. (Char -> Bool) -> Parser s Text
manySatisfy Char -> Bool
is09
  Text -> Parser TurtleState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser TurtleState Text)
-> Text -> Parser TurtleState Text
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 :: Parser TurtleState Text
_d2 = do
  Char -> Parser TurtleState ()
forall s. Char -> Parser s ()
ichar Char
'.'
  Text
b <- (Char -> Bool) -> Parser TurtleState Text
forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
is09
  Text -> Parser TurtleState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser TurtleState Text)
-> Text -> Parser TurtleState Text
forall a b. (a -> b) -> a -> b
$ Char
'.' Char -> Text -> Text
`L.cons` Text
b

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

_double :: TurtleParser L.Text
_double :: Parser TurtleState Text
_double = do
  Maybe Bool
ms <- TurtleParser (Maybe Bool)
_leadingSign
  Text
leading <- Parser TurtleState Text
_d1 Parser TurtleState Text
-> Parser TurtleState Text -> Parser TurtleState Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TurtleState Text
_d2 Parser TurtleState Text
-> Parser TurtleState Text -> Parser TurtleState Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TurtleState Text
_d3
  Text
e <- Parser TurtleState Text
_exponent
  Text -> Parser TurtleState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser TurtleState Text)
-> Text -> Parser TurtleState Text
forall a b. (a -> b) -> a -> b
$ Maybe Bool -> Text -> Text
addSign Maybe Bool
ms (Text -> Text) -> Text -> Text
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 :: Parser TurtleState Text
_exponent = do
  Char
e <- Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'e' Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'E'
  Maybe Bool
ms <- TurtleParser (Maybe Bool)
_leadingSign
  Char -> Text -> Text
L.cons Char
e (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Bool -> Text -> Text
addSign Maybe Bool
ms (Text -> Text)
-> Parser TurtleState Text -> Parser TurtleState Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TurtleState 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 :: Parser TurtleState Char
_protChar = Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'\\' Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser TurtleState Char
_echar' Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TurtleState Char
_uchar')

_exclSLQ, _exclSLSQ :: String
_exclSLQ :: String
_exclSLQ = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr [Int
0x22, Int
0x5c, Int
0x0a, Int
0x0d]
_exclSLSQ :: String
_exclSLSQ = (Int -> Char) -> [Int] -> String
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 :: Parser TurtleState Text
_stringLiteralQuote = Parser TurtleState ()
-> Parser TurtleState Char -> Parser TurtleState Text
forall a.
TurtleParser a
-> Parser TurtleState Char -> Parser TurtleState Text
_stringIt Parser TurtleState ()
dQuot (String -> Parser TurtleState Char
_tChars String
_exclSLQ)
_stringLiteralSingleQuote :: Parser TurtleState Text
_stringLiteralSingleQuote = Parser TurtleState ()
-> Parser TurtleState Char -> Parser TurtleState Text
forall a.
TurtleParser a
-> Parser TurtleState Char -> Parser TurtleState Text
_stringIt Parser TurtleState ()
sQuot (String -> Parser TurtleState Char
_tChars String
_exclSLSQ)

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

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

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

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

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

_multiQuote :: Char -> TurtleParser L.Text
_multiQuote :: Char -> Parser TurtleState Text
_multiQuote Char
c = do
  Maybe Text
mq <- Parser TurtleState Text -> Parser TurtleState (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser TurtleState Text
oneOrTwo Char
c)
  Char
r <- String -> Parser TurtleState Char
forall s. String -> Parser s Char
noneOf (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
"\\")
  Text -> Parser TurtleState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser TurtleState Text)
-> Text -> Parser TurtleState Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
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 -> Parser TurtleState Text
_tCharsLong Char
c =
  Char -> Text
L.singleton (Char -> Text)
-> Parser TurtleState Char -> Parser TurtleState Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TurtleState Char
_protChar
  Parser TurtleState Text
-> Parser TurtleState Text -> Parser TurtleState Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser TurtleState Text
_multiQuote Char
c

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

_uchar' :: TurtleParser Char
_uchar' :: Parser TurtleState Char
_uchar' =
  (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'u' Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser TurtleState Char -> Parser TurtleState Char
forall (p :: * -> *) a. Commitment p => p a -> p a
commit Parser TurtleState Char
forall a. Parser a Char
hex4 Parser TurtleState Char -> String -> Parser TurtleState Char
forall s a. Parser s a -> String -> Parser s a
<? String
"Expected 4 hex characters after \\u"))
  Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'U' Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser TurtleState Char -> Parser TurtleState Char
forall (p :: * -> *) a. Commitment p => p a -> p a
commit Parser TurtleState Char
forall a. Parser a Char
hex8 Parser TurtleState Char -> String -> Parser TurtleState Char
forall s a. Parser s a -> String -> Parser s a
<? String
"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' :: Parser TurtleState Char
_echar' = 
  (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
't' Parser TurtleState Char -> Char -> Parser TurtleState Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\t') Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'b' Parser TurtleState Char -> Char -> Parser TurtleState Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\b') Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'n' Parser TurtleState Char -> Char -> Parser TurtleState Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\n') Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'r' Parser TurtleState Char -> Char -> Parser TurtleState Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\r') Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'f' Parser TurtleState Char -> Char -> Parser TurtleState Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\f') Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'\\' Parser TurtleState Char -> Char -> Parser TurtleState Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\\') Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'"' Parser TurtleState Char -> Char -> Parser TurtleState Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'"') Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'\'' Parser TurtleState Char -> Char -> Parser TurtleState 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 = Parser TurtleState Char -> Parser TurtleState ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser TurtleState Char -> Parser TurtleState ())
-> Parser TurtleState Char -> Parser TurtleState ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser TurtleState Char
forall s. (Char -> Bool) -> Parser s Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
_wsChars)

_wsChars :: String
_wsChars :: String
_wsChars = (Int -> Char) -> [Int] -> String
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 =
  Char -> Char -> Parser TurtleState [()] -> Parser TurtleState [()]
forall a. Char -> Char -> TurtleParser a -> TurtleParser a
br Char
'[' Char
']' (Parser TurtleState () -> Parser TurtleState [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser TurtleState ()
_ws) Parser TurtleState [()]
-> TurtleParser RDFLabel -> TurtleParser RDFLabel
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 :: Parser TurtleState 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
|| 
               Int -> [(Int, Int)] -> 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 (Char -> Bool) -> Parser TurtleState Char
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 :: Parser TurtleState Char
_pnCharsU = Parser TurtleState Char
_pnCharsBase Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'_'
_pnChars :: Parser TurtleState Char
_pnChars =
  let f :: Char -> Bool
f Char
c = let i :: Int
i = Char -> Int
ord Char
c
            in Int -> [(Int, Int)] -> Bool
forall a. Ord a => a -> [(a, a)] -> Bool
match Int
i [(Int
0x300, Int
0x36f), (Int
0x203f, Int
0x2040)]
  in Parser TurtleState Char
_pnCharsU Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char Char
'-' Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser TurtleState Char
forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
is09 Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     Char -> Parser TurtleState Char
forall s. Char -> Parser s Char
char (Int -> Char
chr Int
0xb7) Parser TurtleState Char
-> Parser TurtleState Char -> Parser TurtleState Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser TurtleState Char
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 :: Parser TurtleState Text
_pnPrefix = Char -> Text -> Text
L.cons (Char -> Text -> Text)
-> Parser TurtleState Char -> Parser TurtleState (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TurtleState Char
_pnCharsBase Parser TurtleState (Text -> Text)
-> Parser TurtleState Text -> Parser TurtleState Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TurtleState Text
_pnRest

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

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

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

--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2013, 2014, 2018, 2020 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
--
--------------------------------------------------------------------------------