{-|
Module      : Data.RDF.ToRDF
Description : DSL for Mapping Haskell Data to RDF Graphs
Copyright   : Travis Whitaker 2016
License     : MIT
Maintainer  : pi.boy.travis@gmail.com
Stability   : Provisional
Portability : Portable

This module provides a simple DSL for mapping Haskell data to RDF graphs.
-}

{-# LANGUAGE FlexibleContexts
           , FlexibleInstances
           , TupleSections
           #-}

module Data.RDF.ToRDF (
    ToRDF(..)
  , ToObject(..)
  , toTriples
  , Triples
  , RDFGen
  , runRDFGen
  , appBaseIRI
  , newBlankNode
  ) where

import Control.Monad.Trans.Reader
import Control.Monad.Trans.State.Lazy

import qualified Data.DList as DL

import Data.Int

import Data.Monoid

import Data.RDF.Types

import qualified Data.Text                        as T
import qualified Data.Text.Lazy                   as TL
import qualified Data.Text.Lazy.Builder           as TL
import qualified Data.Text.Lazy.Builder.Int       as TL
import qualified Data.Text.Lazy.Builder.RealFloat as TL

import Data.Word

type Triples = DL.DList Triple

-- | RDF generator monad. Provides 'ReaderT' for the base 'IRI', and 'StateT'
--   for a monotonically increasing blank node identifier.
type RDFGen a = ReaderT IRI (State Word64) a

runRDFGen :: RDFGen a -> IRI -> a
runRDFGen :: RDFGen a -> IRI -> a
runRDFGen RDFGen a
m IRI
i = State Word64 a -> Word64 -> a
forall s a. State s a -> s -> a
evalState (RDFGen a -> IRI -> State Word64 a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT RDFGen a
m IRI
i) Word64
0

class ToRDF a where
    triples :: a -> RDFGen Triples

class ToObject a where
    object :: a -> RDFGen Object

instance ToObject Int where
    object :: Int -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Int -> Object) -> Int -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Int -> Builder) -> Int -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
forall a. Integral a => a -> Builder
TL.decimal

instance ToObject Integer where
    object :: Integer -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Integer -> Object) -> Integer -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Integer -> Builder) -> Integer -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Builder
forall a. Integral a => a -> Builder
TL.decimal

instance ToObject Int8 where
    object :: Int8 -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Int8 -> Object) -> Int8 -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Int8 -> Builder) -> Int8 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Builder
forall a. Integral a => a -> Builder
TL.decimal

instance ToObject Int16 where
    object :: Int16 -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Int16 -> Object) -> Int16 -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Int16 -> Builder) -> Int16 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Builder
forall a. Integral a => a -> Builder
TL.decimal

instance ToObject Int32 where
    object :: Int32 -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Int32 -> Object) -> Int32 -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Int32 -> Builder) -> Int32 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Builder
forall a. Integral a => a -> Builder
TL.decimal

instance ToObject Int64 where
    object :: Int64 -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Int64 -> Object) -> Int64 -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Int64 -> Builder) -> Int64 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Builder
forall a. Integral a => a -> Builder
TL.decimal

instance ToObject Word where
    object :: Word -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Word -> Object) -> Word -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Word -> Builder) -> Word -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Builder
forall a. Integral a => a -> Builder
TL.decimal

instance ToObject Word8 where
    object :: Word8 -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Word8 -> Object) -> Word8 -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Word8 -> Builder) -> Word8 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Builder
forall a. Integral a => a -> Builder
TL.decimal

instance ToObject Word16 where
    object :: Word16 -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Word16 -> Object) -> Word16 -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Word16 -> Builder) -> Word16 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Builder
forall a. Integral a => a -> Builder
TL.decimal

instance ToObject Word32 where
    object :: Word32 -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Word32 -> Object) -> Word32 -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Word32 -> Builder) -> Word32 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Builder
forall a. Integral a => a -> Builder
TL.decimal

