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

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Turtle
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--                 2011, 2012, 2013, 2014, 2018, 2019, 2020, 2021 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  CPP, OverloadedStrings
--
--  This Module implements a Turtle formatter 
--  for an 'RDFGraph' value.
--
--  REFERENCES:
--
--  - \"Turtle, Terse RDF Triple Language\",
--    W3C Working Draft 09 August 2011 (<http://www.w3.org/TR/2011/WD-turtle-20110809/>)
--    <http://www.w3.org/TR/turtle/>
--
-- NOTES:
--
--  - The formatter needs to be updated to the W3C
--    Candidate Recommendation (19 February 2013,
--    <http://www.w3.org/TR/2013/CR-turtle-20130219/>).
--
--  - Should literal strings (@Lit@) be written out as @xsd:string@, or
--    should @TypedLit@ strings with a type of @xsd:string@ be written
--    out with no type? (e.g. see
--    <http://www.w3.org/TR/2011/WD-turtle-20110809/#terms>).
--
--------------------------------------------------------------------------------

{-
TODO:

The code used to determine whether a blank node can be written
using the "[]" short form could probably take advantage of the
GraphPartition module.

-}

module Swish.RDF.Formatter.Turtle
    ( NodeGenLookupMap
    , formatGraphAsText
    , formatGraphAsLazyText
    , formatGraphAsBuilder
    , formatGraphIndent  
    , formatGraphDiag
    )
where

import Swish.RDF.Formatter.Internal (NodeGenLookupMap, SubjTree, PredTree
                                    , SLens(..)
                                    , LabelContext(..)
                                    , NodeGenState(..)
                                    , changeState
                                    , hasMore
                                    , emptyNgs
                                    , findMaxBnode
                                    , processArcs
                                    , formatScopedName
                                    , formatPlainLit
                                    , formatLangLit
                                    , formatTypedLit
                                    , insertList
                                    , nextLine_
                                    , mapBlankNode_
                                    , formatPrefixes_
                                    , formatGraph_
                                    , formatSubjects_
                                    , formatProperties_
                                    , formatObjects_
                                    , insertBnode_
                                    , extractList_
                                    )

import Swish.RDF.Graph (
  RDFGraph, RDFLabel(..)
  , NamespaceMap
  , emptyNamespaceMap
  , getNamespaces
  , emptyRDFGraph
  )

import Swish.RDF.Vocabulary (rdfType, rdfNil)

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

import Control.Monad.State (State, modify, gets, runState)

import Data.Char (isDigit)
import Data.List (uncons)
import Data.Word (Word32)

#if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)
import Data.Monoid (Monoid(..))
#endif

-- 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.Map as M
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
----------------------------------------------------------------------
--
--  The graph to be formatted is carried as part of the formatting
--  state, so that decisions about what needs to be formatted can
--  themselves be based upon and reflected in the state (e.g. if a
--  decision is made to include a blank node inline, it can be removed
--  from the graph state that remains to be formatted).

data TurtleFormatterState = TFS
    { TurtleFormatterState -> Builder
indent    :: B.Builder
    , TurtleFormatterState -> Bool
lineBreak :: Bool
    , TurtleFormatterState -> RDFGraph
graph     :: RDFGraph
    , TurtleFormatterState -> SubjTree RDFLabel
subjs     :: SubjTree RDFLabel
    , TurtleFormatterState -> PredTree RDFLabel
props     :: PredTree RDFLabel   -- for last subject selected
    , TurtleFormatterState -> [RDFLabel]
objs      :: [RDFLabel]          -- for last property selected
    -- , formAvail :: FormulaMap RDFLabel
    -- , formQueue :: [(RDFLabel,RDFGraph)]
    , TurtleFormatterState -> NamespaceMap
prefixes  :: NamespaceMap
    , TurtleFormatterState -> NodeGenState
nodeGenSt :: NodeGenState
    , TurtleFormatterState -> [RDFLabel]
bNodesCheck   :: [RDFLabel]      -- these bNodes are not to be converted to '[..]' format
    , TurtleFormatterState -> [String]
traceBuf  :: [String]
    }

type SL a = SLens TurtleFormatterState a

_lineBreak :: SL Bool
_lineBreak :: SL Bool
_lineBreak = (TurtleFormatterState -> Bool)
-> (TurtleFormatterState -> Bool -> TurtleFormatterState)
-> SL Bool
forall a b. (a -> b) -> (a -> b -> a) -> SLens a b
SLens TurtleFormatterState -> Bool
lineBreak    ((TurtleFormatterState -> Bool -> TurtleFormatterState) -> SL Bool)
-> (TurtleFormatterState -> Bool -> TurtleFormatterState)
-> SL Bool
forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
a Bool
b -> TurtleFormatterState
a { lineBreak :: Bool
lineBreak = Bool
b }

_nodeGen :: SL NodeGenState
_nodeGen :: SL NodeGenState
_nodeGen   = (TurtleFormatterState -> NodeGenState)
-> (TurtleFormatterState -> NodeGenState -> TurtleFormatterState)
-> SL NodeGenState
forall a b. (a -> b) -> (a -> b -> a) -> SLens a b
SLens TurtleFormatterState -> NodeGenState
nodeGenSt    ((TurtleFormatterState -> NodeGenState -> TurtleFormatterState)
 -> SL NodeGenState)
-> (TurtleFormatterState -> NodeGenState -> TurtleFormatterState)
-> SL NodeGenState
forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
a NodeGenState
b -> TurtleFormatterState
a { nodeGenSt :: NodeGenState
nodeGenSt = NodeGenState
b }

type Formatter a = State TurtleFormatterState a

updateState ::
    TurtleFormatterState
    -> SubjTree RDFLabel
    -> PredTree RDFLabel
    -> [RDFLabel]
    -> TurtleFormatterState
updateState :: TurtleFormatterState
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> TurtleFormatterState
updateState TurtleFormatterState
ost SubjTree RDFLabel
nsubjs PredTree RDFLabel
nprops [RDFLabel]
nobjs = TurtleFormatterState
ost { subjs :: SubjTree RDFLabel
subjs = SubjTree RDFLabel
nsubjs, props :: PredTree RDFLabel
props = PredTree RDFLabel
nprops, objs :: [RDFLabel]
objs = [RDFLabel]
nobjs }

emptyTFS :: NodeGenState -> TurtleFormatterState
emptyTFS :: NodeGenState -> TurtleFormatterState
emptyTFS NodeGenState
ngs = TFS :: Builder
-> Bool
-> RDFGraph
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> NamespaceMap
-> NodeGenState
-> [RDFLabel]
-> [String]
-> TurtleFormatterState
TFS
    { indent :: Builder
indent    = Builder
"\n"
    , lineBreak :: Bool
lineBreak = Bool
False
    , graph :: RDFGraph
graph     = RDFGraph
emptyRDFGraph
    , subjs :: SubjTree RDFLabel
subjs     = []
    , props :: PredTree RDFLabel
props     = []
    , objs :: [RDFLabel]
objs      = []
    , prefixes :: NamespaceMap
prefixes  = NamespaceMap
emptyNamespaceMap
    , nodeGenSt :: NodeGenState
nodeGenSt = NodeGenState
ngs
    , bNodesCheck :: [RDFLabel]
bNodesCheck   = []
    , traceBuf :: [String]
traceBuf  = []
    }

setIndent :: B.Builder -> Formatter ()
setIndent :: Builder -> Formatter ()
setIndent Builder
ind = (TurtleFormatterState -> TurtleFormatterState) -> Formatter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TurtleFormatterState -> TurtleFormatterState) -> Formatter ())
-> (TurtleFormatterState -> TurtleFormatterState) -> Formatter ()
forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st -> TurtleFormatterState
st { indent :: Builder
indent = Builder
ind }

setLineBreak :: Bool -> Formatter ()
setLineBreak :: Bool -> Formatter ()
setLineBreak Bool
brk = (TurtleFormatterState -> TurtleFormatterState) -> Formatter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TurtleFormatterState -> TurtleFormatterState) -> Formatter ())
-> (TurtleFormatterState -> TurtleFormatterState) -> Formatter ()
forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st -> TurtleFormatterState
st { lineBreak :: Bool
lineBreak = Bool
brk }

