{-# LANGUAGE OverloadedStrings #-}

-- |A serializer for RDF as N-Triples
-- <http://www.w3.org/TR/rdf-testcases/#ntriples>.

module Text.RDF.RDF4H.NTriplesSerializer
  ( NTriplesSerializer(NTriplesSerializer)
  ) where

import Data.RDF.Types
import Data.RDF.Query (expandTriples)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.IO

data NTriplesSerializer = NTriplesSerializer

instance RdfSerializer NTriplesSerializer where
  hWriteRdf :: NTriplesSerializer -> Handle -> RDF a -> IO ()
hWriteRdf NTriplesSerializer
_     = Handle -> RDF a -> IO ()
forall a. Rdf a => Handle -> RDF a -> IO ()
_writeRdf
  writeRdf :: NTriplesSerializer -> RDF a -> IO ()
writeRdf  NTriplesSerializer
_     = Handle -> RDF a -> IO ()
forall a. Rdf a => Handle -> RDF a -> IO ()
_writeRdf Handle
stdout
  hWriteH :: NTriplesSerializer -> Handle -> RDF a -> IO ()
hWriteH   NTriplesSerializer
_ Handle
_ RDF a
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  writeH :: NTriplesSerializer -> RDF a -> IO ()
writeH    NTriplesSerializer
_   RDF a
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  hWriteTs :: NTriplesSerializer -> Handle -> Triples -> IO ()
hWriteTs  NTriplesSerializer
_     = Handle -> Triples -> IO ()
_writeTriples
  writeTs :: NTriplesSerializer -> Triples -> IO ()
writeTs   NTriplesSerializer
_     = Handle -> Triples -> IO ()
_writeTriples Handle
stdout
  hWriteT :: NTriplesSerializer -> Handle -> Triple -> IO ()
hWriteT   NTriplesSerializer
_     = Handle -> Triple -> IO ()
_writeTriple
  writeT :: NTriplesSerializer -> Triple -> IO ()
writeT    NTriplesSerializer
_     = Handle -> Triple -> IO ()
_writeTriple Handle
stdout
  hWriteN :: NTriplesSerializer -> Handle -> Node -> IO ()
hWriteN   NTriplesSerializer
_     = Handle -> Node -> IO ()
_writeNode
  writeN :: NTriplesSerializer -> Node -> IO ()
writeN    NTriplesSerializer
_     = Handle -> Node -> IO ()
_writeNode Handle
stdout

_writeRdf :: Rdf a => Handle -> RDF a -> IO ()
_writeRdf :: Handle -> RDF a -> IO ()
_writeRdf Handle
h = Handle -> Triples -> IO ()
_writeTriples Handle
h (Triples -> IO ()) -> (RDF a -> Triples) -> RDF a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDF a -> Triples
forall a. Rdf a => RDF a -> Triples
expandTriples

_writeTriples :: Handle -> Triples -> IO ()
_writeTriples :: Handle -> Triples -> IO ()
_writeTriples Handle
h = (Triple -> IO ()) -> Triples -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Triple -> IO ()
_writeTriple Handle
h)

_writeTriple :: Handle -> Triple -> IO ()
_writeTriple :: Handle -> Triple -> IO ()
_writeTriple Handle
h (Triple Node
s Node
p Node
o) =
  Handle -> Node -> IO ()
_writeNode Handle
h Node
s IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
' ' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Handle -> Node -> IO ()
_writeNode Handle
h Node
p IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
' ' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Handle -> Node -> IO ()
_writeNode Handle
h Node
o IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStrLn Handle
h String
" ."

_writeNode :: Handle -> Node -> IO ()
_writeNode :: Handle -> Node -> IO ()
_writeNode Handle
h Node
node = case Node
node of
  (UNode Text
s)  -> Handle -> Char -> IO ()
hPutChar Handle
h Char
'<' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Text -> IO ()
T.hPutStr Handle
h Text
s IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
'>'
  (BNode Text
gId) -> Handle -> Text -> IO ()
T.hPutStr Handle
h Text
"_:" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Text -> IO ()
T.hPutStr Handle
h Text
gId
  (BNodeGen Int
i)-> Handle -> Text -> IO ()
T.hPutStr Handle
h Text
"_:genid" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStr Handle
h (Int -> String
forall a. Show a => a -> String
show Int
i)
  (LNode LValue
n)   -> Handle -> LValue -> IO ()
_writeLValue Handle
h LValue
n

_writeLValue :: Handle -> LValue -> IO ()
_writeLValue :: Handle -> LValue -> IO ()
_writeLValue Handle
h LValue
lv = case LValue
lv of
  (PlainL Text
lit)       -> Handle -> Text -> IO ()
_writeLiteralString Handle
h Text
lit
  (PlainLL Text
lit Text
lang) -> Handle -> Text -> IO ()
_writeLiteralString Handle
h Text
lit IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          Handle -> Char -> IO ()
hPutChar Handle
h Char
'@' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          Handle -> Text -> IO ()
T.hPutStr Handle
h Text
lang
  (TypedL Text
lit Text
dtype) -> Handle -> Text -> IO ()
_writeLiteralString Handle
h Text
lit IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          Handle -> String -> IO ()
hPutStr Handle
h String
"^^<" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          Handle -> Text -> IO ()
T.hPutStr Handle
h Text
dtype IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                          Handle -> Char -> IO ()
hPutChar Handle
h Char
'>'

_writeLiteralString:: Handle -> T.Text -> IO ()
_writeLiteralString :: Handle -> Text -> IO ()
_writeLiteralString Handle
h Text
ls = do
  Handle -> Char -> IO ()
hPutChar Handle
h Char
'"'
  Handle -> Text -> IO ()
T.hPutStr Handle
h (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeChar Text
ls
  Handle -> Char -> IO ()
hPutChar Handle
h Char
'"'
  where escapeChar :: Char -> Text
escapeChar Char
'\n' = Text
"\\n"
        escapeChar Char
'\t' = Text
"\\t"
        escapeChar Char
'\r' = Text
"\\r"
        escapeChar Char
'"'  = Text
"\\\""
        escapeChar Char
'\\' = Text
"\\\\"
        escapeChar Char
c    = Char -> Text
T.singleton Char
c