module Hydra.Langs.Rdf.Utils where

import Hydra.Kernel
import qualified Hydra.Langs.Rdf.Syntax as Rdf

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


descriptionsToGraph :: [Rdf.Description] -> Rdf.Graph
descriptionsToGraph :: [Description] -> Graph
descriptionsToGraph [Description]
ds = Set Triple -> Graph
Rdf.Graph (Set Triple -> Graph) -> Set Triple -> Graph
forall a b. (a -> b) -> a -> b
$ [Triple] -> Set Triple
forall a. Ord a => [a] -> Set a
S.fromList ([Triple] -> Set Triple) -> [Triple] -> Set Triple
forall a b. (a -> b) -> a -> b
$ [Description] -> [Triple]
triplesOf [Description]
ds

emptyDescription :: Rdf.Node -> Rdf.Description
emptyDescription :: Node -> Description
emptyDescription Node
node = Node -> Graph -> Description
Rdf.Description Node
node Graph
emptyGraph

emptyGraph :: Rdf.Graph
emptyGraph :: Graph
emptyGraph = Set Triple -> Graph
Rdf.Graph Set Triple
forall a. Set a
S.empty

emptyLangStrings :: Rdf.LangStrings
emptyLangStrings :: LangStrings
emptyLangStrings = Map (Maybe LanguageTag) String -> LangStrings
Rdf.LangStrings Map (Maybe LanguageTag) String
forall k a. Map k a
M.empty

encodeLiteral :: Literal -> Flow (Graph) Rdf.Literal
encodeLiteral :: Literal -> Flow Graph Literal
encodeLiteral Literal
lit = case Literal
lit of
    LiteralBinary String
s -> String -> Flow Graph Literal
forall a. String -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"base 64 encoding not yet implemented"
    LiteralBoolean Bool
b -> Literal -> Flow Graph Literal
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> Flow Graph Literal) -> Literal -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ (Bool -> String) -> Bool -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd (\Bool
b -> if Bool
b then String
"true" else String
"false") Bool
b String
"boolean"
    LiteralFloat FloatValue
f -> Literal -> Flow Graph Literal
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> Flow Graph Literal) -> Literal -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ case FloatValue
f of
      FloatValueBigfloat Double
v -> (Double -> String) -> Double -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Double -> String
forall a. Show a => a -> String
show Double
v String
"decimal"
      FloatValueFloat32 Float
v -> (Float -> String) -> Float -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Float -> String
forall a. Show a => a -> String
show Float
v String
"float"
      FloatValueFloat64 Double
v -> (Double -> String) -> Double -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Double -> String
forall a. Show a => a -> String
show Double
v String
"double"
    LiteralInteger IntegerValue
i -> Literal -> Flow Graph Literal
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> Flow Graph Literal) -> Literal -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ case IntegerValue
i of
      IntegerValueBigint Integer
v -> (Integer -> String) -> Integer -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Integer -> String
forall a. Show a => a -> String
show Integer
v String
"integer"
      IntegerValueInt8 Int8
v   -> (Int8 -> String) -> Int8 -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Int8 -> String
forall a. Show a => a -> String
show Int8
v String
"byte"
      IntegerValueInt16 Int16
v  -> (Int16 -> String) -> Int16 -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Int16 -> String
forall a. Show a => a -> String
show Int16
v String
"short"
      IntegerValueInt32 Int
v  -> (Int -> String) -> Int -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Int -> String
forall a. Show a => a -> String
show Int
v String
"int"
      IntegerValueInt64 Int64
v  -> (Int64 -> String) -> Int64 -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Int64 -> String
forall a. Show a => a -> String
show Int64
v String
"long"
      IntegerValueUint8 Int16
v  -> (Int16 -> String) -> Int16 -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Int16 -> String
forall a. Show a => a -> String
show Int16
v String
"unsignedByte"
      IntegerValueUint16 Int
v -> (Int -> String) -> Int -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Int -> String
forall a. Show a => a -> String
show Int
v String
"unsignedShort"
      IntegerValueUint32 Int64
v -> (Int64 -> String) -> Int64 -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Int64 -> String
forall a. Show a => a -> String
show Int64
v String
"unsignedInt"
      IntegerValueUint64 Integer
v -> (Integer -> String) -> Integer -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd Integer -> String
forall a. Show a => a -> String
show Integer
v String
"unsignedLong"
    LiteralString String
s -> Literal -> Flow Graph Literal
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> Flow Graph Literal) -> Literal -> Flow Graph Literal
forall a b. (a -> b) -> a -> b
$ (String -> String) -> String -> String -> Literal
forall {t}. (t -> String) -> t -> String -> Literal
xsd String -> String
forall a. a -> a
id String
s String
"string"
  where
    -- TODO: using Haskell's built-in show function is a cheat, and may not be correct/optimal in all cases
    xsd :: (t -> String) -> t -> String -> Literal
xsd t -> String
ser t
x String
local = String -> Iri -> Maybe LanguageTag -> Literal
Rdf.Literal (t -> String
ser t
x) (String -> Iri
xmlSchemaDatatypeIri String
local) Maybe LanguageTag
forall a. Maybe a
Nothing