setSubjs :: SubjTree RDFLabel -> Formatter ()
setSubjs :: SubjTree RDFLabel -> Formatter ()
setSubjs SubjTree RDFLabel
sl = (TurtleFormatterState -> TurtleFormatterState) -> Formatter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TurtleFormatterState -> TurtleFormatterState) -> Formatter ())
-> (TurtleFormatterState -> TurtleFormatterState) -> Formatter ()
forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st -> TurtleFormatterState
st { subjs :: SubjTree RDFLabel
subjs = SubjTree RDFLabel
sl }

setProps :: PredTree RDFLabel -> Formatter ()
setProps :: PredTree RDFLabel -> Formatter ()
setProps PredTree RDFLabel
ps = (TurtleFormatterState -> TurtleFormatterState) -> Formatter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TurtleFormatterState -> TurtleFormatterState) -> Formatter ())
-> (TurtleFormatterState -> TurtleFormatterState) -> Formatter ()
forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st -> TurtleFormatterState
st { props :: PredTree RDFLabel
props = PredTree RDFLabel
ps }

{-
TODO:

Should we change the preds/objs entries as well?

-}
extractList :: LabelContext -> RDFLabel -> Formatter (Maybe [RDFLabel])
extractList :: LabelContext -> RDFLabel -> Formatter (Maybe [RDFLabel])
extractList = (TurtleFormatterState -> SubjTree RDFLabel)
-> (TurtleFormatterState -> PredTree RDFLabel)
-> (SubjTree RDFLabel -> Formatter ())
-> (PredTree RDFLabel -> Formatter ())
-> LabelContext
-> RDFLabel
-> Formatter (Maybe [RDFLabel])
forall a.
(a -> SubjTree RDFLabel)
-> (a -> PredTree RDFLabel)
-> (SubjTree RDFLabel -> State a ())
-> (PredTree RDFLabel -> State a ())
-> LabelContext
-> RDFLabel
-> State a (Maybe [RDFLabel])
extractList_ TurtleFormatterState -> SubjTree RDFLabel
subjs TurtleFormatterState -> PredTree RDFLabel
props SubjTree RDFLabel -> Formatter ()
setSubjs PredTree RDFLabel -> Formatter ()
setProps

