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

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  N3
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--                 2011, 2012, 2014, 2020 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  OverloadedStrings
--
--  This Module implements a Notation 3 formatter
--  for an 'RDFGraph' value.
--
-- REFERENCES:
--
--  - \"Notation3 (N3): A readable RDF syntax\",
--     W3C Team Submission 14 January 2008,
--     <http://www.w3.org/TeamSubmission/2008/SUBM-n3-20080114/>
--
--  - Tim Berners-Lee's design issues series notes and description,
--     <http://www.w3.org/DesignIssues/Notation3.html>
--
--  - Notation 3 Primer by Sean Palmer,
--      <http://www.w3.org/2000/10/swap/Primer.html>
--
--  TODO:
--
--   * Initial prefix list to include nested formulae;
--      then don't need to update prefix list for these.
--
--   * correct output of strings containing unsupported escape
--     characters (such as @\\q@)
--
--   * more flexible terminator generation for formatted formulae
--     (for inline blank nodes.)
--
--------------------------------------------------------------------------------

{-
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.N3
    ( NodeGenLookupMap
    , formatGraphAsText
    , formatGraphAsLazyText
    , formatGraphAsBuilder
    , formatGraphIndent  
    , formatGraphDiag
    )
where

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

import Swish.Namespace (ScopedName)

import Swish.RDF.Graph (
  RDFGraph, RDFLabel(..),
  NamespaceMap,
  emptyNamespaceMap,
  FormulaMap, emptyFormulaMap,
  setNamespaces, getNamespaces,
  getFormulae,
  emptyRDFGraph
  )

import Swish.RDF.Vocabulary (
  rdfType,
  rdfNil,
  owlSameAs, logImplies
  )

import Control.Monad (void)
import Control.Monad.State (State, modify, get, gets, put, runState)

import Data.Char (isDigit)
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 N3FormatterState = N3FS
    { N3FormatterState -> Builder
indent    :: B.Builder
    , N3FormatterState -> Bool
lineBreak :: Bool
    , N3FormatterState -> RDFGraph
graph     :: RDFGraph
    , N3FormatterState -> SubjTree RDFLabel
subjs     :: SubjTree RDFLabel
    , N3FormatterState -> PredTree RDFLabel
props     :: PredTree RDFLabel   -- for last subject selected
    , N3FormatterState -> [RDFLabel]
objs      :: [RDFLabel]          -- for last property selected
    , N3FormatterState -> FormulaMap RDFLabel
formAvail :: FormulaMap RDFLabel
    , N3FormatterState -> [(RDFLabel, RDFGraph)]
formQueue :: [(RDFLabel,RDFGraph)]
    , N3FormatterState -> NamespaceMap
prefixes  :: NamespaceMap
    , N3FormatterState -> NodeGenState
nodeGenSt :: NodeGenState
    , N3FormatterState -> [RDFLabel]
bNodesCheck   :: [RDFLabel]      -- these bNodes are not to be converted to '[..]' format
    , N3FormatterState -> [String]
traceBuf  :: [String]
    }

type SL a = SLens N3FormatterState a

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

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

type Formatter a = State N3FormatterState a

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

emptyN3FS :: NamespaceMap -> NodeGenState -> N3FormatterState
emptyN3FS :: NamespaceMap -> NodeGenState -> N3FormatterState
emptyN3FS NamespaceMap
pmap NodeGenState
ngs = N3FS :: Builder
-> Bool
-> RDFGraph
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> FormulaMap RDFLabel
-> [(RDFLabel, RDFGraph)]
-> NamespaceMap
-> NodeGenState
-> [RDFLabel]
-> [String]
-> N3FormatterState
N3FS
    { 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      = []
    , formAvail :: FormulaMap RDFLabel
formAvail = FormulaMap RDFLabel
emptyFormulaMap
    , formQueue :: [(RDFLabel, RDFGraph)]
formQueue = []
    , prefixes :: NamespaceMap
prefixes  = NamespaceMap
pmap
    , nodeGenSt :: NodeGenState
nodeGenSt = NodeGenState
ngs
    , bNodesCheck :: [RDFLabel]
bNodesCheck   = []
    , traceBuf :: [String]
traceBuf  = []
    }

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

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

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

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

{-
getObjs :: Formatter ([RDFLabel])
getObjs = objs `fmap` get

setObjs :: [RDFLabel] -> Formatter ()
setObjs os = do
  st <- get
  put $ st { objs = os }
-}

{-
addTrace :: String -> Formatter ()
addTrace tr = do
  st <- get
  put $ st { traceBuf = tr : traceBuf st }
-}
  
queueFormula :: RDFLabel -> Formatter ()
queueFormula :: RDFLabel -> Formatter ()
queueFormula RDFLabel
fn = do
  N3FormatterState
st <- StateT N3FormatterState Identity N3FormatterState
forall s (m :: * -> *). MonadState s m => m s
get
  let fa :: FormulaMap RDFLabel
fa = N3FormatterState -> FormulaMap RDFLabel
formAvail N3FormatterState
st
      _newState :: RDFGraph -> N3FormatterState
_newState RDFGraph
fv = N3FormatterState
st {
                       formAvail :: FormulaMap RDFLabel
formAvail = RDFLabel -> FormulaMap RDFLabel -> FormulaMap RDFLabel
forall k a. Ord k => k -> Map k a -> Map k a
M.delete RDFLabel
fn FormulaMap RDFLabel
fa,
                       formQueue :: [(RDFLabel, RDFGraph)]
formQueue = (RDFLabel
fn,RDFGraph
fv) (RDFLabel, RDFGraph)
-> [(RDFLabel, RDFGraph)] -> [(RDFLabel, RDFGraph)]
forall a. a -> [a] -> [a]
: N3FormatterState -> [(RDFLabel, RDFGraph)]
formQueue N3FormatterState
st
                     }
  case RDFLabel -> FormulaMap RDFLabel -> Maybe RDFGraph
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup RDFLabel
fn FormulaMap RDFLabel
fa of
    Maybe RDFGraph
Nothing -> () -> Formatter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just RDFGraph
v -> Formatter () -> Formatter ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Formatter () -> Formatter ()) -> Formatter () -> Formatter ()
forall a b. (a -> b) -> a -> b
$ N3FormatterState -> Formatter ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (N3FormatterState -> Formatter ())
-> N3FormatterState -> Formatter ()
forall a b. (a -> b) -> a -> b
$ RDFGraph -> N3FormatterState
_newState RDFGraph
v

