    {-# 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 gr :: 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 gr :: 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 ' '
    nl :: Builder
    nl    = " .\n"

    formatArc :: Arc RDFLabel -> Formatter B.Builder
    formatArc :: Arc RDFLabel -> State NodeGenState Builder
    formatArc (Arc s :: RDFLabel
    s p :: RDFLabel
    p o :: 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 _) = RDFLabel -> State NodeGenState Builder
    mapBlankNode RDFLabel
    lab
    formatLabel (Res sn :: 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 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 lit :: Text
    lit lang :: 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, "@", Text -> Builder
    B.fromText (LanguageTag -> Text
    fromLangTag LanguageTag
    lang)]
    formatLabel (TypedLit lit :: Text
    lit dt :: 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, "^^", ScopedName -> Builder
    showScopedName ScopedName
    dt]

    -- do not expect to get the following, but include
    -- just in case rather than failing
    formatLabel lab :: 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 s :: 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  st :: Text
    st = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat ["\"", Text -> Builder
    B.fromText (Text -> Text
    quote Text
    st), "\""]

    {-
    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 '\\' = "\\\\"
    quoteT '"'  = "\\\""
    quoteT '\n' = "\\n"
    quoteT '\t' = "\\t"
    quoteT '\r' = "\\r"
    quoteT c :: 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
    > 0xffff
         then String -> Text
    T.pack ('\\'Char -> String -> String
    forall a. a -> [a] -> [a]
    :'U'Char -> String -> String
    forall a. a -> [a] -> [a]
    : Int -> Int -> String
    numToHex 8 Int
    nc)
         else if Int
    nc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0x7e Bool -> Bool -> Bool
    || Int
    nc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0x20
              then String -> Text
    T.pack ('\\'Char -> String -> String
    forall a. a -> [a] -> [a]
    :'u'Char -> String -> String
    forall a. a -> [a] -> [a]
    : Int -> Int -> String
    numToHex 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 c :: Int
    c = String -> Int -> String
    go []
      where
        go :: String -> Int -> String
    go s :: String
    s 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) '0' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s
        go s :: String
    s n :: Int
    n =
          let (m :: Int
    m,x :: Int
    x) = Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    divMod Int
    n 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 x :: Int
    x | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 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
    --
    --------------------------------------------------------------------------------