----------------------------------------------------------------------
--  Define a top-level formatter function:
----------------------------------------------------------------------

-- | Convert the graph to text.
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 the graph to text.
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 the graph to a Builder.
formatGraphAsBuilder :: RDFGraph -> B.Builder
formatGraphAsBuilder :: RDFGraph -> Builder
formatGraphAsBuilder = Builder -> Bool -> RDFGraph -> Builder
formatGraphIndent Builder
"\n" Bool
True
  
-- | Convert the graph to a builder using the given indentation text.
formatGraphIndent ::
    B.Builder     -- ^ indentation text
    -> Bool       -- ^ are prefixes to be generated?
    -> RDFGraph   -- ^ graph
    -> B.Builder
formatGraphIndent :: Builder -> Bool -> RDFGraph -> Builder
formatGraphIndent Builder
indnt Bool
flag RDFGraph
gr = 
  let (Builder
res, NodeGenLookupMap
_, Word32
_, [String]
_) = Builder
-> Bool
-> RDFGraph
-> (Builder, NodeGenLookupMap, Word32, [String])
formatGraphDiag Builder
indnt Bool
flag RDFGraph
gr
  in Builder
res
  
-- | Format graph and return additional information.
formatGraphDiag :: 
  B.Builder  -- ^ indentation
  -> Bool    -- ^ are prefixes to be generated?
  -> RDFGraph 
  -> (B.Builder, NodeGenLookupMap, Word32, [String])
formatGraphDiag :: Builder
-> Bool
-> RDFGraph
-> (Builder, NodeGenLookupMap, Word32, [String])
formatGraphDiag Builder
indnt Bool
flag RDFGraph
gr = 
  let fg :: Formatter Builder