{-
Return the graph associated with the label and delete it
from the store, if there is an association, otherwise
return Nothing.
-}
extractFormula :: RDFLabel -> Formatter (Maybe RDFGraph)
extractFormula :: RDFLabel -> Formatter (Maybe RDFGraph)
extractFormula RDFLabel
fn = do
  N3FormatterState
st <- StateT N3FormatterState Identity N3FormatterState
forall s (m :: * -> *). MonadState s m => m s
get
  let (Maybe RDFGraph
rval, FormulaMap RDFLabel
nform) = (RDFLabel -> RDFGraph -> Maybe RDFGraph)
-> RDFLabel
-> FormulaMap RDFLabel
-> (Maybe RDFGraph, FormulaMap RDFLabel)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
M.updateLookupWithKey (\RDFLabel
_ RDFGraph
_ -> Maybe RDFGraph
forall a. Maybe a
Nothing) RDFLabel
fn (FormulaMap RDFLabel -> (Maybe RDFGraph, FormulaMap RDFLabel))
-> FormulaMap RDFLabel -> (Maybe RDFGraph, FormulaMap RDFLabel)
forall a b. (a -> b) -> a -> b
$ N3FormatterState -> FormulaMap RDFLabel
formAvail N3FormatterState
st
  N3FormatterState -> Formatter ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (N3FormatterState -> Formatter ())
-> N3FormatterState -> Formatter ()
forall a b. (a -> b) -> a -> b
$ N3FormatterState
st { formAvail :: FormulaMap RDFLabel
formAvail = FormulaMap RDFLabel
nform }
  Maybe RDFGraph -> Formatter (Maybe RDFGraph)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RDFGraph
rval

{-
moreFormulae :: Formatter Bool
moreFormulae =  do
  st <- get
  return $ not $ null (formQueue st)

nextFormula :: Formatter (RDFLabel,RDFGraph)
nextFormula = do
  st <- get
  let (nf : fq) = formQueue st
  put $ st { formQueue = fq }
  return nf

-}

{-
TODO:

Should we change the preds/objs entries as well?

-}
extractList :: LabelContext -> RDFLabel -> Formatter (Maybe [RDFLabel])
extractList :: LabelContext -> RDFLabel -> Formatter (Maybe [RDFLabel])
extractList = (N3FormatterState -> SubjTree RDFLabel)
-> (N3FormatterState -> 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_ N3FormatterState -> SubjTree RDFLabel
subjs N3FormatterState -> 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, N3FormatterState
fgs) = Formatter Builder
-> N3FormatterState -> (Builder, N3FormatterState)
forall s a. State s a -> s -> (a, s)
runState Formatter Builder
fg (NamespaceMap -> NodeGenState -> N3FormatterState
emptyN3FS NamespaceMap
emptyNamespaceMap NodeGenState
ngs)
      ogs :: NodeGenState
