-- | Serialize RDF using an approximation (because it does not yet support Unicode escape sequences) of the N-triples format

module Hydra.Ext.Rdf.Serde (
  rdfGraphToString,
) where

import qualified Hydra.Ext.Rdf.Syntax as Rdf
import Hydra.Util.Codetree.Script
import qualified Hydra.Util.Codetree.Ast as CT

import qualified Data.List as L
import qualified Data.Set as S


-- IRIREF ::= '<' ([^#x00-#x20<>"{}|^`\] | UCHAR)* '>'
-- TODO: Unicode escape sequences
escapeIriStr :: String -> String
escapeIriStr :: String -> String
escapeIriStr String
s = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Char -> String
esc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
s)
  where
    esc :: Char -> String
esc Char
c = if Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\128' Bool -> Bool -> Bool
|| Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\32' Bool -> Bool -> Bool
|| forall a. Ord a => a -> Set a -> Bool
S.member Char
c Set Char
others
      then String
"?"
      else [Char
c]
    others :: Set Char
others = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ String
"<>\"{}|^`\\"

-- STRING_LITERAL_QUOTE ::= '"' ([^#x22#x5C#xA#xD] | ECHAR | UCHAR)* '"'
-- TODO: Unicode escape sequences
escapeLiteralString :: String -> String
escapeLiteralString :: String -> String
escapeLiteralString String
s = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Char -> String
esc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
s)
  where
    esc :: Char -> String
esc Char
c = if Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\128'
      then String
"?"
      else case Char
c of
        Char
'\"' -> String
"\\\""
        Char
'\\' -> String
"\\\\"
        Char
'\n' -> String
"\\n"
        Char
'\r' -> String
"\\r"
        Char
_ -> [Char
c]

rdfGraphToString :: Rdf.Graph -> String
rdfGraphToString :: Graph -> String
rdfGraphToString = Expr -> String
printExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Expr
writeGraph

writeBlankNode :: Rdf.BlankNode -> CT.Expr
writeBlankNode :: BlankNode -> Expr
writeBlankNode BlankNode
bnode = [Expr] -> Expr
noSep [String -> Expr
cst String
"_:", String -> Expr
cst forall a b. (a -> b) -> a -> b
$ BlankNode -> String
Rdf.unBlankNode BlankNode
bnode]

writeGraph :: Rdf.Graph -> CT.Expr
writeGraph :: Graph -> Expr
writeGraph Graph
g = [Expr] -> Expr
newlineSep (Triple -> Expr
writeTriple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ Graph -> Set Triple
Rdf.unGraph Graph
g))

writeIri :: Rdf.Iri -> CT.Expr
writeIri :: Iri -> Expr
writeIri Iri
iri = [Expr] -> Expr
noSep [String -> Expr
cst String
"<", String -> Expr
cst forall a b. (a -> b) -> a -> b
$ String -> String
escapeIriStr forall a b. (a -> b) -> a -> b
$ Iri -> String
Rdf.unIri Iri
iri, String -> Expr
cst String
">"]

-- LANGTAG ::= '@' [a-zA-Z]+ ('-' [a-zA-Z0-9]+)*
-- Note: we simply trust language tags to be valid
writeLanguageTag :: Rdf.LanguageTag -> CT.Expr
writeLanguageTag :: LanguageTag -> Expr
writeLanguageTag LanguageTag
lang = [Expr] -> Expr
noSep [String -> Expr
cst String
"@", String -> Expr
cst forall a b. (a -> b) -> a -> b
$ LanguageTag -> String
Rdf.unLanguageTag LanguageTag
lang]

writeLiteral :: Rdf.Literal -> CT.Expr
writeLiteral :: Literal -> Expr
writeLiteral Literal
lit = [Expr] -> Expr
noSep [String -> Expr
cst String
lex, Expr
suffix]
  where
    suffix :: Expr
suffix = case Literal -> Maybe LanguageTag
Rdf.literalLanguageTag Literal
lit of
      Maybe LanguageTag
Nothing -> [Expr] -> Expr
noSep [String -> Expr
cst String
"^^", Iri -> Expr
writeIri Iri
dt]
      Just LanguageTag
lang -> LanguageTag -> Expr
writeLanguageTag LanguageTag
lang
    lex :: String
lex = String
"\"" forall a. [a] -> [a] -> [a]
++ (String -> String
escapeLiteralString forall a b. (a -> b) -> a -> b
$ Literal -> String
Rdf.literalLexicalForm Literal
lit) forall a. [a] -> [a] -> [a]
++ String
"\""
    dt :: Iri
dt = Literal -> Iri
Rdf.literalDatatypeIri Literal
lit

writeNode :: Rdf.Node -> CT.Expr
writeNode :: Node -> Expr
writeNode Node
n = case Node
n of
  Rdf.NodeIri Iri
iri -> Iri -> Expr
writeIri Iri
iri
  Rdf.NodeBnode BlankNode
bnode -> BlankNode -> Expr
writeBlankNode BlankNode
bnode
  Rdf.NodeLiteral Literal
lit -> Literal -> Expr
writeLiteral Literal
lit

writeResource :: Rdf.Resource -> CT.Expr
writeResource :: Resource -> Expr
writeResource Resource
r = case Resource
r of
  Rdf.ResourceIri Iri
iri -> Iri -> Expr
writeIri Iri
iri
  Rdf.ResourceBnode BlankNode
bnode -> BlankNode -> Expr
writeBlankNode BlankNode
bnode

writeTriple :: Rdf.Triple -> CT.Expr
writeTriple :: Triple -> Expr
writeTriple Triple
t = [Expr] -> Expr
spaceSep [
    Resource -> Expr
writeResource forall a b. (a -> b) -> a -> b
$ Triple -> Resource
Rdf.tripleSubject Triple
t,
    Iri -> Expr
writeIri forall a b. (a -> b) -> a -> b
$ Triple -> Iri
Rdf.triplePredicate Triple
t,
    Node -> Expr
writeNode forall a b. (a -> b) -> a -> b
$ Triple -> Node
Rdf.tripleObject Triple
t,
    String -> Expr
cst String
"."]