<commit_before>module Text.RDF.TurtleSerializer where

import Text.RDF.Core
import Text.RDF.Namespace

import Data.ByteString.Char8(ByteString)
import qualified Data.ByteString.Char8 as B

import Text.PrettyPrint.HughesPJ

import System.IO

writeGraph :: Graph gr => Handle -> gr -> IO ()
writeGraph h gr = writeHeader h bUrl pms >> writeTriples h bUrl pms ts
  where
    bUrl = baseUrl gr
    pms  = prefixMappings gr
    ts   = triplesOf gr

writeHeader :: Handle -> Maybe BaseUrl -> PrefixMappings -> IO ()
writeHeader h bUrl pms = writeBase h bUrl >> writePrefixes h pms

writeBase :: Handle -> Maybe BaseUrl -> IO ()
writeBase h Nothing               = return ()
writeBase h (Just (BaseUrl bUrl)) = hPutStr h "@base " >> B.hPutStrLn h bUrl

writePrefixes :: Handle -> PrefixMappings -> IO ()
writePrefixes h pms = mapM_ (writePrefix h) (toPMList pms)

writePrefix :: Handle -> (ByteString, ByteString) -> IO ()
writePrefix h (pre, uri) =
  hPutStr h "@prefix " >> B.hPutStr h pre >> hPutChar h ':' >>
  B.hPutStrLn h uri

writeTriples :: Handle -> Maybe BaseUrl -> PrefixMappings -> Triples -> IO ()
writeTriples _ _    _   []     = return ()
writeTriples h bUrl pms (t:ts) = return ()

--writeSubjectGroup :: Handle -> Maybe BaseUrl -> PrefixMappings -> Triples -> IO ()
--writeSubjectGroup


subj1 = unode $ s2b "http://example.com/subj"
pred1 = unode $ s2b "http://example.com/pred"<commit_msg>TurtleSerializer.hs: implemented a bit more of the serializer. Technically, it works at this point, but needs much more work, as it currently outputs each line as a standalone triple, even when the same subject or same subject and predicate are in consecutive triples.<commit_after>module Text.RDF.TurtleSerializer where

import Text.RDF.Core
import Text.RDF.Namespace
import Text.RDF.Utils

import Data.ByteString.Char8(ByteString)
import qualified Data.ByteString.Char8 as B

import Data.Map(Map)
import qualified Data.Map as Map

import Control.Monad

import Text.PrettyPrint.HughesPJ

import System.IO

splitUri :: ByteString -> (ByteString, ByteString)
splitUri = B.breakEnd (\c -> c == '/' || c == ':' || c == '#')

writeGraph :: Graph gr => Handle -> gr -> IO ()
writeGraph h gr =
  writeHeader h bUrl pms >> writeTriples h bUrl pms ts >> hPutChar h '\n'
  where
    bUrl = baseUrl gr
    pms  = prefixMappings gr
    ts   = triplesOf gr

writeHeader :: Handle -> Maybe BaseUrl -> PrefixMappings -> IO ()
writeHeader h bUrl pms = writeBase h bUrl >> writePrefixes h pms

writeBase :: Handle -> Maybe BaseUrl -> IO ()
writeBase h Nothing               = return ()
writeBase h (Just (BaseUrl bUrl)) = hPutStr h "@base " >> B.hPutStrLn h bUrl

writePrefixes :: Handle -> PrefixMappings -> IO ()
writePrefixes h pms = mapM_ (writePrefix h) (toPMList pms) >> hPutChar h '\n'

writePrefix :: Handle -> (ByteString, ByteString) -> IO ()
writePrefix h (pre, uri) =
  hPutStr h "@prefix " >> B.hPutStr h pre >> hPutChar h ':' >>
  B.hPutStrLn h uri

writeTriples :: Handle -> Maybe BaseUrl -> PrefixMappings -> Triples -> IO ()
writeTriples _ _    _                    []     = return ()
writeTriples h bUrl (PrefixMappings pms) (t:ts) =
  let (subj, pred, obj) = (subjectOf t, predicateOf t, objectOf t)
      revPms            = Map.fromList $ map (\(k,v) -> (v,k)) $ Map.toList pms
  in writeNode h subj revPms >> hPutChar h ' ' >>
     writeNode h pred revPms >> hPutChar h ' ' >>
     writeNode h obj  revPms >> hPutStrLn h " ."

writeNode :: Handle -> Node -> Map ByteString ByteString -> IO ()
writeNode h node prefixes =
  case node of
    (UNode fs)  -> writeUNodeUri h (B.reverse $ value fs) prefixes
    (BNode gId) -> hPutStrRev h (value gId)
    (BNodeGen i)-> putStr "_:genid" >> hPutStr h (show i)
    (LNode n)   -> writeLValue h n

writeUNodeUri :: Handle -> ByteString -> Map ByteString ByteString -> IO ()
writeUNodeUri h uri prefixes =
  case Map.lookup urlInit prefixes of
    Nothing    -> hPutChar h '<' >> B.hPutStr h uri >> hPutChar h '>'
    (Just pre) -> B.hPutStr h pre >> hPutChar h ':' >> B.hPutStr h localName
  where
    (urlInit, localName) = splitUri uri

writeLValue :: Handle -> LValue -> IO ()
writeLValue h lv =
  case lv of
    (PlainL lit)       -> writeLiteralString h lit
    (PlainLL lit lang) -> writeLiteralString h lit >>
                            hPutStr h "@\"" >>
                            B.hPutStr h lang >>
                            hPutStr h "\""
    (TypedL lit dtype) -> writeLiteralString h lit >>
                            hPutStr h "^^\"" >>
                            hPutStrRev h (value dtype) >>
                            hPutStr h "\""

writeLiteralString:: Handle -> ByteString -> IO ()
writeLiteralString h bs =
  do hPutChar h '"'
     B.foldl' writeChar (return True) bs
     hPutChar h '"'
  where
    writeChar :: IO (Bool) -> Char -> IO (Bool)
    writeChar b c =
      case c of
        '\n' ->  b >>= \b' -> when b' (hPutChar h '\\' >> hPutChar h 'n')  >> return True
        '\t' ->  b >>= \b' -> when b' (hPutChar h '\\' >> hPutChar h 't')  >> return True
        '\r' ->  b >>= \b' -> when b' (hPutChar h '\\' >> hPutChar h 'r')  >> return True
        '"'  ->  b >>= \b' -> when b' (hPutChar h '\\' >> hPutChar h '"')  >> return True
        '\\' ->  b >>= \b' -> when b' (hPutChar h '\\' >> hPutChar h '\\') >> return True
        _    ->  b >>= \b' -> when b' (hPutChar  h c)                      >> return True
--writeSubjGroup :: Handle -> Maybe BaseUrl -> PrefixMappings -> Triples -> IO ()
--writeSubjGroup h bUrl pms ts = mapM_ (writeSubjPredGroup h bUrl pms) (groupBy equalPred ts)

--writeSubjPredGroup :: Handle -> Maybe BaseUrl -> PrefixMappings -> Triples -> IO ()
--writeSubjPredGroup h bUrl pms ts = undefined

subj1 = unode $ s2b "http://example.com/subj"
pred1 = unode $ s2b "http://example.com/pred"
{'fraction_non_alphanumeric': 0.13236814891416754, 'fraction_numerical': 0.002068252326783868, 'mean_word_length': 2.633688165309956, 'pattern_counts': {'":': 0, '<': 4, '<?xml version=': 0, '>': 178, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5601696', 'n_tokens_mistral': 1923, 'n_tokens_neox': 1907, 'n_words': 636}