fg  = Builder -> Builder -> Bool -> Bool -> RDFGraph -> Formatter Builder
formatGraph Builder
indnt Builder
" .\n" Bool
False Bool
flag RDFGraph
gr
      ngs :: NodeGenState
ngs = NodeGenState
emptyNgs { nodeGen :: Word32
nodeGen = RDFGraph -> Word32
findMaxBnode RDFGraph
gr }
             
      (Builder
out, TurtleFormatterState
fgs) = Formatter Builder
-> TurtleFormatterState -> (Builder, TurtleFormatterState)
forall s a. State s a -> s -> (a, s)
runState Formatter Builder
fg (NodeGenState -> TurtleFormatterState
emptyTFS NodeGenState
ngs)
      ogs :: NodeGenState
ogs        = TurtleFormatterState -> NodeGenState
nodeGenSt TurtleFormatterState
fgs
  
  in (Builder
out, NodeGenState -> NodeGenLookupMap
nodeMap NodeGenState
ogs, NodeGenState -> Word32
nodeGen NodeGenState
ogs, TurtleFormatterState -> [String]
traceBuf TurtleFormatterState
fgs)

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

formatGraph :: 
  B.Builder     -- indentation string
  -> B.Builder  -- text to be placed after final statement
  -> Bool       -- True if a line break is to be inserted at the start
  -> Bool       -- True if prefix strings are to be generated
  -> RDFGraph   -- graph to convert
  -> Formatter B.Builder
formatGraph :: Builder -> Builder -> Bool -> Bool -> RDFGraph -> Formatter Builder
formatGraph = (Builder -> Formatter ())
-> (Bool -> Formatter ())
-> (RDFGraph -> TurtleFormatterState -> TurtleFormatterState)
-> (NamespaceMap -> Formatter Builder)
-> (TurtleFormatterState -> SubjTree RDFLabel)
-> Formatter Builder
-> Builder
-> Builder
-> Bool
-> Bool
-> RDFGraph
-> Formatter Builder
forall a.
(Builder -> State a ())
-> (Bool -> State a ())
-> (RDFGraph -> a -> a)
-> (NamespaceMap -> State a Builder)
-> (a -> SubjTree RDFLabel)
-> State a Builder
-> Builder
-> Builder
-> Bool
-> Bool
-> RDFGraph
-> State a Builder
formatGraph_ Builder -> Formatter ()
setIndent Bool -> Formatter ()
setLineBreak RDFGraph -> TurtleFormatterState -> TurtleFormatterState
newState NamespaceMap -> Formatter Builder
formatPrefixes TurtleFormatterState -> SubjTree RDFLabel
subjs Formatter Builder
formatSubjects

formatPrefixes :: NamespaceMap -> Formatter B.Builder
formatPrefixes :: NamespaceMap -> Formatter Builder
formatPrefixes = (Builder -> Formatter Builder) -> NamespaceMap -> Formatter Builder
forall a.
(Builder -> State a Builder) -> NamespaceMap -> State a Builder
formatPrefixes_ Builder -> Formatter Builder
nextLine

formatSubjects :: Formatter B.Builder
formatSubjects :: Formatter Builder
formatSubjects = State TurtleFormatterState RDFLabel
-> (LabelContext -> RDFLabel -> Formatter Builder)
-> (TurtleFormatterState -> PredTree RDFLabel)
-> (RDFLabel -> Builder -> Formatter Builder)
-> (TurtleFormatterState -> SubjTree RDFLabel)
-> (Builder -> Formatter Builder)
-> Formatter Builder
forall a.
State a RDFLabel
-> (LabelContext -> RDFLabel -> State a Builder)
-> (a -> PredTree RDFLabel)
-> (RDFLabel -> Builder -> State a Builder)
-> (a -> SubjTree RDFLabel)
-> (Builder -> State a Builder)
-> State a Builder
formatSubjects_ State TurtleFormatterState RDFLabel
nextSubject LabelContext -> RDFLabel -> Formatter Builder
formatLabel TurtleFormatterState -> PredTree RDFLabel
props RDFLabel -> Builder -> Formatter Builder
formatProperties TurtleFormatterState -> SubjTree RDFLabel
subjs Builder -> Formatter Builder
nextLine