forObjects :: Rdf.Resource -> Rdf.Iri -> [Rdf.Node] -> [Rdf.Triple]
forObjects :: Resource -> Iri -> [Node] -> [Triple]
forObjects Resource
subj Iri
pred [Node]
objs = (Resource -> Iri -> Node -> Triple
Rdf.Triple Resource
subj Iri
pred) (Node -> Triple) -> [Node] -> [Triple]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node]
objs

iri :: String -> String -> Rdf.Iri
iri :: String -> String -> Iri
iri String
ns String
local = String -> Iri
Rdf.Iri (String -> Iri) -> String -> Iri
forall a b. (a -> b) -> a -> b
$ String
ns String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
local

keyIri :: String -> Rdf.Iri
keyIri :: String -> Iri
keyIri = String -> String -> Iri
iri String
"urn:key:" -- Note: not an official URN scheme

mergeGraphs :: [Rdf.Graph] -> Rdf.Graph
mergeGraphs :: [Graph] -> Graph
mergeGraphs [Graph]
graphs = Set Triple -> Graph
Rdf.Graph (Set Triple -> Graph) -> Set Triple -> Graph
forall a b. (a -> b) -> a -> b
$ (Set Triple -> Set Triple -> Set Triple)
-> Set Triple -> [Set Triple] -> Set Triple
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl Set Triple -> Set Triple -> Set Triple
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Triple
forall a. Set a
S.empty (Graph -> Set Triple
Rdf.unGraph (Graph -> Set Triple) -> [Graph] -> [Set Triple]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Graph]
graphs)

nameToIri :: Name -> Rdf.Iri
nameToIri :: Name -> Iri
nameToIri Name
name = String -> Iri
Rdf.Iri (String -> Iri) -> String -> Iri
forall a b. (a -> b) -> a -> b
$ String
"urn:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
name

nextBlankNode :: Flow (Graph) Rdf.Resource
nextBlankNode :: Flow Graph Resource
nextBlankNode = do
  Int
count <- String -> Flow Graph Int
forall s. String -> Flow s Int
nextCount String
"rdfBlankNodeCounter"
  Resource -> Flow Graph Resource
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Resource -> Flow Graph Resource)
-> Resource -> Flow Graph Resource
forall a b. (a -> b) -> a -> b
$ BlankNode -> Resource
Rdf.ResourceBnode (BlankNode -> Resource) -> BlankNode -> Resource
forall a b. (a -> b) -> a -> b
$ String -> BlankNode
Rdf.BlankNode (String -> BlankNode) -> String -> BlankNode
forall a b. (a -> b) -> a -> b
$ String
"b" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count

-- Note: these are not "proper" URNs, as they do not use an established URN scheme
propertyIri :: Name -> Name -> Rdf.Iri
propertyIri :: Name -> Name -> Iri
propertyIri Name
rname Name
fname = String -> Iri
Rdf.Iri (String -> Iri) -> String -> Iri
forall a b. (a -> b) -> a -> b
$ String
"urn:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Namespace -> String
unNamespace Namespace
gname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
decapitalize String
local String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
capitalize (Name -> String
unName Name
fname)
  where
    QualifiedName (Just Namespace
gname) String
local = Name -> QualifiedName
qualifyNameLazy Name
rname

rdfIri :: String -> Rdf.Iri
rdfIri :: String -> Iri
rdfIri = String -> String -> Iri
iri String
"http://www.w3.org/1999/02/22-rdf-syntax-ns#"

resourceToNode :: Rdf.Resource -> Rdf.Node
resourceToNode :: Resource -> Node
resourceToNode Resource
r = case Resource
r of
  Rdf.ResourceIri Iri
i -> Iri -> Node
Rdf.NodeIri Iri
i
  Rdf.ResourceBnode BlankNode
b -> BlankNode -> Node
Rdf.NodeBnode BlankNode
b

subjectsOf :: [Rdf.Description] -> [Rdf.Node]
subjectsOf :: [Description] -> [Node]
subjectsOf [Description]
descs = Description -> Node
Rdf.descriptionSubject (Description -> Node) -> [Description] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Description]
descs

triplesOf :: [Rdf.Description] -> [Rdf.Triple]
triplesOf :: [Description] -> [Triple]
triplesOf [Description]
descs = [[Triple]] -> [Triple]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat ((Set Triple -> [Triple]
forall a. Set a -> [a]
S.toList (Set Triple -> [Triple])
-> (Description -> Set Triple) -> Description -> [Triple]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> Set Triple
Rdf.unGraph (Graph -> Set Triple)
-> (Description -> Graph) -> Description -> Set Triple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Description -> Graph
Rdf.descriptionGraph) (Description -> [Triple]) -> [Description] -> [[Triple]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Description]
descs)

xmlSchemaDatatypeIri :: String -> Rdf.Iri
xmlSchemaDatatypeIri :: String -> Iri
xmlSchemaDatatypeIri = String -> String -> Iri
iri String
"http://www.w3.org/2001/XMLSchema#"