{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  NTriples
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--                 2011, 2012, 2013, 2014, 2015, 2020 Doug  Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  OverloadedStrings
--
--  This Module implements a NTriples formatter for a 'RDFGraph'.
--
--  REFERENCES:
--
--  - \"RDF Test Cases\",
--     W3C Recommendation 10 February 2004,
--     <http://www.w3.org/TR/rdf-testcases/#ntriples>
--
-- NOTES:
--
--  - Update to the document \"N-Triples. A line-based syntax for an RDF graph\"
--    W3C Working Group Note 09 April 2013,
--    <http://www.w3.org/TR/2013/NOTE-n-triples-20130409/>
--
--------------------------------------------------------------------------------

module Swish.RDF.Formatter.NTriples
    ( formatGraphAsText
    , formatGraphAsLazyText
    , formatGraphAsBuilder
    )
where

import Swish.RDF.Formatter.Internal ( NodeGenState(..)
                                    , SLens (..)
                                    , emptyNgs
                                    , mapBlankNode_
                                    )

import Swish.GraphClass (Arc(..))
import Swish.Namespace (ScopedName, getQName)

import Swish.RDF.Graph (RDFGraph, RDFLabel(..))
import Swish.RDF.Graph (getArcs)

import Swish.RDF.Vocabulary (fromLangTag)

import Control.Monad.State

import Data.Char (ord, intToDigit, toUpper)

#if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)
import Data.Monoid
import Control.Applicative ((<$>))
#endif

-- import Prelude

-- it strikes me that using Lazy Text here is likely to be
-- wrong; however I have done no profiling to back this
-- assumption up!

import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Builder as B

----------------------------------------------------------------------
--  Graph formatting state monad
----------------------------------------------------------------------
--
--  This is a lot simpler than other formatters.

type Formatter a = State NodeGenState a

_nodeGen :: SLens NodeGenState NodeGenState
_nodeGen :: SLens NodeGenState NodeGenState
_nodeGen = (NodeGenState -> NodeGenState)
-> (NodeGenState -> NodeGenState -> NodeGenState)
-> SLens NodeGenState NodeGenState
forall a b. (a -> b) -> (a -> b -> a) -> SLens a b
SLens NodeGenState -> NodeGenState
forall a. a -> a
id ((NodeGenState -> NodeGenState -> NodeGenState)
 -> SLens NodeGenState NodeGenState)
-> (NodeGenState -> NodeGenState -> NodeGenState)
-> SLens NodeGenState NodeGenState
forall a b. (a -> b) -> a -> b
$ (NodeGenState -> NodeGenState)
-> NodeGenState -> NodeGenState -> NodeGenState
forall a b. a -> b -> a
const NodeGenState -> NodeGenState
forall a. a -> a
id

-- | Convert a RDF graph to NTriples format.
formatGraphAsText :: RDFGraph -> T.Text
formatGraphAsText :: RDFGraph -> Text
formatGraphAsText = Text -> Text
L.toStrict (Text -> Text) -> (RDFGraph -> Text) -> RDFGraph -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDFGraph -> Text
formatGraphAsLazyText

-- | Convert a RDF graph to NTriples format.
formatGraphAsLazyText :: RDFGraph -> L.Text
formatGraphAsLazyText :: RDFGraph -> Text
formatGraphAsLazyText = Builder -> Text
B.toLazyText (Builder -> Text) -> (RDFGraph -> Builder) -> RDFGraph -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDFGraph -> Builder
formatGraphAsBuilder

-- | Convert a RDF graph to NTriples format.
formatGraphAsBuilder :: RDFGraph -> B.Builder
formatGraphAsBuilder :: RDFGraph -> Builder
formatGraphAsBuilder RDFGraph
gr = State NodeGenState Builder -> NodeGenState -> Builder
forall s a. State s a -> s -> a
evalState (RDFGraph -> State NodeGenState Builder
formatGraph RDFGraph
gr) NodeGenState
emptyNgs

----------------------------------------------------------------------
--  Formatting as a monad-based computation
----------------------------------------------------------------------

formatGraph :: RDFGraph -> Formatter B.Builder
formatGraph :: RDFGraph -> State NodeGenState Builder
formatGraph RDFGraph
gr = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> StateT NodeGenState Identity [Builder]
-> State NodeGenState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Arc RDFLabel -> State NodeGenState Builder)
-> [Arc RDFLabel] -> StateT NodeGenState Identity [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Arc RDFLabel -> State NodeGenState Builder
formatArc (Set (Arc RDFLabel) -> [Arc RDFLabel]
forall a. Set a -> [a]
S.toList (RDFGraph -> Set (Arc RDFLabel)
forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs RDFGraph
gr))

-- TODO: this reverses the contents but may be faster?
--       that is if I've got the order right in the mappend call
-- formatGraphBuilder gr = foldl' (\a b -> b `mappend` (formatArcBuilder a)) B.empty (getArcs gr)

space, nl :: B.Builder
space :: Builder
space = Char -> Builder
B.singleton Char
' '
nl :: Builder
nl    = Builder
" .\n"

formatArc :: Arc RDFLabel -> Formatter B.Builder
formatArc :: Arc RDFLabel -> State NodeGenState Builder
formatArc (Arc RDFLabel
s RDFLabel
p RDFLabel
o) = do
  Builder
sl <- RDFLabel -> State NodeGenState Builder
formatLabel RDFLabel
s
  Builder
pl <- RDFLabel -> State NodeGenState Builder
formatLabel RDFLabel
p
  Builder
ol <- RDFLabel -> State NodeGenState Builder
formatLabel RDFLabel
o
  Builder -> State NodeGenState Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State NodeGenState Builder)