formatProperties :: RDFLabel -> B.Builder -> Formatter B.Builder
formatProperties :: RDFLabel -> Builder -> Formatter Builder
formatProperties = (RDFLabel -> State TurtleFormatterState RDFLabel)
-> (LabelContext -> RDFLabel -> Formatter Builder)
-> (RDFLabel -> RDFLabel -> Builder -> Formatter Builder)
-> (TurtleFormatterState -> PredTree RDFLabel)
-> (Builder -> Formatter Builder)
-> RDFLabel
-> Builder
-> Formatter Builder
forall a.
(RDFLabel -> State a RDFLabel)
-> (LabelContext -> RDFLabel -> State a Builder)
-> (RDFLabel -> RDFLabel -> Builder -> State a Builder)
-> (a -> PredTree RDFLabel)
-> (Builder -> State a Builder)
-> RDFLabel
-> Builder
-> State a Builder
formatProperties_ RDFLabel -> State TurtleFormatterState RDFLabel
nextProperty LabelContext -> RDFLabel -> Formatter Builder
formatLabel RDFLabel -> RDFLabel -> Builder -> Formatter Builder
formatObjects TurtleFormatterState -> PredTree RDFLabel
props Builder -> Formatter Builder
nextLine

formatObjects :: RDFLabel -> RDFLabel -> B.Builder -> Formatter B.Builder
formatObjects :: RDFLabel -> RDFLabel -> Builder -> Formatter Builder
formatObjects = (RDFLabel -> RDFLabel -> State TurtleFormatterState RDFLabel)
-> (LabelContext -> RDFLabel -> Formatter Builder)
-> (TurtleFormatterState -> [RDFLabel])
-> (Builder -> Formatter Builder)
-> RDFLabel
-> RDFLabel
-> Builder
-> Formatter Builder
forall a.
(RDFLabel -> RDFLabel -> State a RDFLabel)
-> (LabelContext -> RDFLabel -> State a Builder)
-> (a -> [RDFLabel])
-> (Builder -> State a Builder)
-> RDFLabel
-> RDFLabel
-> Builder
-> State a Builder
formatObjects_ RDFLabel -> RDFLabel -> State TurtleFormatterState RDFLabel
nextObject LabelContext -> RDFLabel -> Formatter Builder
formatLabel TurtleFormatterState -> [RDFLabel]
objs Builder -> Formatter Builder
nextLine

{-
Add a blank node inline.
-}

insertBnode :: LabelContext -> RDFLabel -> Formatter B.Builder
insertBnode :: LabelContext -> RDFLabel -> Formatter Builder
insertBnode LabelContext
SubjContext RDFLabel
lbl = do
  -- a safety check
  Bool
flag <- (TurtleFormatterState -> PredTree RDFLabel)
-> State TurtleFormatterState Bool
forall a b. (a -> [b]) -> State a Bool
hasMore TurtleFormatterState -> PredTree RDFLabel
props
  if Bool
flag
    then do
      Builder
