swish 0.6.0.1 → 0.6.1.0

raw patch · 11 files changed

+2008/−590 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Swish.hs +6/−4
• Swish/RDF/N3Parser.hs +4/−567
• Swish/RDF/RDFGraph.hs +17/−12
• Swish/RDF/RDFParser.hs +4/−0
• Swish/RDF/SwishCommands.hs +4/−0
• Swish/RDF/SwishMain.hs +2/−2
• Swish/RDF/SwishMonad.hs +4/−2
• Swish/RDF/SwishScript.hs +1/−1
• Swish/RDF/TurtleFormatter.hs +885/−0
• Swish/RDF/TurtleParser.hs +1072/−0
• swish.cabal +9/−2

@@ -28,9 +28,9 @@ --  "Swish.RDF.SwishScript". -- --  Users wishing to process RDF data directly may prefer to look at---  the following modules; "Swish.RDF", "Swish.RDF.N3Parser",---  "Swish.RDF.N3Formatter", "Swish.RDF.NTParser" and---  "Swish.RDF.NTFormatter".+--  the following modules; "Swish.RDF", "Swish.RDF.TurtleParser",+--  "Swish.RDF.N3Parser", "Swish.RDF.N3Formatter", "Swish.RDF.NTParser"+--  and "Swish.RDF.NTFormatter". -- --  (1) Semantic web: <http://www.w3.org/2001/sw/> --@@ -40,7 +40,9 @@ -- --  (4) Notation 3:   <http://www.w3.org/TeamSubmission/2008/SUBM-n3-20080114/> -----  (5) RDF:          <http://www.w3.org/RDF/>+--  (5) Turtle:       <http://www.w3.org/TR/turtle/>+--+--  (6) RDF:          <http://www.w3.org/RDF/> -- -------------------------------------------------------------------------------- 