-> Builder -> State NodeGenState Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
sl, Builder
space, Builder
pl, Builder
space, Builder
ol, Builder
nl]
  
formatLabel :: RDFLabel -> Formatter B.Builder
formatLabel :: RDFLabel -> State NodeGenState Builder
formatLabel lab :: RDFLabel
lab@(Blank String
_) = RDFLabel -> State NodeGenState Builder
mapBlankNode RDFLabel
lab
formatLabel (Res ScopedName
sn) = Builder -> State NodeGenState Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State NodeGenState Builder)
-> Builder -> State NodeGenState Builder
forall a b. (a -> b) -> a -> b
$ ScopedName -> Builder
showScopedName ScopedName
sn
formatLabel (Lit Text
lit) = Builder -> State NodeGenState Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State NodeGenState Builder)
-> Builder -> State NodeGenState Builder
forall a b. (a -> b) -> a -> b
$ Text -> Builder
quoteText Text
lit
formatLabel (LangLit Text
lit LanguageTag
lang) = Builder -> State NodeGenState Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State NodeGenState Builder)
-> Builder -> State NodeGenState Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Text -> Builder
quoteText Text
lit, Builder
"@", Text -> Builder
B.fromText (LanguageTag -> Text
fromLangTag LanguageTag
lang)]
formatLabel (TypedLit Text
lit ScopedName
dt)  = Builder -> State NodeGenState Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State NodeGenState Builder)
-> Builder -> State NodeGenState Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Text -> Builder
quoteText Text
lit, Builder
"^^", ScopedName -> Builder
showScopedName ScopedName
dt]

-- do not expect to get the following, but include
-- just in case rather than failing
formatLabel RDFLabel
lab = Builder -> State NodeGenState Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State NodeGenState Builder)
-> Builder -> State NodeGenState Builder
forall a b. (a -> b) -> a -> b
$ String -> Builder
B.fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ RDFLabel -> String
forall a. Show a => a -> String
show RDFLabel
lab

mapBlankNode :: RDFLabel -> Formatter B.Builder
mapBlankNode :: RDFLabel -> State NodeGenState Builder
mapBlankNode = SLens NodeGenState NodeGenState
-> RDFLabel -> State NodeGenState Builder
forall a. SLens a NodeGenState -> RDFLabel -> State a Builder
mapBlankNode_ SLens NodeGenState NodeGenState
_nodeGen

-- TODO: can we use Network.URI to protect the URI?
showScopedName :: ScopedName -> B.Builder
showScopedName :: ScopedName -> Builder
showScopedName ScopedName
s = Text -> Builder
B.fromText (Text -> Text
quote (String -> Text
T.pack (QName -> String
forall a. Show a => a -> String
show (ScopedName -> QName
getQName ScopedName
s)))) -- looks like qname already adds the <> around this

quoteText :: T.Text -> B.Builder
quoteText :: Text -> Builder
quoteText  Text
st = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"\"", Text -> Builder
B.fromText (Text -> Text
quote Text
st), Builder
"\""]

{-
QUS: should we be operating on Text like this?
-}

quote :: T.Text -> T.Text
quote :: Text -> Text
quote = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
quoteT

quoteT :: Char -> T.Text
quoteT :: Char -> Text
quoteT Char
'\\' = Text
"\\\\"
quoteT Char
'"'  = Text
"\\\""
quoteT Char
'\n' = Text
"\\n"
quoteT Char
'\t' = Text
"\\t"
quoteT Char
'\r' = Text
"\\r"
quoteT Char
c    = 
  let nc :: Int
nc = Char -> Int
ord Char
c
      
  in if Int
nc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xffff 
     then String -> Text
T.pack (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'U'Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Int -> String
numToHex Int
8 Int
nc)
     else if Int
nc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x7e Bool -> Bool -> Bool
|| Int
nc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x20
          then String -> Text
T.pack (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'u'Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Int -> String
numToHex Int
4 Int
nc)
          else Char -> Text
T.singleton Char
c
                      
-- we assume c > 0, n >= 0 and that the input value fits
-- into the requested number of digits
numToHex :: Int -> Int -> String
numToHex :: Int -> Int -> String
numToHex Int
c = String -> Int -> String
go []
  where
    go :: String -> Int -> String
go String
s Int
0 = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
    go String
s Int
n = 
      let (Int
m,Int
x) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
n Int
16
      in String -> Int -> String
go (Int -> Char
iToD Int
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
s) Int
m

    -- Data.Char.intToDigit uses lower-case Hex
    iToD :: Int -> Char
iToD Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10    = Int -> Char
intToDigit Int
x
           | Bool
otherwise = Char -> Char
toUpper (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
intToDigit Int
x
      
--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2013, 2014, 2015, 2020 Douglas Burke
--  All rights reserved.
--
--  This file is part of Swish.
--
--  Swish is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  Swish is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with Swish; if not, write to:
--    The Free Software Foundation, Inc.,
--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--
--------------------------------------------------------------------------------