txt <- (Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
"\n") (Builder -> Builder) -> Formatter Builder -> Formatter Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` RDFLabel -> Builder -> Formatter Builder
formatProperties RDFLabel
lbl Builder
""
      Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"[] ", Builder
txt]
    else String -> Formatter Builder
forall a. HasCallStack => String -> a
error (String -> Formatter Builder) -> String -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ String
"Internal error: expected properties with label: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RDFLabel -> String
forall a. Show a => a -> String
show RDFLabel
lbl

insertBnode LabelContext
_ RDFLabel
lbl = (TurtleFormatterState -> SubjTree RDFLabel)
-> (TurtleFormatterState -> PredTree RDFLabel)
-> (TurtleFormatterState -> [RDFLabel])
-> (TurtleFormatterState
    -> SubjTree RDFLabel
    -> PredTree RDFLabel
    -> [RDFLabel]
    -> TurtleFormatterState)
-> (RDFLabel -> Builder -> Formatter Builder)
-> RDFLabel
-> Formatter Builder
forall a.
(a -> SubjTree RDFLabel)
-> (a -> PredTree RDFLabel)
-> (a -> [RDFLabel])
-> (a -> SubjTree RDFLabel -> PredTree RDFLabel -> [RDFLabel] -> a)
-> (RDFLabel -> Builder -> State a Builder)
-> RDFLabel
-> State a Builder
insertBnode_ TurtleFormatterState -> SubjTree RDFLabel
subjs TurtleFormatterState -> PredTree RDFLabel
props TurtleFormatterState -> [RDFLabel]
objs TurtleFormatterState
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> TurtleFormatterState
updateState RDFLabel -> Builder -> Formatter Builder
formatProperties RDFLabel
lbl

----------------------------------------------------------------------
--  Formatting helpers
----------------------------------------------------------------------

newState :: RDFGraph -> TurtleFormatterState -> TurtleFormatterState
newState :: RDFGraph -> TurtleFormatterState -> TurtleFormatterState
newState RDFGraph
gr TurtleFormatterState
st = 
    let pre' :: NamespaceMap
pre' = TurtleFormatterState -> NamespaceMap
prefixes TurtleFormatterState
st NamespaceMap -> NamespaceMap -> NamespaceMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` RDFGraph -> NamespaceMap
forall lb. NSGraph lb -> NamespaceMap
getNamespaces RDFGraph
gr
        (SubjTree RDFLabel
arcSubjs, [RDFLabel]
bNodes) = RDFGraph -> (SubjTree RDFLabel, [RDFLabel])
processArcs RDFGraph
gr

    in TurtleFormatterState
st  { graph :: RDFGraph
graph     = RDFGraph
gr
           , subjs :: SubjTree RDFLabel
subjs     = SubjTree RDFLabel
arcSubjs
           , props :: PredTree RDFLabel
props     = []
           , objs :: [RDFLabel]
objs      = []
           , prefixes :: NamespaceMap
prefixes  = NamespaceMap
pre'
           , bNodesCheck :: [RDFLabel]
bNodesCheck   = [RDFLabel]
bNodes
           }