@@ -449,10 +449,11 @@ is09 c = c >= '0' && c <= '9' isaz09 c = isaz c || is09 c +match :: (Ord a) => a -> [(a,a)] -> Bool+match v = any (\(l,h) -> v >= l && v <= h)+ startChar :: Char -> Bool startChar c = let i = ord c-                  match :: (Ord a) => a -> [(a,a)] -> Bool-                  match v = any (\(l,h) -> v >= l && v <= h)               in c == '_' ||                   match c [('A', 'Z'), ('a', 'z')] ||                  match i [(0x00c0, 0x00d6), (0x00d8, 0x00f6), (0x00f8, 0x02ff), @@ -464,8 +465,6 @@    inBody :: Char -> Bool inBody c = let i = ord c-               match :: (Ord a) => a -> [(a,a)] -> Bool-               match v = any (\(l,h) -> v >= l && v <= h)            in c `elem` "-_" || i == 0x007 ||               match c [('0', '9'), ('A', 'Z'), ('a', 'z')] ||               match i [(0x00c0, 0x00d6), (0x00d8, 0x00f6), (0x00f8, 0x037d), @@ -735,8 +734,7 @@  qname :: N3Parser ScopedName qname =-  -- (char ':' *> toSN getDefaultPrefix)-  (char ':' >> g >>= return . uncurry makeNSScopedName)+  fmap (uncurry makeNSScopedName) (char ':' >> g)   <|> (n3Name >>= fullOrLocalQName)     where       g = (,) <$> getDefaultPrefix <*> (n3Name <|> return "")@@ -1048,14 +1046,6 @@ We change the production rule from objecttail to objectlist for lists of objects (may change back). -May be an optimisation needed in the case of-- :s :p :o1 , .. , :o<large number>.--Is parsec creating the list of actions, using sepBy1-in objectListWith, and then evaluating them all once the list-has been created?- -}  object :: N3Parser RDFLabel@@ -1126,559 +1116,6 @@   atWord "forAll" *>    failBad "universal (@forAll) currently unsupported."    -- will be something like: *> symbolCsl--{----- OLD ---  --- helper routines--isymbol :: String -> N3Parser ()-isymbol s = symbol s >> return ()----  document         = directive* statement-list--document :: N3Parser RDFGraph-document = do-  whiteSpace-  _ <- many directive-  statements-  eof-  s <- getState-  return $ setNamespaces (prefixUris s) (graphState s)-    ---  directive        = "@prefix" prefix ":" uriRef2 "."   // Namespace declaration---                   | "@prefix" ":" uriRef2 "."          // Default namespace---                   | "@equivalence" uriRef2 "."         // Alternative to daml:equivalent---                   | "@listfirst" uriRef2 "."           // Alternative to n3:first---                   | "@listrest"  uriRef2 "."           // Alternative to n3:rest---                   | "@listnull"  uriRef2 "."           // Alternative to n3:null---                   | "@plus"  uriRef2 "."               // Alternative to operator:plus---                   | "@minus" uriRef2 "."               // Alternative to operator:minus---                   | "@slash" uriRef2 "."               // Alternative to operator:slash---                   | "@star"  uriRef2 "."               // Alternative to operator:star---                   | "@base"  uriRef2 "."               // Base URI for relative URIs.--directive :: N3Parser ()-directive = -  (try (symbol "@prefix") >> (defaultPrefix <|> namedPrefix))-  <|> (string "@" >> syntaxUri)-  <?> "directive"--defaultPrefix :: N3Parser ()-defaultPrefix = do-  u <- br ":" "." uriRef2-  updateState $ setPrefix "" (getScopedNameURI u)--namedPrefix :: N3Parser ()-namedPrefix = do-  n <- name-  u <- br ":" "." uriRef2-  updateState $ setPrefix n (getScopedNameURI u)-        -syntaxUri :: N3Parser ()-syntaxUri = do-  s <- uriName-  u <- uriRef2-  isymbol "."-  updateState $ setSUri s (getScopedNameURI u)-        -uriName :: N3Parser String-uriName =-  try (symbol "equivalence")-  <|> try (symbol "listfirst")-  <|> try (symbol "listrest")-  <|> try (symbol "listnull")-  <|> try (symbol "plus")-  <|> try (symbol "minus")-  <|> try (symbol "slash")-  <|> try (symbol "star")-  <|> try (symbol "base")-  <?> "special URI directive"-----  statements       = [ statement ( "." statement )* ]------  statement        = subject property-list------  properties       = [ property ( ";" property )* ]------  New statements are added to the user state graph--statements :: N3Parser ()-statements = sepEndBy1 statement (symbol ".") >> return ()--statement :: N3Parser ()--- statement = subject >>= optional . properties  -- when using Parsec's optional-statement = subject >>= optional . properties >> return () -- not sure this is exactly the same as with Parsec--properties :: RDFLabel -> N3Parser ()-properties subj = sepBy1 (property subj) (symbol ";") >> return ()-----  property         = verb object-list---                   | ":-" anon-node           // Creates anon-node aongside the current node---  verb             = ">-" prop "->"           // has 'prop' of---                   | "<-" prop "<-"           // is  'prop' of---                   | operator                 // has operator:'operator' of (???)---                   | prop                     // has 'prop' of -- shorthand---                   | "has" prop "of"          // has 'prop' of---                   | "is" prop "of"           // is  'prop' of---                   | "a"                      // has rdf:type of---                   | "="                      // has daml:equivalent of------  subj    is the subject node for these properties.------  New statements are added to the graph in the parser's user state.--property :: RDFLabel -> N3Parser ()-property subj =-  (verb >>= uncurry (objects subj))-  <|>-  (isymbol ":-" >> anonNode subj >> return ())--verb :: N3Parser (RDFLabel,Bool)-verb = -  (prop >>= \p -> return (p, False))    -  <|> (operator >>= \p -> return (p, False))-  <|> (br ">-"  "->" prop >>= \p -> return (p, False))-  <|> (br "<-"  "<-" prop >>= \p -> return (p, True))-  <|> (br "has" "of" prop >>= \p -> return (p, False))-  <|> (br "is"  "of" prop >>= \p -> return (p, True))-  <|> (symbol "a" >> operatorLabel rdf_type   >>= \lab -> return (lab, False))-  <|> (symbol "=" >> operatorLabel owl_sameAs >>= \lab -> return (lab, False))-  <?> "property"-----  objects          = object---                   | object "," object-list------  subj    is the subject node for the new statements,---  prop    is the property node for the new statements.---  swap    is true if the subject/object values in the resulting statement---          are to be swapped (for "is <prop> of", etc.)------  New statements are added to the graph in the parser's user state--objects :: RDFLabel -> RDFLabel -> Bool -> N3Parser ()-objects subj ppty swap = -  sepBy1 (object subj ppty swap) (symbol ",") >> return ()----  anonNode         = "[" property-list "]"    // Something with given properties---                   | "{" statement-list "}"   // List of statements as resource---                   | "(" node-list ")"        // Construct list with---                                              //   rdf:first, rdf:rest, rdf:nil------  subj    is the subject node with which the new anonymous node is equated,------  The anonymous node value is returned by this parser (which is often the same---  as the supplied subject node, but not always).------  New statements are added to the graph in the parser's user state---  (in the case of a formula, a new graph and parser are created, and---  the graph arcs are added to this new graph).--anonNode :: RDFLabel -> N3Parser RDFLabel-anonNode subj =-  (br "[" "]" (properties subj) >> return subj)-  <|> br "{" "}" (formula subj)-  <|> br "(" ")" (nodeList subj)-  <?> "anon node (\"[\", \"(\" or \"{\")"----  This method allows a statement list to be parsed as a subgraph---  whose value is associated with the supplied node of the current---  graph.--formula :: RDFLabel -> N3Parser RDFLabel-formula subj = do-  subgr <- subgraph subj-  updateState-    $ updateGraph-    $ setFormula (Formula subj subgr)-  return subj--subgraph :: RDFLabel -> N3Parser RDFGraph-subgraph this = do-  pstate <- getState-  let fstate = pstate { graphState = emptyRDFGraph, thisNode = this }-  setState fstate       -- switch new state into parser-  statements            -- parse statements of formula-  fstate' <- getState-  let nstate = pstate { nodeGen = nodeGen fstate' }-  setState nstate       -- swap back state, with updated nodeGen-  return (graphState fstate')----  prop             = uri-ref2---                   | varid------  Returns URI value as a Node--prop :: N3Parser RDFLabel-prop = nodeid <|> varid <|> uriNode-----  operator         = "+"                      // >- operator:plus ->---                   | "-"                      // >- operator:minus ->---                   | "/"                      // >- operator:slash ->---                   | "*"                      // >- operator:star->------  If matched, the operator is returned as a node value.--operator :: N3Parser RDFLabel-operator =-  (symbol "+" >> operatorLabel operator_plus)-  <|> (symbol "-" >> operatorLabel operator_minus)-  <|> (symbol "*" >> operatorLabel operator_star)-  <|> (symbol "/" >> operatorLabel operator_slash)-  <?> ""----  subject          = node--subject :: N3Parser RDFLabel-subject = node-----  object           = litNode------  This production adds a new triple to the graph state,---  using the supplied subject and property values.---  If swap is True, the subject and object positions are---  swapped.--object :: RDFLabel -> RDFLabel -> Bool -> N3Parser ()-object subj ppty True = do-  o <- litNode-  addStatement o ppty subj--object subj ppty _ = do-  o <- litNode-  addStatement subj ppty o-        ---  nodeList         = litNode*------  subj    is the node from which the list is linked.------  Returns the supplied head of list or Nil node allocated.------  Link first element of link to list head, scan rest of list,---  and return the list head;  otherwise return a node rdf_null.------  This slightly convoluted pattern is to deal with two different---  occurrences of a list node:---    <node> :- ( l1, l2, ... )---      Here, <node> (the supplied subj) is the listhead.---    <node> prop ( l1, l2, ... )---      Here, the a new blank is supplied as subj to be the listhead.---  In either case, if the list is non-empty, the supplied subj---  is returned.  But if the list is empty, a rdf_null node is returned.---  In the second case, the invoking production must use the returned---  value.--nodeList :: RDFLabel -> N3Parser RDFLabel-nodeList subj =-  (do-      val   <- litNode-      first <- operatorLabel rdf_first-      addStatement subj first val-      nodeList1 subj-      return subj)-  <|> operatorLabel rdf_nil-  <?> "Node or ')'"--nodeList1 :: RDFLabel -> N3Parser ()-nodeList1 prev =-  (do-      val   <- litNode-      lnk   <- newBlankNode-      first <- operatorLabel rdf_first-      rest  <- operatorLabel rdf_rest-      addStatement lnk  first val-      addStatement prev rest  lnk-      nodeList1 lnk)-  <|> (do -          nil   <- operatorLabel rdf_nil-          rest  <- operatorLabel rdf_rest-          addStatement prev rest nil)-  <?> "Node or ')'"-----  lit-node         = node---                   | str-node [ "@" lang ] [ "^^" uriRef2 ]---  str-node         = '"' constant-value '"'---                   | '"""' constant value '"""'   // Including single or double occurences of---                                                  //   quotes and/or newlines------  Returns a new node value.--litNode :: N3Parser RDFLabel-litNode = -  node-  <|> liftM2 Lit strNode litTypeOrLang-  <?> "URI, blank node or literal"--strNode :: N3Parser String-strNode =-        tripleQuoteString-    <|> singleQuoteString---litTypeOrLang :: N3Parser (Maybe ScopedName)-litTypeOrLang =-        langTag-    <|> typeUri-    <|> return Nothing-    <?> "'@tag' (language tag) or '^^name' (datatype URI)"--langTag :: N3Parser (Maybe ScopedName)-langTag =-  fmap (Just . langName) (string "@" >> name)-  <?> "'@tag' (language tag)"-                                               -typeUri :: N3Parser (Maybe ScopedName)-typeUri =-  fmap Just (string "^^" >> uriRef2)-  <?> "'^^name' (datatype URI)"----  node             = nodeid---                   | varid---                   | uri-ref2---                   | anon-node------  nodeid           = "_:" name------  varid            = "?" name------  Returns a new node value.--node :: N3Parser RDFLabel-node =  nodeid-    <|> varid-    <|> uriNode-    <|> (newBlankNode >>= anonNode)-    <?> "URI or blank node"----  Identified blank node in input------  Note that automatically generated blank node identifiers start with---  a digit, where input node identifiers start with a letter, so there---  can be no clash.  Care is needed when serializing a graph to ensure---  that future clashes are avoided.--nodeid :: N3Parser RDFLabel--- nodeid = lexeme nodeid1-nodeid = fmap Blank (string "_:" >> name)----  variable identifier--varid :: N3Parser RDFLabel-varid = fmap Var (string "?" >> name)----  uriNode          = qname---                   | "<" URI-reference ">"---                   | "this"--uriNode :: N3Parser RDFLabel-uriNode = -  fmap Res uriRef2-  <|> fmap thisNode (string "this" >> getState)-  <?> "URI node"-----  uriRef2          = qname---                   | ":" local-name---                   | "<" URI-reference ">"---  qname            = prefix ":" local-name------  prefix           = name                         // Namespace prefix------  local-name       = name                         // Local name (namespace qualified)------  name             = alpha alphanumeric*------  alpha            = "a"-"z"---                   | "A"-"Z"---                   | "_"------  alphanumeric     = alpha---                   | "0"-"9"------  URI-reference    = (conforming to syntax in RFC2396)------  uriRef2 returns a ScopedName.--uriRef2 :: N3Parser ScopedName-uriRef2 = lexeme (try uriRef2a)-    <?> "URI or QName"--uriRef2a :: N3Parser ScopedName-uriRef2a =-  liftM2 ScopedName prefix (colon >> localname)-  <|> (colon >> liftM2 ScopedName defaultprefix localname)-  <|> fmap makeUriScopedName absUriRef-  <?> "URI or QName"--prefix :: N3Parser Namespace-prefix = do-  pref <- prefixname-  st   <- getState-  return (getPrefixNs st pref)   -- map prefix to namespace--defaultprefix :: N3Parser Namespace-defaultprefix = do-  st <- getState-  return (getPrefixNs st "")--name :: N3Parser String-name =  lexeme $ name1 identStart--prefixname :: N3Parser String-prefixname =  name1 identStart--localname :: N3Parser String-localname =  lexeme $ name1 identLetter----  'name1' is a name without following whitespace---  initChar is a parser for the first character-name1 :: N3Parser Char -> N3Parser String-name1 initChar =-  liftM2 (:) initChar (many identLetter)-  <?> "identifier"---------------------------------------------------------------------------- Lexical support----------------------------------------------------------------------------- The following code adapted from ParsecToken,--- modified to handle different escape conventions and triple-quoted strings---      \c---      \uhhhh---      \Uhhhhhhhh------ Regular single-quoted string -- cannot be split over line breaks--singleQuoteString :: N3Parser String-singleQuoteString =-    lexeme-    (   between (char '"') (char '"' <?> "end of string (\")") anyStringChars-    <?> "literal string" )--anyStringChars :: CharParser st String-anyStringChars = -  fmap (foldr (maybe id (:)) "") (many stringChar)-      --- Triple-quoted string -- may include line breaks, '"' or '""'.-tripleQuoteString :: N3Parser String-tripleQuoteString =-    lexeme-    (fmap (foldr (++) "") $ between (try $ string "\"\"\"")-                                    (string "\"\"\"" <?> "end of string (\"\"\")")-                                    (many tripleQuoteSubstring))-    <?> "triple-quoted literal string"---- Match non-quote substring or one or two quote characters-tripleQuoteSubstring :: N3Parser String-tripleQuoteSubstring =-        tripleQuoteSubstring1-    <|> try sqTripleQuoteSubstring1-    <|> try dqTripleQuoteSubstring1--dqTripleQuoteSubstring1 :: N3Parser String-dqTripleQuoteSubstring1 = -  fmap ("\"\""++) $ string "\"\"" >> tripleQuoteSubstring1--sqTripleQuoteSubstring1 :: N3Parser String-sqTripleQuoteSubstring1 =-  fmap ('"':) $ char '"' >> tripleQuoteSubstring1---- match at least one non-quote character in a triple-quoted string-tripleQuoteSubstring1 :: N3Parser String-tripleQuoteSubstring1 =-  fmap (foldr (maybe id (:)) "") $ many1 tripleQuoteStringChar--tripleQuoteStringChar :: CharParser st (Maybe Char)-tripleQuoteStringChar =-  stringChar <|> (string "\n" >> return (Just '\n'))--stringChar :: CharParser st (Maybe Char)-stringChar =-  fmap Just stringLetter-  <|> stringEscape-  <?> "string character"--stringLetter :: CharParser st Char-stringLetter    = satisfy (\c -> (c /= '"') && (c /= '\\') && (c >= '\032'))--stringEscape :: CharParser st (Maybe Char)-stringEscape =-  fmap Just $ char '\\' >> escapeCode---- escape codes-escapeCode :: CharParser st Char-escapeCode = charEsc <|> charUCS2 <|> charUCS4 <?> "escape code"---- \c-charEsc :: CharParser st Char-charEsc = choice (map parseEsc escMap)-        where-            parseEsc (c,code) = fmap (const code) (char c)-            escMap            = zip "nrt\\\"\'" "\n\r\t\\\"\'"---- \uhhhh-charUCS2 :: CharParser st Char-charUCS2 =-  fmap chr $ char 'u' >> numberFW 16 hexDigit 4 0---- \Uhhhhhhhh-charUCS4 :: CharParser st Char-charUCS4 =-  fmap chr $ char 'U' >> numberFW 16 hexDigit 8 0---- parse fixed-width number:-numberFW :: Int -> CharParser st Char -> Int -> Int -> CharParser st Int-numberFW _    _         0     val = return val-numberFW base baseDigit width val = do-  d <- baseDigit-  numberFW base baseDigit (width-1) (val*base + digitToInt d)----------------------------------------------------------------------------  Parse a URI reference from the input---  The result returned has absolute form;  relative URIs are resolved---  relative to the current base prefix (set using "@base").-------  lexeme version-lexUriRef :: N3Parser String-lexUriRef = lexeme absUriRef---- from Swish.Utils.ProcessURI-absoluteUriPart :: String -- ^ URI base-                   -> String -- ^ URI reference-                   -> String-absoluteUriPart base rel = showURI $ fromJust $ relativeTo (fromJust (parseURIReference rel)) (fromJust (parseURI base))-  -absUriRef :: N3Parser String-absUriRef = do-  u <- between (char '<') (char '>' <?> "end of URI '>'") anyUriChars-  if isURI u-    then return u-    else if isURIReference u-         then do-           s <- getState-           return $ absoluteUriPart (getSUri s "base") u-         else fail ("Invalid URI: <"++u++">")--anyUriChars :: N3Parser String-anyUriChars = many uriChar--uriChar :: N3Parser Char-uriChar =-        alphaNum-    <|> oneOf "[];?:@&=+$,-_.!~*'()%//#"-    <?> "URI character"---}  -------------------------------------------------------------------------------- --

@@ -89,7 +89,7 @@  import Swish.RDF.GraphClass     ( LDGraph(..), Label (..)-    , Arc(..), arc, arcSubj, arcPred, arcObj+    , Arc(..), arc, arcSubj, arcPred, arcObj, arcLabels     , Selector )  import Swish.RDF.GraphMatch (graphMatch, LabelMap, ScopedLabel(..))@@ -119,6 +119,7 @@ import Network.URI (URI)  import Data.Monoid (Monoid(..))+import Data.Maybe (mapMaybe) import Data.Char (ord, isDigit) import Data.List (intersect, union, findIndices, foldl') import Data.Ord (comparing)@@ -663,11 +664,11 @@ --  first character of local name is '_' and --  remaining characters of local name are all digits isMemberProp :: RDFLabel -> Bool-isMemberProp (Res sn) = getScopeNamespace sn == namespaceRDF &&-                        T.head loc   == '_' &&-                        T.all isDigit (T.tail loc)-                        where-                            loc = getScopeLocal sn+isMemberProp (Res sn) =+  getScopeNamespace sn == namespaceRDF &&+  case T.uncons (getScopeLocal sn) of+    Just ('_', t) -> T.all isDigit t+    _ -> False isMemberProp _        = False  -- |Test if supplied labal is a blank node@@ -1084,12 +1085,16 @@ toRDFGraph :: [RDFTriple] -> RDFGraph -- toRDFGraph arcs = emptyRDFGraph { statements = arcs } toRDFGraph arcs = -  let lbls = concatMap (\(Arc s p o) -> [s,p,o]) arcs-      ns1  = map (getScopeNamespace . getScopedName) (filter isUri lbls)-      ns2  = map (getScopeNamespace . getDataType) (filter isTypedLiteral lbls)-      getDataType (Lit _ (Just dt)) = dt-      getDataType _ = nullScopedName -- should not happen-      nsmap = foldl' mapAddIfNew emptyNamespaceMap (ns1++ns2)+  let lbls = concatMap arcLabels arcs+      +      getNS (Res s) = Just s+      getNS (Lit _ (Just tn)) | not (isLang tn) = Just tn+                              | otherwise = Nothing+      getNS _ = Nothing++      ns = mapMaybe (fmap getScopeNamespace . getNS) lbls+      nsmap = foldl' mapAddIfNew emptyNamespaceMap ns+     in mempty { namespaces = nsmap, statements = arcs }  -- |Create a new, empty RDF graph.

@@ -30,6 +30,7 @@     , string     , stringT     , symbol+    , isymbol     , lexeme     , notFollowedBy     , whiteSpace@@ -206,6 +207,9 @@  symbol :: String -> Parser s String symbol = lexeme . string++isymbol :: String -> Parser s ()+isymbol = ignore . symbol  lexeme :: Parser s a -> Parser s a lexeme p = p <* whiteSpace

@@ -50,9 +50,11 @@ import Swish.RDF.RDFGraph     ( RDFGraph, merge ) +import qualified Swish.RDF.TurtleFormatter as TTLF import qualified Swish.RDF.N3Formatter as N3F import qualified Swish.RDF.NTFormatter as NTF +import Swish.RDF.TurtleParser (parseTurtle) import Swish.RDF.N3Parser (parseN3) import Swish.RDF.NTParser (parseNT) import Swish.RDF.RDFParser (appendURIs)@@ -273,6 +275,7 @@   case fmt of     N3 -> writeOut N3F.formatGraphAsLazyText     NT -> writeOut NTF.formatGraphAsLazyText+    Turtle -> writeOut TTLF.formatGraphAsLazyText     -- _  -> swishError ("Unsupported file format: "++show fmt) SwishArgumentError  ------------------------------------------------------------@@ -348,6 +351,7 @@         Right res -> return $ Just res                 case fmt of+    Turtle -> readIn (`parseTurtle` Just (getQNameURI buri))     N3 -> readIn (`parseN3` Just buri)     NT -> readIn parseNT     {-

@@ -25,8 +25,6 @@ -- --  * Add RDF/XML input and output -----  * Add Turtle and related formats for input and output---  module Swish.RDF.SwishMain (   SwishStatus(..), SwishAction,@@ -89,6 +87,7 @@     , "-v        display Swish version and quit."     , "-q        do not display Swish version on start up."     , "-nt       use Ntriples format for subsequent input and output."+    , "-ttl      use Turtle format for subsequent input and output."     , "-n3       use Notation3 format for subsequent input and output (default)"     , "-i[=file] read file in selected format into the graph workspace,"     , "          replacing any existing graph."@@ -179,6 +178,7 @@              wrap f = Right $ SA $ f marg   in case nam of+    "-ttl"  -> wrap $ swishFormat Turtle     "-nt"   -> wrap $ swishFormat NT     "-n3"   -> wrap $ swishFormat N3     "-i"    -> wrap swishInput

@@ -80,13 +80,15 @@ The supported input and output formats. -} data SwishFormat = -  N3  -- ^ N3 format-  | NT -- ^ NTriples format+  Turtle  -- ^ Turtle format+  | N3    -- ^ N3 format+  | NT    -- ^ NTriples format     deriving Eq  instance Show SwishFormat where   show N3  = "N3"   show NT  = "Ntriples"+  show Turtle = "Turtle"   -- show RDF = "RDF/XML"  -- | The State for a Swish \"program\".

@@ -890,7 +890,7 @@             ; return $ Right dat             }     fromUri = fromFile-    fromFile uri | uriScheme uri == "file:" = Right `fmap` (lift $ LIO.readFile $ uriPath uri)+    fromFile uri | uriScheme uri == "file:" = Right `fmap` lift (LIO.readFile $ uriPath uri)                  | otherwise = error $ "Unsupported file name for read: " ++ show uri                                 --  Temporary implementation:  just write local file

@@ -0,0 +1,885 @@+{-# LANGUAGE OverloadedStrings #-}++--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  TurtleFormatter+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  OverloadedStrings+--+--  This Module implements a Turtle formatter (see [1])+--  for an RDFGraph value.+--+-- REFERENCES:+--+-- 1 <http://www.w3.org/TR/turtle/>+--     Turtle, Terse RDF Triple Language+--     W3C Working Draft 09 August 2011 (<http://www.w3.org/TR/2011/WD-turtle-20110809/>)+--+--------------------------------------------------------------------------------++{-+TODO:++The code used to determine whether a blank node can be written+using the "[]" short form could probably take advantage of the+GraphPartition module.++-}++module Swish.RDF.TurtleFormatter+    ( NodeGenLookupMap+    , formatGraphAsText+    , formatGraphAsLazyText+    , formatGraphAsBuilder+    , formatGraphIndent  +    , formatGraphDiag+    )+where++import Swish.RDF.RDFGraph (+  RDFGraph, RDFLabel(..)+  , NamespaceMap, RevNamespaceMap+  -- emptyNamespaceMap,+  -- FormulaMap, emptyFormulaMap,+  , getArcs+  , labels+  -- , setNamespaces+  , getNamespaces,+  -- getFormulae,+  emptyRDFGraph+  , quote+  , quoteT+  , resRdfFirst, resRdfRest, resRdfNil+  )++import Swish.RDF.Vocabulary (+  isLang+  , langTag +  , rdfType+  , rdfNil+  , xsdBoolean, xsdDecimal, xsdInteger, xsdDouble +  )++import Swish.RDF.GraphClass (Arc(..))++import Swish.Utils.LookupMap+    ( LookupEntryClass(..)+    , LookupMap, emptyLookupMap, reverseLookupMap+    , listLookupMap+    , mapFind, mapFindMaybe, mapAdd+    -- , mapDelete+    , mapMerge+    )++import Swish.Utils.Namespace (ScopedName, getScopeLocal, getScopeURI)++import Data.Char (isDigit)++import Data.List (foldl', delete, groupBy, partition, sort, intersperse)++import Data.Monoid (Monoid(..))+import Control.Monad (liftM, when)+import Control.Monad.State (State, modify, get, put, runState)++-- it strikes me that using Lazy Text here is likely to be+-- wrong; however I have done no profiling to back this+-- assumption up!++import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Builder as B++-- temporary conversion+quoteB :: Bool -> String -> B.Builder+quoteB f v = B.fromString $ quote f v++----------------------------------------------------------------------+--  Graph formatting state monad+----------------------------------------------------------------------+--+--  The graph to be formatted is carried as part of the formatting+--  state, so that decisions about what needs to be formatted can+--  themselves be based upon and reflected in the state (e.g. if a+--  decision is made to include a blank node inline, it can be removed+--  from the graph state that remains to be formatted).++type SubjTree lb = [(lb,PredTree lb)]+type PredTree lb = [(lb,[lb])]++data TurtleFormatterState = TFS+    { indent    :: B.Builder+    , lineBreak :: Bool+    , graph     :: RDFGraph+    , subjs     :: SubjTree RDFLabel+    , props     :: PredTree RDFLabel   -- for last subject selected+    , objs      :: [RDFLabel]          -- for last property selected+    -- , formAvail :: FormulaMap RDFLabel+    -- , formQueue :: [(RDFLabel,RDFGraph)]+    , nodeGenSt :: NodeGenState+    , bNodesCheck   :: [RDFLabel]      -- these bNodes are not to be converted to '[..]' format+    , traceBuf  :: [String]+    }+             +type Formatter a = State TurtleFormatterState a++emptyTFS :: NodeGenState -> TurtleFormatterState+emptyTFS ngs = TFS+    { indent    = "\n"+    , lineBreak = False+    , graph     = emptyRDFGraph+    , subjs     = []+    , props     = []+    , objs      = []+    -- , formAvail = emptyFormulaMap+    -- , formQueue = []+    , nodeGenSt = ngs+    , bNodesCheck   = []+    , traceBuf  = []+    }++--  | Node name generation state information that carries through+--  and is updated by nested formulae+type NodeGenLookupMap = LookupMap (RDFLabel,Int)++data NodeGenState = Ngs+    { prefixes  :: NamespaceMap+    , nodeMap   :: NodeGenLookupMap+    , nodeGen   :: Int+    }++emptyNgs :: NodeGenState+emptyNgs = Ngs+    { prefixes  = emptyLookupMap+    , nodeMap   = emptyLookupMap+    , nodeGen   = 0+    }++-- simple context for label creation+-- (may be a temporary solution to the problem+--  of label creation)+--+data LabelContext = SubjContext | PredContext | ObjContext+                    deriving (Eq, Show)++getIndent :: Formatter B.Builder+getIndent = indent `liftM` get++setIndent :: B.Builder -> Formatter ()+setIndent ind = modify $ \st -> st { indent = ind }++getLineBreak :: Formatter Bool+getLineBreak = lineBreak `liftM` get++setLineBreak :: Bool -> Formatter ()+setLineBreak brk = modify $ \st -> st { lineBreak = brk }++getNgs :: Formatter NodeGenState+getNgs = nodeGenSt `liftM` get++setNgs :: NodeGenState -> Formatter ()+setNgs ngs = modify $ \st -> st { nodeGenSt = ngs }++getPrefixes :: Formatter NamespaceMap+getPrefixes = prefixes `liftM` getNgs++getSubjs :: Formatter (SubjTree RDFLabel)+getSubjs = subjs `liftM` get++setSubjs :: SubjTree RDFLabel -> Formatter ()+setSubjs sl = modify $ \st -> st { subjs = sl }++getProps :: Formatter (PredTree RDFLabel)+getProps = props `liftM` get++setProps :: PredTree RDFLabel -> Formatter ()+setProps ps = modify $ \st -> st { props = ps }++{-+getObjs :: Formatter ([RDFLabel])+getObjs = objs `liftM` get++setObjs :: [RDFLabel] -> Formatter ()+setObjs os = do+  st <- get+  put $ st { objs = os }+-}++getBnodesCheck :: Formatter [RDFLabel]+getBnodesCheck = bNodesCheck `liftM` get++{-+addTrace :: String -> Formatter ()+addTrace tr = do+  st <- get+  put $ st { traceBuf = tr : traceBuf st }+-}+  +{-+queueFormula :: RDFLabel -> Formatter ()+queueFormula fn = do+  st <- get+  let fa = formAvail st+      newState fv = st {+                      formAvail = mapDelete fa fn,+                      formQueue = (fn,fv) : formQueue st+                    }+  case mapFindMaybe fn fa of+    Nothing -> return ()+    Just v -> put (newState v) >> return ()+-}++{-+Return the graph associated with the label and delete it+from the store, if there is an association, otherwise+return Nothing.++extractFormula :: RDFLabel -> Formatter (Maybe RDFGraph)+extractFormula fn = do+  st <- get+  let fa = formAvail st+      newState = st { formAvail=mapDelete fa fn }+  case mapFindMaybe fn fa of+    Nothing -> return Nothing+    Just fv -> put newState >> return (Just fv)++-}++{-+moreFormulae :: Formatter Bool+moreFormulae =  do+  st <- get+  return $ not $ null (formQueue st)++nextFormula :: Formatter (RDFLabel,RDFGraph)+nextFormula = do+  st <- get+  let (nf : fq) = formQueue st+  put $ st { formQueue = fq }+  return nf++-}++-- list has a length of 1+len1 :: [a] -> Bool+len1 (_:[]) = True+len1 _ = False++{-|+Given a set of statements and a label, return the details of the+RDF collection referred to by label, or Nothing.++For label to be considered as representing a collection we require the+following conditions to hold (this is only to support the+serialisation using the '(..)' syntax and does not make any statement+about semantics of the statements with regard to RDF Collections):++  - there must be one rdf_first and one rdfRest statement+  - there must be no other predicates for the label++-} +getCollection ::          +  SubjTree RDFLabel -- ^ statements organized by subject+  -> RDFLabel -- ^ does this label represent a list?+  -> Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])+     -- ^ the statements with the elements removed; the+     -- content elements of the collection (the objects of the rdf:first+     -- predicate) and the nodes that represent the spine of the+     -- collection (in reverse order, unlike the actual contents which are in+     -- order).+getCollection subjList lbl = go subjList lbl ([],[]) +    where+      go sl l (cs,ss) | l == resRdfNil = Just (sl, reverse cs, ss)+                      | otherwise = do+        (pList1, sl') <- removeItem sl l+        (pFirst, pList2) <- removeItem pList1 resRdfFirst+        (pNext, pList3) <- removeItem pList2 resRdfRest++        -- QUS: could I include these checks implicitly in the pattern matches above?+        -- ie instrad of (pFirst, pos1) <- ..+        -- have ([content], pos1) <- ...+        -- ?+        if and [len1 pFirst, len1 pNext, null pList3]+          then go sl' (head pNext) (head pFirst : cs, l : ss)+          else Nothing++{-+TODO:++Should we change the preds/objs entries as well?++-}+extractList :: LabelContext -> RDFLabel -> Formatter (Maybe [RDFLabel])+extractList lctxt ln = do+  osubjs <- getSubjs+  oprops <- getProps+  let mlst = getCollection osubjs' ln++      -- we only want to send in rdf:first/rdf:rest here+      fprops = filter ((`elem` [resRdfFirst, resRdfRest]) . fst) oprops++      osubjs' =+          case lctxt of+            SubjContext -> (ln, fprops) : osubjs+            _ -> osubjs ++      -- tr = "extractList " ++ show ln ++ " (" ++ show lctxt ++ ")\n -> osubjs= " ++ show osubjs ++ "\n -> opreds= " ++ show oprops ++ "\n -> mlst= " ++ show mlst ++ "\n"+  -- addTrace tr+  case mlst of+    -- sl is guaranteed to be free of (ln,fprops) here if lctxt is SubjContext+    Just (sl,ls,_) -> do+              setSubjs sl+              when (lctxt == SubjContext) $ setProps $ filter ((`notElem` [resRdfFirst, resRdfRest]) . fst) oprops+              return (Just ls)++    Nothing -> return Nothing+  +{-|+Removes the first occurrence of the item from the+association list, returning it's contents and the rest+of the list, if it exists.+-}+removeItem :: (Eq a) => [(a,b)] -> a -> Maybe (b, [(a,b)])+removeItem os x =+  let (as, bs) = break (\a -> fst a == x) os+  in case bs of+    ((_,b):bbs) -> Just (b, as ++ bbs)+    [] -> Nothing++----------------------------------------------------------------------+--  Define a top-level formatter function:+----------------------------------------------------------------------++formatGraphAsText :: RDFGraph -> T.Text+formatGraphAsText = L.toStrict . formatGraphAsLazyText++formatGraphAsLazyText :: RDFGraph -> L.Text+formatGraphAsLazyText = B.toLazyText . formatGraphAsBuilder+  +formatGraphAsBuilder :: RDFGraph -> B.Builder+formatGraphAsBuilder = formatGraphIndent "\n" True+  +formatGraphIndent :: B.Builder -> Bool -> RDFGraph -> B.Builder+formatGraphIndent indnt flag gr = +  let (res, _, _, _) = formatGraphDiag indnt flag gr+  in res+  +-- | Format graph and return additional information+formatGraphDiag :: +  B.Builder  -- ^ indentation+  -> Bool    -- ^ are prefixes to be generated?+  -> RDFGraph +  -> (B.Builder, NodeGenLookupMap, Int, [String])+formatGraphDiag indnt flag gr = +  let fg  = formatGraph indnt " .\n" False flag gr+      ngs = emptyNgs {+        prefixes = emptyLookupMap,+        nodeGen  = findMaxBnode gr+        }+             +      (out, fgs) = runState fg (emptyTFS ngs)+      ogs        = nodeGenSt fgs+  +  in (out, nodeMap ogs, nodeGen ogs, traceBuf fgs)++----------------------------------------------------------------------+--  Formatting as a monad-based computation+----------------------------------------------------------------------++formatGraph :: +  B.Builder     -- indentation string+  -> B.Builder  -- text to be placed after final statement+  -> Bool       -- True if a line break is to be inserted at the start+  -> Bool       -- True if prefix strings are to be generated+  -> RDFGraph   -- graph to convert+  -> Formatter B.Builder+formatGraph ind end dobreak dopref gr = do+  setIndent ind+  setLineBreak dobreak+  setGraph gr+  +  fp <- if dopref+        then formatPrefixes (getNamespaces gr)+        else return mempty+  more <- moreSubjects+  if more+    then do+      fr <- formatSubjects+      return $ mconcat [fp, fr, end]+    else return fp++formatPrefixes :: NamespaceMap -> Formatter B.Builder+formatPrefixes pmap = do+  let mls = map (pref . keyVal) (listLookupMap pmap)+  ls <- sequence mls+  return $ mconcat ls+    where+      pref (Just p,u) = nextLine $ mconcat ["@prefix ", B.fromText p, ": <", quoteB True (show u), "> ."]+      pref (_,u)      = nextLine $ mconcat ["@prefix : <", quoteB True (show u), "> ."]++{-+NOTE:+I expect there to be confusion below where I need to+convert from Text to Builder+-}++formatSubjects :: Formatter B.Builder+formatSubjects = do+  sb    <- nextSubject+  sbstr <- formatLabel SubjContext sb+  +  flagP <- moreProperties+  if flagP+    then do+      prstr <- formatProperties sb sbstr+      flagS <- moreSubjects+      if flagS+        then do+          fr <- formatSubjects+          return $ mconcat [prstr, " .", fr]+        else return prstr+           +    else do+      txt <- nextLine sbstr+    +      flagS <- moreSubjects+      if flagS+        then do+          fr <- formatSubjects+          return $ mconcat [txt, " .", fr]+        else return txt++{-+TODO: now we are throwing a Builder around it is awkward to+get the length of the text to calculate the indentation++So++  a) change the indentation scheme+  b) pass around text instead of builder++mkIndent :: L.Text -> L.Text+mkIndent inVal = L.replicate (L.length inVal) " "+-}++hackIndent :: B.Builder+hackIndent = "    "++formatProperties :: RDFLabel -> B.Builder -> Formatter B.Builder+formatProperties sb sbstr = do+  pr <- nextProperty sb+  prstr <- formatLabel PredContext pr+  obstr <- formatObjects sb pr $ mconcat [sbstr, " ", prstr]+  more  <- moreProperties+  let sbindent = hackIndent -- mkIndent sbstr+  if more+    then do+      fr <- formatProperties sb sbindent+      nl <- nextLine $ obstr `mappend` " ;"+      return $ nl `mappend` fr+    else nextLine obstr++formatObjects :: RDFLabel -> RDFLabel -> B.Builder -> Formatter B.Builder+formatObjects sb pr prstr = do+  ob    <- nextObject sb pr+  obstr <- formatLabel ObjContext ob+  more  <- moreObjects+  if more+    then do+      let prindent = hackIndent -- mkIndent prstr+      fr <- formatObjects sb pr prindent+      nl <- nextLine $ mconcat [prstr, " ", obstr, ","]+      return $ nl `mappend` fr+    else return $ mconcat [prstr, " ", obstr]++{-+Add a list inline. We are given the labels that constitute+the list, in order, so just need to display them surrounded+by ().+-}+insertList :: [RDFLabel] -> Formatter B.Builder+insertList [] = return "()" -- not convinced this can happen+insertList xs = do+  ls <- mapM (formatLabel ObjContext) xs+  return $ mconcat ("( " : intersperse " " ls) `mappend` " )"+    +{-+Add a blank node inline.+-}++insertBnode :: LabelContext -> RDFLabel -> Formatter B.Builder+insertBnode SubjContext lbl = do+  -- a safety check+  flag <- moreProperties+  if flag+    then do+      txt <- (`mappend` "\n") `liftM` formatProperties lbl ""+      return $ mconcat ["[] ", txt]+    else error $ "Internal error: expected properties with label: " ++ show lbl++insertBnode _ lbl = do+  ost <- get+  let osubjs = subjs ost+      oprops = props ost+      oobjs  = objs  ost++      (bsubj, rsubjs) = partition ((== lbl) . fst) osubjs++      rprops = case bsubj of+                 [(_,rs)] -> rs+                 _ -> []++      -- we essentially want to create a new subgraph+      -- for this node but it's not as simple as that since+      -- we could have something like+      --     :a :b [ :foo [ :bar "xx" ] ]+      -- so we still need to carry around the whole graph+      --+      nst = ost { subjs = rsubjs,+                  props = rprops,+                  objs  = []+                }++  put nst+  flag <- moreProperties+  txt <- if flag+         then (`mappend` "\n") `liftM` formatProperties lbl ""+         else return ""++  -- TODO: how do we restore the original set up?+  --       I can't believe the following is sufficient+  --+  nst' <- get+  let slist  = map fst $ subjs nst'+      nsubjs = filter (\(l,_) -> l `elem` slist) osubjs++  put $ nst' { subjs = nsubjs,+                       props = oprops, +                       objs  = oobjs+             }++  -- TODO: handle indentation?+  return $ mconcat ["[", txt, "]"]+  +----------------------------------------------------------------------+--  Formatting helpers+----------------------------------------------------------------------++setGraph :: RDFGraph -> Formatter ()+setGraph gr = do+  st <- get++  let ngs0 = nodeGenSt st+      pre' = mapMerge (prefixes ngs0) (getNamespaces gr)+      ngs' = ngs0 { prefixes = pre' }+      arcs = sortArcs $ getArcs gr+      nst  = st  { graph     = gr+                 , subjs     = arcTree arcs+                 , props     = []+                 , objs      = []+                 -- , formAvail = getFormulae gr+                 , nodeGenSt = ngs'+                 , bNodesCheck   = countBnodes arcs+                 }++  put nst++hasMore :: (TurtleFormatterState -> [b]) -> Formatter Bool+hasMore lens = (not . null . lens) `liftM` get++moreSubjects :: Formatter Bool+moreSubjects = hasMore subjs+-- moreSubjects = (not . null . subjs) `liftM` get++moreProperties :: Formatter Bool+moreProperties = hasMore props+-- moreProperties = (not . null . props) `liftM` get++moreObjects :: Formatter Bool+moreObjects = hasMore objs+-- moreObjects = (not . null . objs) `liftM` get++nextSubject :: Formatter RDFLabel+nextSubject = do+  st <- get++  let sb:sbs = subjs st+      nst = st  { subjs = sbs+                , props = snd sb+                , objs  = []+                }++  put nst+  return $ fst sb++nextProperty :: RDFLabel -> Formatter RDFLabel+nextProperty _ = do+  st <- get++  let pr:prs = props st+      nst = st  { props = prs+                 , objs  = snd pr+                 }++  put nst+  return $ fst pr++nextObject :: RDFLabel -> RDFLabel -> Formatter RDFLabel+nextObject _ _ = do+  st <- get++  let ob:obs = objs st+      nst = st { objs = obs }++  put nst+  return ob++nextLine :: B.Builder -> Formatter B.Builder+nextLine str = do+  ind <- getIndent+  brk <- getLineBreak+  if brk+    then return $ ind `mappend` str+    else do+      --  After first line, always insert line break+      setLineBreak True+      return str++--  Format a label+--  Most labels are simply displayed as provided, but there are a+--  number of wrinkles to take care of here:+--  (a) blank nodes automatically allocated on input, with node+--      identifiers of the form of a digit string nnn.  These are+--      not syntactically valid, and are reassigned node identifiers+--      of the form _nnn, where nnn is chosen so that is does not+--      clash with any other identifier in the graph.+--  (b) URI nodes:  if possible, replace URI with qname,+--      else display as <uri>+--  (c) formula nodes (containing graphs).+--  (d) use the "special-case" formats for integer/float/double+--      literals.      +--      +--  [[[TODO:]]]+--  (d) generate multi-line literals when appropriate+--+-- This is being updated to produce inline formula, lists and     +-- blank nodes. The code is not efficient.+--+--+-- Note: There is a lot less customisation possible in Turtle than N3.+--      ++formatLabel :: LabelContext -> RDFLabel -> Formatter B.Builder++{-+The "[..]" conversion is done last, after "()" and "{}" checks.+-}+formatLabel lctxt lab@(Blank (_:_)) = do+  mlst <- extractList lctxt lab+  case mlst of+    Just lst -> insertList lst+    Nothing -> do+      -- NOTE: unlike N3 we do not properly handle "formula"/named graphs+      -- also we only expand out bnodes into [...] format when it's a object.+      -- although we need to handle [] for the subject.+      nb1 <- getBnodesCheck+      if lctxt /= PredContext && lab `notElem` nb1+        then insertBnode lctxt lab+        else formatNodeId lab++-- formatLabel _ lab@(Res sn) = +formatLabel ctxt (Res sn)+  | ctxt == PredContext && sn == rdfType = return "a"+  | ctxt == ObjContext  && sn == rdfNil  = return "()"+  | otherwise = do+  pr <- getPrefixes+  let nsuri  = getScopeURI sn+      local  = getScopeLocal sn+      premap = reverseLookupMap pr :: RevNamespaceMap+      prefix = mapFindMaybe nsuri premap+          +      name   = case prefix of+        Just (Just p) -> B.fromText $ quoteT True $ mconcat [p, ":", local] -- TODO: what are quoting rules for QNames+        _ -> mconcat ["<", quoteB True (show nsuri ++ T.unpack local), ">"]+      +  return name++-- The canonical notation for xsd:double in XSD, with an upper-case E,+-- does not match the syntax used in N3, so we need to convert here.     +-- Rather than converting back to a Double and then displaying that       +-- we just convert E to e for now.      +--      +formatLabel _ (Lit lit (Just dtype)) +  | dtype == xsdDouble = return $ B.fromText $ T.toLower lit+  | dtype `elem` [xsdBoolean, xsdDecimal, xsdInteger] = return $ B.fromText lit+  | otherwise = return $ quoteText lit `mappend` formatAnnotation dtype+formatLabel _ (Lit lit Nothing) = return $ quoteText lit++formatLabel _ lab = return $ B.fromString $ show lab++-- the annotation for a literal (ie type or language)+formatAnnotation :: ScopedName -> B.Builder+formatAnnotation a  | isLang a  = "@" `mappend` B.fromText (langTag a)+                    | otherwise = "^^" `mappend` showScopedName a++{-+We have to decide whether to use " or """ to quote+the string.++There is also no need to restrict the string to the+ASCII character set; this could be an option but we+can also leave Unicode as is (or at least convert to UTF-8).++If we use """ to surround the string then we protect the+last character if it is a " (assuming it isn't protected).+-}++quoteText :: T.Text -> B.Builder+quoteText txt = +  let st = T.unpack txt -- TODO: fix+      qst = quoteB (n==1) st+      n = if '\n' `elem` st || '"' `elem` st then 3 else 1+      qch = B.fromString (replicate n '"')+  in mconcat [qch, qst, qch]++formatNodeId :: RDFLabel -> Formatter B.Builder+formatNodeId lab@(Blank (lnc:_)) =+    if isDigit lnc then mapBlankNode lab else return $ B.fromString $ show lab+formatNodeId other = error $ "formatNodeId not expecting a " ++ show other -- to shut up -Wall++mapBlankNode :: RDFLabel -> Formatter B.Builder+mapBlankNode lab = do+  ngs <- getNgs+  let cmap = nodeMap ngs+      cval = nodeGen ngs+  nv <- case mapFind 0 lab cmap of+    0 -> do +      let nval = succ cval+          nmap = mapAdd cmap (lab, nval)+      setNgs $ ngs { nodeGen = nval, nodeMap = nmap }+      return nval+      +    n -> return n+  +  -- TODO: is this what we want?+  return $ "_:swish" `mappend` B.fromString (show nv)++-- TODO: need to be a bit more clever with this than we did in NTriples+--       not sure the following counts as clever enough ...+--  +showScopedName :: ScopedName -> B.Builder+{-+showScopedName (ScopedName n l) = +  let uri = nsURI n ++ l+  in quote uri+-}+showScopedName = quoteB True . show++----------------------------------------------------------------------+--  Graph-related helper functions+----------------------------------------------------------------------++newtype SortedArcs lb = SA [Arc lb]++sortArcs :: (Ord lb) => [Arc lb] -> SortedArcs lb+sortArcs = SA . sort++--  Rearrange a list of arcs into a tree of pairs which group together+--  all statements for a single subject, and similarly for multiple+--  objects of a common predicate.+--+arcTree :: (Eq lb) => SortedArcs lb -> SubjTree lb+arcTree (SA as) = commonFstEq (commonFstEq id) $ map spopair as+    where+        spopair (Arc s p o) = (s,(p,o))++{-+arcTree as = map spopair $ sort as+    where+        spopair (Arc s p o) = (s,[(p,[o])])+-}++--  Rearrange a list of pairs so that multiple occurrences of the first+--  are commoned up, and the supplied function is applied to each sublist+--  with common first elements to obtain the corresponding second value+commonFstEq :: (Eq a) => ( [b] -> c ) -> [(a,b)] -> [(a,c)]+commonFstEq f ps =+    [ (fst $ head sps,f $ map snd sps) | sps <- groupBy fstEq ps ]+    where+        fstEq (f1,_) (f2,_) = f1 == f2++findMaxBnode :: RDFGraph -> Int+findMaxBnode = maximum . map getAutoBnodeIndex . labels++getAutoBnodeIndex   :: RDFLabel -> Int+getAutoBnodeIndex (Blank ('_':lns)) = res where+    -- cf. prelude definition of read s ...+    res = case [x | (x,t) <- reads lns, ("","") <- lex t] of+            [x] -> x+            _   -> 0+getAutoBnodeIndex _                   = 0++{-+Find all blank nodes that occur+  - any number of times as a subject+  - 0 or 1 times as an object++Such nodes can be output using the "[..]" syntax. To make it simpler+to check we actually store those nodes that can not be expanded.++Note that we do not try and expand any bNode that is used in+a predicate position.++Should probably be using the SubjTree RDFLabel structure but this+is easier for now.++-}++countBnodes :: SortedArcs RDFLabel -> [RDFLabel]+countBnodes (SA as) = snd (foldl' ctr ([],[]) as)+    where+      -- first element of tuple are those blank nodes only seen once,+      -- second element those blank nodes seen multiple times+      --+      inc b@(b1s,bms) l@(Blank _) | l `elem` bms = b+                                  | l `elem` b1s = (delete l b1s, l:bms)+                                  | otherwise    = (l:b1s, bms)+      inc b _ = b++      -- if the bNode appears as a predicate we instantly add it to the+      -- list of nodes not to expand, even if only used once+      incP b@(b1s,bms) l@(Blank _) | l `elem` bms = b+                                   | l `elem` b1s = (delete l b1s, l:bms)+           			   | otherwise    = (b1s, l:bms)+      incP b _ = b++      ctr orig (Arc _ p o) = inc (incP orig p) o++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------

@@ -0,0 +1,1072 @@+{-# LANGUAGE OverloadedStrings #-} -- only used in 'fromMaybe "" mbase' line of parseN3++--------------------------------------------------------------------------------+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  TurtleParser+--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+--  License     :  GPL V2+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  OverloadedStrings+--+--  This Module implements a Turtle parser (see [1]), returning a+--  new 'RDFGraph' consisting of triples and namespace information parsed from+--  the supplied input string, or an error indication.+--+-- REFERENCES:+--+-- 1 <http://www.w3.org/TR/turtle/>+--     Turtle, Terse RDF Triple Language+--     W3C Working Draft 09 August 2011 (<http://www.w3.org/TR/2011/WD-turtle-20110809/>)+--+-- Notes:+--+-- At present there is a lot of overlap with the N3 Parser.+--+--------------------------------------------------------------------------------++module Swish.RDF.TurtleParser+    ( ParseResult+    , parseTurtle      +    , parseTurtlefromText      +    {-+    , parseAnyfromText+    , parseTextFromText, parseAltFromText+    , parseNameFromText -- , parsePrefixFromText+    , parseAbsURIrefFromText, parseLexURIrefFromText, parseURIref2FromText+    -}+      +      {-+    -- * Exports for parsers that embed Turtle in a bigger syntax+    , TurtleParser, TurtleState(..), SpecialMap+    +    , getPrefix -- a combination of the old defaultPrefix and namedPrefix productions+    , n3symbol -- replacement for uriRef2 -- TODO: check this is semantically correct      +    , quickVariable -- was varid      +    , lexUriRef       +    , document, subgraph                                                   +    , newBlankNode+       -}+    )+where++import Swish.RDF.RDFGraph+    ( RDFGraph, RDFLabel(..)+    , ToRDFLabel(..)+    , NamespaceMap+    , addArc +    , setNamespaces+    , emptyRDFGraph+    )++import Swish.RDF.GraphClass (arc)++import Swish.Utils.LookupMap+    ( LookupMap(..)+    , LookupEntryClass(..)+    , mapFindMaybe, mapReplaceOrAdd, mapAdd, mapReplace )++import Swish.Utils.Namespace+    ( Namespace, makeNamespace+    , ScopedName+    , getScopeNamespace+    , getScopedNameURI+    , getScopeNamespace+    , makeURIScopedName+    , makeNSScopedName+    )++import Swish.RDF.Vocabulary+    ( langName+    , rdfType+    , rdfFirst, rdfRest, rdfNil+    , xsdBoolean, xsdInteger, xsdDecimal, xsdDouble+    , defaultBase+    )++import Swish.RDF.RDFParser+    ( ParseResult+    -- , prefixTable+    , ignore+    -- , notFollowedBy+    -- , endBy+    -- , sepEndBy+    -- , manyTill+    , noneOf+    , char+    , ichar+    , string+    , stringT+    , symbol+    , isymbol+    , lexeme+    , whiteSpace+    , mkTypedLit+    , hex4  +    , hex8  +    , appendURIs+    )++import Control.Applicative+import Control.Monad (foldM)++import Network.URI (URI(..), parseURIReference)++import Data.Char (ord) +import Data.Maybe (fromMaybe, fromJust)++import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import Text.ParserCombinators.Poly.StateText++----------------------------------------------------------------------+-- Define parser state and helper functions+----------------------------------------------------------------------++-- | Turtle parser state+data TurtleState = TurtleState+        { graphState :: RDFGraph            -- Graph under construction+        , prefixUris :: NamespaceMap        -- namespace prefix mapping table+        , baseUri    :: URI                 -- base URI+        , nodeGen    :: Int                 -- blank node id generator+        } deriving Show++-- | Functions to update TurtleState vector (use with stUpdate)++setPrefix :: Maybe T.Text -> URI -> TurtleState -> TurtleState+setPrefix pre uri st =  st { prefixUris=p' }+    where+        p' = mapReplaceOrAdd (makeNamespace pre uri) (prefixUris st)++-- | Change the base+setBase :: URI -> TurtleState -> TurtleState+setBase buri st = st { baseUri = buri }++--  Functions to access state:++-- | Return the default prefix+getDefaultPrefix :: TurtleParser Namespace+getDefaultPrefix = do+  s <- stGet+  case getPrefixURI s Nothing of+    Just uri -> return $ makeNamespace Nothing uri+    _ -> failBad "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 st pre = mapFindMaybe pre (prefixUris st)++findPrefixNamespace :: Maybe L.Text -> TurtleParser Namespace+findPrefixNamespace (Just p) = findPrefix (L.toStrict p)+findPrefixNamespace Nothing  = getDefaultPrefix++--  Return function to update graph in Turtle parser state,+--  using the supplied function of a graph+--+updateGraph :: (RDFGraph -> RDFGraph) -> TurtleState -> TurtleState+updateGraph f s = s { graphState = f (graphState 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 = flip parseTurtle 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 txt mbase = parseAnyfromText turtleDoc mbase txt++hashURI :: URI+hashURI = fromJust $ parseURIReference "#"++emptyState :: +  Maybe URI  -- ^ starting base for the graph+  -> TurtleState+emptyState mbase = +  let pmap   = LookupMap [makeNamespace Nothing hashURI]+      buri   = fromMaybe (getScopedNameURI defaultBase) mbase+  in TurtleState+     { graphState = emptyRDFGraph+     , prefixUris = pmap+     , baseUri    = buri+     , nodeGen    = 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 parser mbase input =+  let (result, _, unparsed) = runParser parser (emptyState mbase) input+     +      -- TODO: work out how best to report error context.+      +  in case result of+    Left emsg -> Left $ concat [emsg, "\nRemaining input:\n", L.unpack unparsed]+    _ -> result++newBlankNode :: TurtleParser RDFLabel+newBlankNode = do+  n <- stQuery (succ . nodeGen)+  stUpdate $ \s -> s { nodeGen = n }+  return $ Blank (show 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 = isymbol ","+semiColon = isymbol ";"+fullStop = isymbol "."++sQuot, dQuot, sQuot3, dQuot3 :: TurtleParser ()+sQuot = ichar '\''+dQuot = ichar '"'+sQuot3 = ignore $ string "'''"+dQuot3 = ignore $ string "\"\"\""++match :: (Ord a) => a -> [(a,a)] -> Bool+match v = any (\(l,h) -> v >= l && v <= h)++-- a specialization of bracket+br :: String -> String -> TurtleParser a -> TurtleParser a+br lsym rsym = bracket (symbol lsym) (symbol rsym)++-- this is a lot simpler than N3+atWord :: T.Text -> TurtleParser ()+atWord s = char '@' *> lexeme (stringT s) *> pure ()++{-+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 s p o@(Lit _ (Just dtype)) | dtype `elem` [xsdBoolean, xsdInteger, xsdDecimal, xsdDouble] = do +  ost <- stGet+  let stmt = arc s p o+      oldp = prefixUris ost+      ogs = graphState ost+      newp = mapReplaceOrAdd (getScopeNamespace dtype) oldp+  stUpdate $ \st -> st { prefixUris = newp, graphState = addArc stmt ogs }+addStatement s p o = stUpdate (updateGraph (addArc (arc s p o) ))++isaz, isAZ, isaZ, is09, isaZ09 :: Char -> Bool+isaz c = c >= 'a' && c <= 'z'+isAZ c = c >= 'A' && c <= 'Z'+isaZ c = isaz c || isAZ c+is09 c = c >= '0' && c <= '9'+isaZ09 c = isaZ c || is09 c++{-+Convert a string representing a double into canonical+XSD form. The input string is assumed to be syntactically+valid so we use read rather than reads. We use the String read+rather than Text one because of issues I have had in some tests+with the accuracy of the Text one.+-}+d2s :: L.Text -> RDFLabel+d2s = +  let conv :: String -> Double+      conv = read+  in toRDFLabel . conv . L.unpack++{-+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+    mapReplaceOrAdd for the input namespace.+    +-}+operatorLabel :: ScopedName -> TurtleParser RDFLabel+operatorLabel snam = do+  st <- stGet+  let sns = getScopeNamespace snam+      opmap = prefixUris st+      pkey = entryKey sns+      pval = entryVal sns+      +      rval = Res snam+      +  -- the lookup and the replacement could be fused+  case mapFindMaybe pkey opmap of+    Just val | val == pval -> return rval+             | otherwise   -> do+               stUpdate $ \s -> s { prefixUris = mapReplace opmap sns }+               return rval+    +    _ -> do+      stUpdate $ \s -> s { prefixUris = mapAdd opmap sns }+      return rval+        +findPrefix :: T.Text -> TurtleParser Namespace+findPrefix pre = do+  st <- stGet+  case mapFindMaybe (Just pre) (prefixUris st) of+    Just uri -> return $ makeNamespace (Just pre) uri+    Nothing  -> failBad $ "Undefined prefix '" ++ T.unpack pre ++ ":'."++{-++Syntax productions; the Turtle NBF grammar elements are from+http://www.w3.org/TR/turtle/turtle.bnf++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 = mkGr <$> (whiteSpace *> many statement *> eof *> stGet)+  where+    mkGr s = setNamespaces (prefixUris s) (graphState s)++{-+[2] statement ::= directive "." + | triples "."+-}+statement :: TurtleParser ()+statement = (directive <|> triples) *> fullStop++{-+[3] directive ::= prefixID + | base+-}+directive :: TurtleParser ()+directive = lexeme (prefixID <|> base)++{-+[4] prefixID ::= PREFIX PNAME_NS IRI_REF +-}+prefixID :: TurtleParser ()+prefixID = do+  _prefix +  p <- lexeme _pnameNS+  u <- _iriRef+  stUpdate (setPrefix (fmap L.toStrict p) u)++{-+[5] base ::= BASE IRI_REF +-}+base :: TurtleParser ()+base = _base >> _iriRef >>= stUpdate . setBase++{-+[6] triples ::= subject predicateObjectList +-}++triples :: TurtleParser ()+triples = subject >>= predicateObjectList++{-+[7] predicateObjectList ::= verb objectList ( ";" verb objectList )* (";")? +-}++predicateObjectList :: RDFLabel -> TurtleParser ()+predicateObjectList subj = +  let term = verb >>= objectList subj+  in sepBy1 term semiColon *> ignore (optional semiColon)+  -- in sepBy1 (lexeme term) semiColon *> ignore (optional semiColon)+  +{-+[8] objectList ::= object ( "," object )* +-}++objectList :: RDFLabel -> RDFLabel -> TurtleParser ()+objectList subj prd = sepBy1 object comma >>= mapM_ (addStatement subj prd)++{-+[9] verb ::= predicate + | "a"+-}++verb :: TurtleParser RDFLabel+verb = predicate <|> (lexeme (char 'a') *> operatorLabel rdfType)+   +{-       +[10] subject ::= IRIref + | blank +-}++subject :: TurtleParser RDFLabel+subject = (Res <$> iriref) <|> blank++{-+[11] predicate ::= IRIref +-}++predicate :: TurtleParser RDFLabel+predicate = Res <$> iriref++{-+[12] object ::= IRIref + | blank + | literal+-}++object :: TurtleParser RDFLabel+object = (Res <$> iriref) <|> blank <|> literal++{-+[13] literal ::= RDFLiteral + | NumericLiteral + | BooleanLiteral +-}++literal :: TurtleParser RDFLabel+literal = lexeme $ rdfLiteral <|> numericLiteral <|> booleanLiteral++{-+[14] blank ::= BlankNode + | blankNodePropertyList + | collection ++Since both BlankNode and blankNodePropertyList can match '[ ... ]' we pull+that out and treat this as++  blank ::= BLANK_NODE_LABEL+     | "[" (predicateObjectList | WS*) "]"+     | collection++blank :: TurtleParser RDFLabel+blank = lexeme (blankNode <|> blankNodePropertyList <|> collection)++-}++blank :: TurtleParser RDFLabel+blank = lexeme (_blankNodeLabel+                <|>+                bracket (char '[') (char ']') handleBlankNode+                <|>+                collection+                )++{-+[15] blankNodePropertyList ::= "[" predicateObjectList "]" ++We now match the brackets in the parent rule.++blankNodePropertyList :: TurtleParser RDFLabel+blankNodePropertyList = do+  bNode <- newBlankNode+  -- br "[" "]" (predicateObjectList bNode)+  bracket (satisfy (=='['))+    (satisfy (==']'))+    (_manyws *> predicateObjectList bNode *> _manyws)+  -- ignore (optional _manyws) -- TODO: this is a hack+  return bNode++-}++handleBlankNode :: TurtleParser RDFLabel+handleBlankNode = do+  bNode <- newBlankNode+  _manyws+  ignore $ optional $ predicateObjectList bNode+  _manyws+  return bNode+++{-+[16] collection ::= "(" object* ")" +-}++collection :: TurtleParser RDFLabel+collection = do+  os <- br "(" ")" (many object)+  eNode <- operatorLabel rdfNil+  case os of+    [] -> return eNode+    +    (x:xs) -> do+      sNode <- newBlankNode+      first <- operatorLabel rdfFirst+      addStatement sNode first x+      lNode <- foldM addElem sNode xs+      rest <- operatorLabel rdfRest+      addStatement lNode rest eNode+      return sNode++    where      +      addElem prevNode curElem = do+        bNode <- newBlankNode+        first <- operatorLabel rdfFirst+        rest <- operatorLabel rdfRest+        addStatement prevNode rest bNode+        addStatement bNode first curElem+        return bNode++{-+[17] <BASE> ::= "@base" +-}++_base :: TurtleParser ()+_base = atWord "base"++{-+[18] <PREFIX> ::= "@prefix" +-}++_prefix :: TurtleParser ()+_prefix = atWord "prefix"++{-+[19] <UCHAR> ::= ( "\\u" [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] ) + | ( "\\U" [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] + [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] ) ++-}++_uchar :: TurtleParser Char+_uchar = char '\\' *> _uchar'+         +_uchar' :: TurtleParser Char+_uchar' = (char 'u' *> hex4) <|> (char 'U' *> hex8)++{-+[60s] RDFLiteral ::= String ( LANGTAG | ( "^^" IRIref ) )? +-}++rdfLiteral :: TurtleParser RDFLabel+rdfLiteral = do+  lbl <- turtleString+  opt <- optional (_langTag <|> (string "^^" *> iriref))+  return $ Lit (L.toStrict lbl) opt++{-+[61s] NumericLiteral ::= NumericLiteralUnsigned + | NumericLiteralPositive + | NumericLiteralNegative +-}++numericLiteral :: TurtleParser RDFLabel+numericLiteral = numericLiteralNegative <|> numericLiteralPositive <|> numericLiteralUnsigned++{-+[62s] NumericLiteralUnsigned ::= INTEGER + | DECIMAL + | DOUBLE +-}++numericLiteralUnsigned :: TurtleParser RDFLabel+numericLiteralUnsigned = +  d2s <$> _double+  <|> +  (mkTypedLit xsdDecimal . L.toStrict <$> _decimal)+  <|> +  (mkTypedLit xsdInteger . L.toStrict <$> _integer)++{-+[63s] NumericLiteralPositive ::= INTEGER_POSITIVE + | DECIMAL_POSITIVE + | DOUBLE_POSITIVE +-}++numericLiteralPositive :: TurtleParser RDFLabel+numericLiteralPositive =+  d2s <$> _doublePositive+  <|> +  (mkTypedLit xsdDecimal . L.toStrict <$> _decimalPositive)+  <|> +  (mkTypedLit xsdInteger . L.toStrict <$> _integerPositive)++{-+[64s] NumericLiteralNegative ::= INTEGER_NEGATIVE + | DECIMAL_NEGATIVE + | DOUBLE_NEGATIVE +-}++numericLiteralNegative :: TurtleParser RDFLabel+numericLiteralNegative = +  d2s <$> _doubleNegative+  <|> +  (mkTypedLit xsdDecimal . L.toStrict <$> _decimalNegative)+  <|> +  (mkTypedLit xsdInteger . L.toStrict <$> _integerNegative)+   +{-+[65s] BooleanLiteral ::= "true" + | "false"+-}++booleanLiteral :: TurtleParser RDFLabel+booleanLiteral = mkTypedLit xsdBoolean . T.pack <$> (string "true" <|> string "false")++{-+[66s] String ::= STRING_LITERAL1 + | STRING_LITERAL2 + | STRING_LITERAL_LONG1 + | STRING_LITERAL_LONG2+-}++turtleString :: TurtleParser L.Text+turtleString = +  lexeme (+    _stringLiteralLong1 <|> _stringLiteral1 <|>+    _stringLiteralLong2 <|> _stringLiteral2)++{-+[67s] IRIref ::= IRI_REF + | PrefixedName +-}++iriref :: TurtleParser ScopedName+iriref = lexeme ((makeURIScopedName <$> _iriRef) <|> prefixedName)++{-+[68s] PrefixedName ::= PNAME_LN + | PNAME_NS +-}++prefixedName :: TurtleParser ScopedName+prefixedName = +  _pnameLN <|> +  flip makeNSScopedName T.empty <$> (_pnameNS >>= findPrefixNamespace)++{-+[69s] BlankNode ::= BLANK_NODE_LABEL + | ANON ++blankNode :: TurtleParser RDFLabel+blankNode = lexeme (_blankNodeLabel <|> _anon)++-}++{-+[70s] <IRI_REF> ::= "<" ( [^<>\"{}|^`\\] - [#0000- ] | UCHAR )* ">" ++Read [#0000- ] as [#x00-#x20] from+http://lists.w3.org/Archives/Public/public-rdf-comments/2011Aug/0011.html++Unlike N3, whitespace is significant within the surrounding <>.++At present relying on Network.URI to define what characters are valid+in a URI. This is not necessarily ideal.+-}++_iriRef :: TurtleParser URI+_iriRef = do+  utxt <- bracket (char '<') (char '>') $ manySatisfy (/= '>') -- TODO: fix+  let ustr = L.unpack utxt+  case parseURIReference ustr of+    Nothing -> fail $ "Unable to convert <" ++ ustr ++ "> to a URI"+    Just uref -> do+      s <- stGet+      either fail return $ appendURIs (baseUri s) uref++{-+[71s] <PNAME_NS> ::= (PN_PREFIX)? ":" +-}++_pnameNS :: TurtleParser (Maybe L.Text)+_pnameNS = optional _pnPrefix <* char ':'++{-+[72s] <PNAME_LN> ::= PNAME_NS PN_LOCAL +-}++_pnameLN :: TurtleParser ScopedName+_pnameLN = makeNSScopedName +           <$> (_pnameNS >>= findPrefixNamespace) +           <*> fmap L.toStrict _pnLocal++{-+[73s] <BLANK_NODE_LABEL> ::= "_:" PN_LOCAL +-}++_blankNodeLabel :: TurtleParser RDFLabel+_blankNodeLabel = (Blank . L.unpack) <$> (string "_:" *> _pnLocal)++{-++These are unused in the grammar.++[74s] <VAR1> ::= "?" VARNAME +[75s] <VAR2> ::= "$" VARNAME +-}++{-+[76s] <LANGTAG> ::= BASE + | PREFIX + | "@" [a-zA-Z]+ ( "-" [a-zA-Z0-9]+ )* ++I am ignoring the BASE and PREFIX lines here as they don't make sense to me.+-}++_langTag :: TurtleParser ScopedName+_langTag = do+  ichar '@'+  h <- many1Satisfy isaZ+  mt <- optional (L.cons <$> char '-' <*> many1Satisfy isaZ09)+  return $ langName $ L.toStrict $ L.append h (fromMaybe L.empty mt)+  +{-+[77s] <INTEGER> ::= [0-9]+ +-}++_integer :: TurtleParser L.Text+_integer = many1Satisfy is09++{-+[78s] <DECIMAL> ::= [0-9]+ "." [0-9]* + | "." [0-9]+ ++We try to produce a canonical form for the+numbers.+-}++_decimal :: TurtleParser L.Text+_decimal = +  let dpart = L.cons <$> char '.' <*> (fromMaybe "0" <$> optional _integer)+  in +   (L.append <$> _integer <*> dpart)+   <|>+   (L.append "0." <$> (char '.' *> _integer))++{-+[79s] <DOUBLE> ::= [0-9]+ "." [0-9]* EXPONENT + | "." ( [0-9] )+ EXPONENT + | ( [0-9] )+ EXPONENT ++Unlike _decimal, the canonical form is enforced+later on, although it could be done here.+-}++_double :: TurtleParser L.Text+_double = +  (L.append <$> _decimal <*> _exponent)+  <|>+  (L.append <$> _integer <*> _exponent)+  +{-+[80s] <INTEGER_POSITIVE> ::= "+" INTEGER +[81s] <DECIMAL_POSITIVE> ::= "+" DECIMAL +[82s] <DOUBLE_POSITIVE> ::= "+" DOUBLE +-}++_integerPositive, _decimalPositive, _doublePositive :: TurtleParser L.Text+_integerPositive = char '+' *> _integer+_decimalPositive = char '+' *> _decimal+_doublePositive = char '+' *> _double++{-+[83s] <INTEGER_NEGATIVE> ::= "-" INTEGER +[84s] <DECIMAL_NEGATIVE> ::= "-" DECIMAL +[85s] <DOUBLE_NEGATIVE> ::= "-" DOUBLE +-}++_integerNegative, _decimalNegative, _doubleNegative :: TurtleParser L.Text+_integerNegative = L.cons <$> char '-' <*> _integer+_decimalNegative = L.cons <$> char '-' <*> _decimal+_doubleNegative = L.cons <$> char '-' <*> _double++{-+[86s] <EXPONENT> ::= [eE] [+-]? [0-9]+ +-}++_exponent :: TurtleParser L.Text+_exponent = do+  ignore $ satisfy (`elem` "eE")+  ms <- optional (satisfy (`elem` "+-"))+  e <- _integer+  case ms of+    Just '-' -> return $ L.append "E-" e+    _        -> return $ L.cons 'E' e+  +{-+[87s] <STRING_LITERAL1> ::= "'" ( ( [^'\\\n\r] ) | ECHAR | UCHAR )* "'" +[88s] <STRING_LITERAL2> ::= '"' ( ( [^\"\\\n\r] ) | ECHAR | UCHAR )* '"' +[89s] <STRING_LITERAL_LONG1> ::= "'''" ( ( "'" | "''" )? ( [^'\\] | ECHAR | UCHAR ) )* "'''" +[90s] <STRING_LITERAL_LONG2> ::= '"""' ( ( '"' | '""' )? ( [^\"\\] | ECHAR | UCHAR ) )* '"""' +-}++_stringLiteral1, _stringLiteral2 :: TurtleParser L.Text+_stringLiteral1 = _stringIt sQuot (_tChars "'\\\n\r")+_stringLiteral2 = _stringIt dQuot (_tChars "\"\\\n\r")++_stringLiteralLong1, _stringLiteralLong2 :: TurtleParser L.Text+_stringLiteralLong1 = _stringItLong sQuot3 (_tCharsLong '\'' "'\\")+_stringLiteralLong2 = _stringItLong dQuot3 (_tCharsLong '"' "\"\\")++_stringIt :: TurtleParser a -> TurtleParser Char -> TurtleParser L.Text+_stringIt sep chars = L.pack <$> bracket sep sep (many chars)++_stringItLong :: TurtleParser a -> TurtleParser L.Text -> TurtleParser L.Text+_stringItLong sep chars = L.concat <$> bracket sep sep (many chars)++_tChars :: String -> TurtleParser Char+_tChars excl = (char '\\' *> (_echar' <|> _uchar'))+               <|> noneOf excl++_tCharsLong :: Char -> String -> TurtleParser L.Text+_tCharsLong c excl = do+  mq <- optional $ oneOrTwo c+  r <- _tChars excl+  return $ L.append (fromMaybe L.empty mq) (L.singleton r)++oneOrTwo :: Char -> TurtleParser L.Text+oneOrTwo c = do+  a <- char c+  mb <- optional (char c)+  case mb of+    Just b -> return $ L.pack [a,b]+    _      -> return $ L.singleton a++{-+[91s] <ECHAR> ::= "\\" [tbnrf\\\"'] +-}++_echar :: TurtleParser Char+_echar = char '\\' *> _echar'++_echar' :: TurtleParser Char+_echar' = +  (char 't' *> pure '\t') <|>+  (char 'b' *> pure '\b') <|>+  (char 'n' *> pure '\n') <|>+  (char 'r' *> pure '\r') <|>+  (char '\\' *> pure '\\') <|>+  (char '"' *> pure '"') <|>+  (char '\'' *> pure '\'')+++{-++Unused.++[92s] <NIL> ::= "(" (WS)* ")" +-}++{-+[93s] <WS> ::= " " + | "\t" + | "\r" + | "\n"++_ws :: TurtleParser ()+_ws = ignore $ satisfy (`elem` " \t\r\n")++-}++_manyws :: TurtleParser ()+_manyws = ignore $ manySatisfy (`elem` " \t\r\n")++{-+[94s] <ANON> ::= "[" (WS)* "]" ++Unused as we do not support the use of ANON in the BlankNode+terminal.++_anon :: TurtleParser RDFLabel+_anon = br "[" "]" _manyws *> newBlankNode++-}++{-+[95s] <PN_CHARS_BASE> ::= [A-Z] + | [a-z] + | [#00C0-#00D6] + | [#00D8-#00F6] + | [#00F8-#02FF] + | [#0370-#037D] + | [#037F-#1FFF] + | [#200C-#200D] + | [#2070-#218F] + | [#2C00-#2FEF] + | [#3001-#D7FF] + | [#F900-#FDCF] + | [#FDF0-#FFFD] + | [#10000-#EFFFF] + | UCHAR ++TODO: may want to make this a Char -> Bool selector for+use with manySatisfy rather than a combinator.+-}++_pnCharsBase :: TurtleParser Char+_pnCharsBase = +  let f c = let i = ord c+            in isaZ c || +               match i [(0xc0, 0xd6), (0xd8, 0xf6), (0xf8, 0x2ff),+                        (0x370, 0x37d), (0x37f, 0x1fff), (0x200c, 0x200d),+                        (0x2070, 0x218f), (0x2c00, 0x2fef), (0x3001, 0xd7ff),+                        (0xf900, 0xfdcf), (0xfdf0, 0xfffd), (0x10000, 0xeffff)]+  in satisfy f <|> _uchar++{-+[96s] <PN_CHARS_U> ::= PN_CHARS_BASE + | "_"+-}++_pnCharsU :: TurtleParser Char+_pnCharsU = _pnCharsBase <|> char '_'++{-++Only used in VAR1/2 rules which are themselves unused.++Unused in the grammar (other than+[97s] <VARNAME> ::= ( PN_CHARS_U | [0-9] ) ( PN_CHARS_U | [0-9] | #00B7 | [#0300-#036F] | [# + 203F-#2040] )* +-}++{-+[98s] <PN_CHARS> ::= PN_CHARS_U + | "-" + | [0-9] + | #00B7 + | [#0300-#036F] + | [#203F-#2040] +-}++_pnChars :: TurtleParser Char+_pnChars = +  _pnCharsU +  <|> +  satisfy (\c -> let i = ord c +                 in c == '-' || (c >= '0' && c <= '9') || i == 0xb7 ||+                    match i [(0x0300, 0x036f), (0x203f, 0x2040)])++{-+[99s] <PN_PREFIX> ::= PN_CHARS_BASE ( ( PN_CHARS | "." )* PN_CHARS )? +-}++_pnPrefix :: TurtleParser L.Text+_pnPrefix = L.cons <$> _pnCharsBase <*> _pnRest+  +{-+[100s] <PN_LOCAL> ::= ( PN_CHARS_U | [0-9] ) ( ( PN_CHARS | "." )* PN_CHARS )? +-}     ++_pnLocal :: TurtleParser L.Text+_pnLocal = L.cons <$> (_pnCharsU <|> satisfy is09) +           <*> _pnRest++{-+Extracted from PN_PREFIX and PN_LOCAL is++<PN_REST> :== ( ( PN_CHARS | "." )* PN_CHARS )?++We assume below that the match is only ever done for small strings, so+the cost of the foldr isn't likely to be large. Let's see how well+this assumption holds up.++-}++_pnRest :: TurtleParser L.Text+_pnRest = do+  lbl <- many (_pnChars <|> char '.')+  let (nret, lclean) = clean lbl+      +      -- a simple difference list implementation+      edl = id+      snocdl x xs = xs . (x:)+      appenddl = (.)+      replicatedl n x = (replicate n x ++)+  +      -- 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 = go 0 edl+        where+          go n acc [] = (n, acc [])+          go n acc ('.':xs) = go (n+1) acc xs +          go 0 acc (x:xs) = go 0 (snocdl x acc) xs+          go n acc (x:xs) = go 0 (appenddl acc (snocdl x (replicatedl n '.'))) xs++  reparse $ L.replicate (fromIntegral nret) (L.singleton '.')+  return $ L.pack lclean++{-+Original from ++ chop = go 0 []+        where+        -- go :: State -> Stack -> String -> String+        go 0 _ [] = []+        go 0 _ (x:xs)+            | isSpace x = go 1 [x] xs+            | otherwise = x : go 0 xs++        go 1 ss [] = []+        go 1 ss (x:xs)+            | isSpace c = go 1 (x:ss) xs+            | otherwise = reverse ss ++ x : go 0 xs++-}++--------------------------------------------------------------------------------+--+--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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+--+--------------------------------------------------------------------------------

@@ -1,5 +1,5 @@ Name:               swish-Version:            0.6.0.1+Version:            0.6.1.0 Stability:          experimental License:            LGPL License-file:       LICENSE @@ -27,7 +27,7 @@   .   Swish is a work-in-progress, and currently incorporates:   .-  * Notation3 and NTriples input and output. The N3 support is+  * Turtle, Notation3 and NTriples input and output. The N3 support is     incomplete (no handling of @\@forAll@).   .   * RDF graph isomorphism testing and merging.@@ -46,6 +46,11 @@   .   Changes:   .+  [Version 0.6.1.0] Added support for Turtle format (added the+  Swish.RDF.TurtleFormatter and Swish.RDF.TurtleParser modules).+  .+  [Version 0.6.0.2] Minor internal changes.+  .   [Version 0.6.0.1] Moved to using hashing routine using the Data.Hashable   interface rather than Swish.Utils.MiscHelpers which is deprecated.   .@@ -217,6 +222,8 @@       Swish.RDF.SwishMain       Swish.RDF.SwishMonad       Swish.RDF.SwishScript+      Swish.RDF.TurtleFormatter+      Swish.RDF.TurtleParser       Swish.RDF.VarBinding       Swish.RDF.Vocabulary       Swish.Utils.ListHelpers