instance ToObject Word64 where
    object :: Word64 -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Word64 -> Object) -> Word64 -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Word64 -> Builder) -> Word64 -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
forall a. Integral a => a -> Builder
TL.decimal

instance ToObject String where
    object :: String -> RDFGen Object
object String
s = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object) -> Object -> RDFGen Object
forall a b. (a -> b) -> a -> b
$ Literal -> Object
LiteralObject (Text -> LiteralType -> Literal
Literal (String -> Text
T.pack String
s) LiteralType
LiteralUntyped)

instance ToObject T.Text where
    object :: Text -> RDFGen Object
object Text
t = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object) -> Object -> RDFGen Object
forall a b. (a -> b) -> a -> b
$ Literal -> Object
LiteralObject (Text -> LiteralType -> Literal
Literal Text
t LiteralType
LiteralUntyped)

-- | Forces the lazy 'TL.Text'.
instance ToObject TL.Text where
    object :: Text -> RDFGen Object
object Text
t = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object) -> Object -> RDFGen Object
forall a b. (a -> b) -> a -> b
$ Literal -> Object
LiteralObject (Text -> LiteralType -> Literal
Literal (Text -> Text
TL.toStrict Text
t) LiteralType
LiteralUntyped)

instance ToObject Float where
    object :: Float -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Float -> Object) -> Float -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Float -> Builder) -> Float -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Builder
forall a. RealFloat a => a -> Builder
TL.realFloat

instance ToObject Double where
    object :: Double -> RDFGen Object
object = Object -> RDFGen Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> RDFGen Object)
-> (Double -> Object) -> Double -> RDFGen Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Object
toLObject (Builder -> Object) -> (Double -> Builder) -> Double -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
forall a. RealFloat a => a -> Builder
TL.realFloat

toTriples :: ToRDF a => IRI -> a -> [Triple]
toTriples :: IRI -> a -> [Triple]
toTriples IRI
i a
x = DList Triple -> [Triple]
forall a. DList a -> [a]
DL.toList (RDFGen (DList Triple) -> IRI -> DList Triple
forall a. RDFGen a -> IRI -> a
runRDFGen (a -> RDFGen (DList Triple)
forall a. ToRDF a => a -> RDFGen (DList Triple)
triples a
x) IRI
i)

toText :: TL.Builder -> T.Text
toText :: Builder -> Text
toText = Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TL.toLazyText

toLObject :: TL.Builder -> Object
toLObject :: Builder -> Object
toLObject Builder
b = Literal -> Object
LiteralObject (Text -> LiteralType -> Literal
Literal (Builder -> Text
toText Builder
b) LiteralType
LiteralUntyped)

appBaseIRI :: Endo IRI -> RDFGen IRI
appBaseIRI :: Endo IRI -> RDFGen IRI
appBaseIRI = (IRI -> IRI) -> RDFGen IRI
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((IRI -> IRI) -> RDFGen IRI)
-> (Endo IRI -> IRI -> IRI) -> Endo IRI -> RDFGen IRI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo IRI -> IRI -> IRI
forall a. Endo a -> a -> a
appEndo

newBlankNode :: RDFGen BlankNode
newBlankNode :: RDFGen BlankNode
newBlankNode = (IRI -> StateT Word64 Identity BlankNode) -> RDFGen BlankNode
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (StateT Word64 Identity BlankNode
-> IRI -> StateT Word64 Identity BlankNode
forall a b. a -> b -> a
const ((Text -> BlankNode
BlankNode (Text -> BlankNode) -> (Word64 -> Text) -> Word64 -> BlankNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toText (Builder -> Text) -> (Word64 -> Builder) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
forall a. Integral a => a -> Builder
TL.decimal)
                           (Word64 -> BlankNode)
-> StateT Word64 Identity Word64
-> StateT Word64 Identity BlankNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Word64 Identity Word64
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT Word64 Identity BlankNode
-> StateT Word64 Identity () -> StateT Word64 Identity BlankNode
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Word64 -> Word64) -> StateT Word64 Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1)))