ogs        = N3FormatterState -> NodeGenState
nodeGenSt N3FormatterState
fgs
  
  in (Builder
out, NodeGenState -> NodeGenLookupMap
nodeMap NodeGenState
ogs, NodeGenState -> Word32
nodeGen NodeGenState
ogs, N3FormatterState -> [String]
traceBuf N3FormatterState
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 -> N3FormatterState -> N3FormatterState)
-> (NamespaceMap -> Formatter Builder)
-> (N3FormatterState -> 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 -> N3FormatterState -> N3FormatterState
newState NamespaceMap -> Formatter Builder
formatPrefixes N3FormatterState -> 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 N3FormatterState RDFLabel
-> (LabelContext -> RDFLabel -> Formatter Builder)
-> (N3FormatterState -> PredTree RDFLabel)
-> (RDFLabel -> Builder -> Formatter Builder)
-> (N3FormatterState -> 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 N3FormatterState RDFLabel
nextSubject LabelContext -> RDFLabel -> Formatter Builder
formatLabel N3FormatterState -> PredTree RDFLabel
props RDFLabel -> Builder -> Formatter Builder
formatProperties N3FormatterState -> SubjTree RDFLabel
subjs Builder -> Formatter Builder
nextLine

formatProperties :: RDFLabel -> B.Builder -> Formatter B.Builder
formatProperties :: RDFLabel -> Builder -> Formatter Builder
formatProperties = (RDFLabel -> State N3FormatterState RDFLabel)
-> (LabelContext -> RDFLabel -> Formatter Builder)
-> (RDFLabel -> RDFLabel -> Builder -> Formatter Builder)
-> (N3FormatterState -> 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 N3FormatterState RDFLabel
nextProperty LabelContext -> RDFLabel -> Formatter Builder
formatLabel RDFLabel -> RDFLabel -> Builder -> Formatter Builder
formatObjects N3FormatterState -> 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 N3FormatterState RDFLabel)
-> (LabelContext -> RDFLabel -> Formatter Builder)
-> (N3FormatterState -> [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 N3FormatterState RDFLabel
nextObject LabelContext -> RDFLabel -> Formatter Builder
formatLabel N3FormatterState -> [RDFLabel]
objs Builder -> Formatter Builder
nextLine

insertFormula :: RDFGraph -> Formatter B.Builder
insertFormula :: RDFGraph -> Formatter Builder
insertFormula RDFGraph
gr = do
  NamespaceMap
pmap0 <- (N3FormatterState -> NamespaceMap)
-> StateT N3FormatterState Identity NamespaceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets N3FormatterState -> NamespaceMap
prefixes
  NodeGenState
ngs0  <- (N3FormatterState -> NodeGenState)
-> StateT N3FormatterState Identity NodeGenState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets N3FormatterState -> NodeGenState
nodeGenSt
  Builder
ind   <- (N3FormatterState -> Builder) -> Formatter Builder
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets N3FormatterState -> Builder
indent
  let grm :: Formatter Builder
grm = Builder -> Builder -> Bool -> Bool -> RDFGraph -> Formatter Builder
formatGraph (Builder
ind Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
"    ") Builder
"" Bool
True Bool
False
            (NamespaceMap -> RDFGraph -> RDFGraph
forall lb. NamespaceMap -> NSGraph lb -> NSGraph lb
setNamespaces NamespaceMap
emptyNamespaceMap RDFGraph
gr)

      (Builder
f3str, N3FormatterState
fgs') = Formatter Builder
-> N3FormatterState -> (Builder, N3FormatterState)
forall s a. State s a -> s -> (a, s)
runState Formatter Builder
grm (NamespaceMap -> NodeGenState -> N3FormatterState
emptyN3FS NamespaceMap
pmap0 NodeGenState
ngs0)

  (N3FormatterState -> N3FormatterState) -> Formatter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((N3FormatterState -> N3FormatterState) -> Formatter ())
-> (N3FormatterState -> N3FormatterState) -> Formatter ()
forall a b. (a -> b) -> a -> b
$ \N3FormatterState
st -> N3FormatterState
st { nodeGenSt :: NodeGenState
nodeGenSt = N3FormatterState -> NodeGenState
nodeGenSt N3FormatterState
fgs'
                     , prefixes :: NamespaceMap
prefixes  = N3FormatterState -> NamespaceMap
prefixes N3FormatterState
fgs' }
  Builder
f4str <- Builder -> Formatter Builder
nextLine 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
f3str, Builder
f4str]

{-
Add a blank node inline.
-}

insertBnode :: LabelContext -> RDFLabel -> Formatter B.Builder
insertBnode :: LabelContext -> RDFLabel -> Formatter Builder
insertBnode LabelContext
SubjContext RDFLabel
lbl = do
  Bool
flag <- (N3FormatterState -> PredTree RDFLabel)
-> State N3FormatterState Bool
forall a b. (a -> [b]) -> State a Bool
hasMore N3FormatterState -> PredTree RDFLabel
props
  Builder
txt <- if Bool
flag
         then (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
""
         else Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
""

  -- TODO: handle indentation?
  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, Builder
"]"]

insertBnode LabelContext
_ RDFLabel
lbl = (N3FormatterState -> SubjTree RDFLabel)
-> (N3FormatterState -> PredTree RDFLabel)
-> (N3FormatterState -> [RDFLabel])
-> (N3FormatterState
    -> SubjTree RDFLabel
    -> PredTree RDFLabel
    -> [RDFLabel]
    -> N3FormatterState)
-> (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_ N3FormatterState -> SubjTree RDFLabel
subjs N3FormatterState -> PredTree RDFLabel
props N3FormatterState -> [RDFLabel]
objs N3FormatterState
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> N3FormatterState
updateState RDFLabel -> Builder -> Formatter Builder
formatProperties RDFLabel
lbl

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

newState :: RDFGraph -> N3FormatterState -> N3FormatterState
newState :: RDFGraph -> N3FormatterState -> N3FormatterState
newState RDFGraph
gr N3FormatterState
st = 
    let pre' :: NamespaceMap
pre' = N3FormatterState -> NamespaceMap
prefixes N3FormatterState
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 N3FormatterState
st  { graph :: RDFGraph
graph     = RDFGraph
gr
           , subjs :: SubjTree RDFLabel
subjs     = SubjTree RDFLabel
arcSubjs
           , props :: PredTree RDFLabel
props     = []
           , objs :: [RDFLabel]
objs      = []
           , formAvail :: FormulaMap RDFLabel
formAvail = RDFGraph -> FormulaMap RDFLabel
forall lb. NSGraph lb -> FormulaMap lb
getFormulae RDFGraph
gr
           , prefixes :: NamespaceMap
prefixes  = NamespaceMap
pre'
           , bNodesCheck :: [RDFLabel]
bNodesCheck   = [RDFLabel]
bNodes
           }

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

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

nextLine :: B.Builder -> Formatter B.Builder
nextLine :: Builder -> Formatter Builder
nextLine = (N3FormatterState -> Builder)
-> SL Bool -> Builder -> Formatter Builder
forall a.
(a -> Builder) -> SLens a Bool -> Builder -> State a Builder
nextLine_ N3FormatterState -> 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
--      literals.      
--      
--  [[[TODO:]]]
--  (d) generate multi-line literals when appropriate
--
-- This is being updated to produce inline formula, lists and     
-- blank nodes. The code is not efficient.
--

specialTable :: [(ScopedName, String)]
specialTable :: [(ScopedName, String)]
specialTable = 
  [ (ScopedName
rdfType, String
"a")
  , (ScopedName
owlSameAs, String
"=")
  , (ScopedName
logImplies, String
"=>")
  , (ScopedName
rdfNil, String
"()")
  ]

formatLabel :: LabelContext -> RDFLabel -> Formatter B.Builder
{-
formatLabel lab@(Blank (_:_)) = do
  name <- formatNodeId lab
  queueFormula lab
  return name
-}

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

TODO: look at the (_:_) check on the blank string; why is this needed?
-}
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
              Maybe RDFGraph
mfml <- RDFLabel -> Formatter (Maybe RDFGraph)
extractFormula RDFLabel
lab
              case Maybe RDFGraph
mfml of
                Just RDFGraph
fml -> RDFGraph -> Formatter Builder
insertFormula RDFGraph
fml
                Maybe RDFGraph
Nothing -> do
                          [RDFLabel]
nb1 <- (N3FormatterState -> [RDFLabel])
-> StateT N3FormatterState Identity [RDFLabel]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets N3FormatterState -> [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 LabelContext
_ lab :: RDFLabel
lab@(Res ScopedName
sn) = 
  case ScopedName -> [(ScopedName, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ScopedName
sn [(ScopedName, String)]
specialTable of
    Just String
txt -> 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 -> String -> Builder
quoteB Bool
True String
txt -- TODO: do we need to quote?
    Maybe String
Nothing -> do
      NamespaceMap
pr <- (N3FormatterState -> NamespaceMap)
-> StateT N3FormatterState Identity NamespaceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets N3FormatterState -> NamespaceMap
prefixes
      RDFLabel -> Formatter ()
queueFormula 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
$ ScopedName -> NamespaceMap -> Builder
formatScopedName ScopedName
sn NamespaceMap
pr

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
True 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, 2014, 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
--
--------------------------------------------------------------------------------