-- A version of uncons for a list which is not empty but we haven't
-- encoded that invariant.
--
getNext :: [a] -> (a, [a])
getNext :: [a] -> (a, [a])
getNext [a]
xs = case [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
uncons [a]
xs of
               Just (a
a, [a]
as) -> (a
a, [a]
as)
               Maybe (a, [a])
Nothing -> String -> (a, [a])
forall a. HasCallStack => String -> a
error String
"Invariant broken: list is empty"


nextSubject :: Formatter RDFLabel
nextSubject :: State TurtleFormatterState RDFLabel
nextSubject = 
    (TurtleFormatterState -> (RDFLabel, TurtleFormatterState))
-> State TurtleFormatterState RDFLabel
forall a b. (a -> (b, a)) -> State a b
changeState ((TurtleFormatterState -> (RDFLabel, TurtleFormatterState))
 -> State TurtleFormatterState RDFLabel)
-> (TurtleFormatterState -> (RDFLabel, TurtleFormatterState))
-> State TurtleFormatterState RDFLabel
forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st -> 
        let ((RDFLabel
a,PredTree RDFLabel
b), SubjTree RDFLabel
sbs) = SubjTree RDFLabel
-> ((RDFLabel, PredTree RDFLabel), SubjTree RDFLabel)
forall a. [a] -> (a, [a])
getNext (TurtleFormatterState -> SubjTree RDFLabel
subjs TurtleFormatterState
st)
            nst :: TurtleFormatterState
nst = TurtleFormatterState
st  { subjs :: SubjTree RDFLabel
subjs = SubjTree RDFLabel
sbs
                      , props :: PredTree RDFLabel
props = PredTree RDFLabel
b
                      , objs :: [RDFLabel]
objs  = []
                      }
        in (RDFLabel
a, TurtleFormatterState
nst)

nextProperty :: RDFLabel -> Formatter RDFLabel
nextProperty :: RDFLabel -> State TurtleFormatterState RDFLabel
nextProperty RDFLabel
_ =
    (TurtleFormatterState -> (RDFLabel, TurtleFormatterState))
-> State TurtleFormatterState RDFLabel
forall a b. (a -> (b, a)) -> State a b
changeState ((TurtleFormatterState -> (RDFLabel, TurtleFormatterState))
 -> State TurtleFormatterState RDFLabel)
-> (TurtleFormatterState -> (RDFLabel, TurtleFormatterState))
-> State TurtleFormatterState RDFLabel
forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st ->
        let ((RDFLabel
a,[RDFLabel]
b), PredTree RDFLabel
prs) = PredTree RDFLabel -> ((RDFLabel, [RDFLabel]), PredTree RDFLabel)
forall a. [a] -> (a, [a])
getNext (TurtleFormatterState -> PredTree RDFLabel
props TurtleFormatterState
st)
            nst :: TurtleFormatterState
nst = TurtleFormatterState
st  { props :: PredTree RDFLabel
props = PredTree RDFLabel
prs
                      , objs :: [RDFLabel]
objs  = [RDFLabel]
b
                      }
        in (RDFLabel
a, TurtleFormatterState
nst)
        
nextObject :: RDFLabel -> RDFLabel -> Formatter RDFLabel
nextObject :: RDFLabel -> RDFLabel -> State TurtleFormatterState RDFLabel
nextObject RDFLabel
_ RDFLabel
_ =
    (TurtleFormatterState -> (RDFLabel, TurtleFormatterState))
-> State TurtleFormatterState RDFLabel
forall a b. (a -> (b, a)) -> State a b
changeState ((TurtleFormatterState -> (RDFLabel, TurtleFormatterState))
 -> State TurtleFormatterState RDFLabel)
-> (TurtleFormatterState -> (RDFLabel, TurtleFormatterState))
-> State TurtleFormatterState RDFLabel
forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st ->
        let (RDFLabel
ob, [RDFLabel]
obs) = [RDFLabel] -> (RDFLabel, [RDFLabel])
forall a. [a] -> (a, [a])
getNext (TurtleFormatterState -> [RDFLabel]
objs TurtleFormatterState
st)
            nst :: TurtleFormatterState
nst = TurtleFormatterState
st { objs :: [RDFLabel]
objs = [RDFLabel]
obs }
        in (RDFLabel
ob, TurtleFormatterState
nst)

nextLine :: B.Builder -> Formatter B.Builder
nextLine :: Builder -> Formatter Builder
nextLine = (TurtleFormatterState -> Builder)
-> SL Bool -> Builder -> Formatter Builder
forall a.
(a -> Builder) -> SLens a Bool -> Builder -> State a Builder
nextLine_ TurtleFormatterState -> Builder
indent SL Bool
_lineBreak

--  Format a label
--  Most labels are simply displayed as provided, but there are a
--  number of wrinkles to take care of here:
--  (a) blank nodes automatically allocated on input, with node
--      identifiers of the form of a digit string nnn.  These are
--      not syntactically valid, and are reassigned node identifiers
--      of the form _nnn, where nnn is chosen so that is does not
--      clash with any other identifier in the graph.
--  (b) URI nodes:  if possible, replace URI with qname,
--      else display as <uri>
--  (c) formula nodes (containing graphs).
--  (d) use the "special-case" formats for integer/float/double/string
--      literals.      
--      
-- This is being updated to produce inline formula, lists and     
-- blank nodes. The code is not efficient.
--
-- Note: There is a lot less customisation possible in Turtle than N3.
--      

formatLabel :: LabelContext -> RDFLabel -> Formatter B.Builder

{-
The "[..]" conversion is done last, after "()" and "{}" checks.

TODO: why is there a (_:_) check on the blank node?
-}
formatLabel :: LabelContext -> RDFLabel -> Formatter Builder
formatLabel LabelContext
lctxt lab :: RDFLabel
lab@(Blank (Char
_:String
_)) = do
  Maybe [RDFLabel]
mlst <- LabelContext -> RDFLabel -> Formatter (Maybe [RDFLabel])
extractList LabelContext
lctxt RDFLabel
lab
  case Maybe [RDFLabel]
mlst of
    Just [RDFLabel]
lst -> (RDFLabel -> Formatter Builder) -> [RDFLabel] -> Formatter Builder
forall a.
(RDFLabel -> State a Builder) -> [RDFLabel] -> State a Builder
insertList (LabelContext -> RDFLabel -> Formatter Builder
formatLabel LabelContext
ObjContext) [RDFLabel]
lst
    Maybe [RDFLabel]
Nothing -> do
      -- NOTE: unlike N3 we do not properly handle "formula"/named graphs
      -- also we only expand out bnodes into [...] format when it's a object.
      -- although we need to handle [] for the subject.
      [RDFLabel]
nb1 <- (TurtleFormatterState -> [RDFLabel])
-> StateT TurtleFormatterState Identity [RDFLabel]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TurtleFormatterState -> [RDFLabel]
bNodesCheck
      if LabelContext
lctxt LabelContext -> LabelContext -> Bool
forall a. Eq a => a -> a -> Bool
/= LabelContext
PredContext Bool -> Bool -> Bool
&& RDFLabel
lab RDFLabel -> [RDFLabel] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [RDFLabel]
nb1
        then LabelContext -> RDFLabel -> Formatter Builder
insertBnode LabelContext
lctxt RDFLabel
lab
        else RDFLabel -> Formatter Builder
formatNodeId RDFLabel
lab

-- formatLabel _ lab@(Res sn) = 
formatLabel LabelContext
ctxt (Res ScopedName
sn)
  | LabelContext
ctxt LabelContext -> LabelContext -> Bool
forall a. Eq a => a -> a -> Bool
== LabelContext
PredContext Bool -> Bool -> Bool
&& ScopedName
sn ScopedName -> ScopedName -> Bool
forall a. Eq a => a -> a -> Bool
== ScopedName
rdfType = Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
"a"
  | LabelContext
ctxt LabelContext -> LabelContext -> Bool
forall a. Eq a => a -> a -> Bool
== LabelContext
ObjContext  Bool -> Bool -> Bool
&& ScopedName
sn ScopedName -> ScopedName -> Bool
forall a. Eq a => a -> a -> Bool
== ScopedName
rdfNil  = Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
"()"
  | Bool
otherwise = (TurtleFormatterState -> Builder) -> Formatter Builder
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (ScopedName -> NamespaceMap -> Builder
formatScopedName ScopedName
sn (NamespaceMap -> Builder)
-> (TurtleFormatterState -> NamespaceMap)
-> TurtleFormatterState
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtleFormatterState -> NamespaceMap
prefixes)

formatLabel LabelContext
_ (Lit Text
lit) = Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ Text -> Builder
formatPlainLit Text
lit
formatLabel LabelContext
_ (LangLit Text
lit LanguageTag
lcode) = Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ Text -> LanguageTag -> Builder
formatLangLit Text
lit LanguageTag
lcode
formatLabel LabelContext
_ (TypedLit Text
lit ScopedName
dtype) = Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> ScopedName -> Builder
formatTypedLit Bool
False Text
lit ScopedName
dtype

formatLabel LabelContext
_ RDFLabel
lab = Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter 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

formatNodeId :: RDFLabel -> Formatter B.Builder
formatNodeId :: RDFLabel -> Formatter Builder
formatNodeId lab :: RDFLabel
lab@(Blank (Char
lnc:String
_)) =
    if Char -> Bool
isDigit Char
lnc then RDFLabel -> Formatter Builder
mapBlankNode RDFLabel
lab else Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter 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
formatNodeId RDFLabel
other = String -> Formatter Builder
forall a. HasCallStack => String -> a
error (String -> Formatter Builder) -> String -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ String
"formatNodeId not expecting a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RDFLabel -> String
forall a. Show a => a -> String
show RDFLabel
other -- to shut up -Wall

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

--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2013, 2014, 2018, 2019, 2020, 2021 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
--
--------------------------------------------------------------------------------