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

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Internal
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--                 2011, 2012, 2013, 2014, 2016, 2018, 2020 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  CPP, OverloadedStrings
--
--  Utility routines.
--
--------------------------------------------------------------------------------

module Swish.RDF.Formatter.Internal
    ( NodeGenLookupMap
    , SLens(..)
    , SubjTree
    , PredTree
    , LabelContext(..)
    , NodeGenState(..)
    , changeState
    , hasMore
    , emptyNgs 
    , getBNodeLabel
    , findMaxBnode
    , splitOnLabel
    , getCollection
    , processArcs
    , findPrefix
      -- N3-like formatting
    , quoteB
    , quoteText
    , showScopedName
    , formatScopedName
    , formatPrefixLines
    , formatPlainLit
    , formatLangLit
    , formatTypedLit
    , insertList
    , nextLine_
    , mapBlankNode_
    , formatPrefixes_
    , formatGraph_
    , formatSubjects_
    , formatProperties_
    , formatObjects_
    , insertBnode_
    , extractList_
    )
where

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

import Swish.GraphClass (Arc(..), ArcSet)
import Swish.Namespace (ScopedName, getScopeLocal, getScopeURI)
import Swish.QName (getLName)

import Swish.RDF.Graph (RDFGraph, RDFLabel(..), NamespaceMap)
import Swish.RDF.Graph (labels, getArcs
                       , getNamespaces
                       , resRdfFirst, resRdfRest, resRdfNil
                       , quote
                       , quoteT
                       )
import Swish.RDF.Vocabulary (LanguageTag, fromLangTag, xsdBoolean, xsdDecimal, xsdInteger, xsdDouble)

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

import Data.List (foldl', groupBy, intersperse, partition)
import Data.Maybe (isJust)
#if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)
import Data.Monoid (Monoid(..), mconcat)
#endif
import Data.Tuple (swap)
import Data.Word

import Network.URI (URI)

findPrefix :: URI -> M.Map a URI -> Maybe a
findPrefix :: URI -> Map a URI -> Maybe a
findPrefix URI
u = URI -> Map URI a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup URI
u (Map URI a -> Maybe a)
-> (Map a URI -> Map URI a) -> Map a URI -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(URI, a)] -> Map URI a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(URI, a)] -> Map URI a)
-> (Map a URI -> [(URI, a)]) -> Map a URI -> Map URI a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, URI) -> (URI, a)) -> [(a, URI)] -> [(URI, a)]
forall a b. (a -> b) -> [a] -> [b]
map (a, URI) -> (URI, a)
forall a b. (a, b) -> (b, a)
swap ([(a, URI)] -> [(URI, a)])
-> (Map a URI -> [(a, URI)]) -> Map a URI -> [(URI, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a URI -> [(a, URI)]
forall k a. Map k a -> [(k, a)]
M.assocs

{- 

Playing around with ideas to reduce the amount of duplicated code
without (for instance) deciding on one of the many lens packages
available. It does not seem worth further re-factoring until we
have another formatter using a turtle-like syntax (e.g. TriG
http://www4.wiwiss.fu-berlin.de/bizer/trig/).

-}

data SLens a b = SLens (a -> b) (a -> b -> a)

-- | Extract the setter.
slens :: SLens a b -> a -> b -> a
slens :: SLens a b -> a -> b -> a
slens (SLens a -> b
_ a -> b -> a
s) = a -> b -> a
s

-- | Extract the getter.
glens :: SLens a b -> a -> b
glens :: SLens a b -> a -> b
glens (SLens a -> b
g a -> b -> a
_) = a -> b
g

-- | Node name generation state information that carries through
--  and is updated by nested formulae.
type NodeGenLookupMap = M.Map RDFLabel Word32

{-
TODO: look at using Swish.Graphpartition instead.
-}
type SubjTree lb = [(lb,PredTree lb)]
type PredTree lb = [(lb,[lb])]

-- | The context for label creation.
--
data LabelContext = SubjContext | PredContext | ObjContext
                    deriving (LabelContext -> LabelContext -> Bool
(LabelContext -> LabelContext -> Bool)
-> (LabelContext -> LabelContext -> Bool) -> Eq LabelContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LabelContext -> LabelContext -> Bool
$c/= :: LabelContext -> LabelContext -> Bool
== :: LabelContext -> LabelContext -> Bool
$c== :: LabelContext -> LabelContext -> Bool
Eq, Int -> LabelContext -> ShowS
[LabelContext] -> ShowS
LabelContext -> String
(Int -> LabelContext -> ShowS)
-> (LabelContext -> String)
-> ([LabelContext] -> ShowS)
-> Show LabelContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelContext] -> ShowS
$cshowList :: [LabelContext] -> ShowS
show :: LabelContext -> String
$cshow :: LabelContext -> String
showsPrec :: Int -> LabelContext -> ShowS
$cshowsPrec :: Int -> LabelContext -> ShowS
Show)

-- | A generator for BNode labels.
data NodeGenState = Ngs
    { NodeGenState -> NodeGenLookupMap
nodeMap   :: NodeGenLookupMap
    , NodeGenState -> Word32
nodeGen   :: Word32
    }

-- | Create an empty node generator.
emptyNgs :: NodeGenState
emptyNgs :: NodeGenState
emptyNgs = NodeGenLookupMap -> Word32 -> NodeGenState
Ngs NodeGenLookupMap
forall k a. Map k a
M.empty Word32
0

{-|
Get the label text for the blank node, creating a new one
if it has not been seen before.

The label text is currently _:swish<number> where number is
1 or higher. This format may be changed in the future.
-}
getBNodeLabel :: RDFLabel -> NodeGenState -> (B.Builder, Maybe NodeGenState)
getBNodeLabel :: RDFLabel -> NodeGenState -> (Builder, Maybe NodeGenState)
getBNodeLabel RDFLabel
lab NodeGenState
ngs = 
    let cmap :: NodeGenLookupMap
cmap = NodeGenState -> NodeGenLookupMap
nodeMap NodeGenState
ngs
        cval :: Word32
cval = NodeGenState -> Word32
nodeGen NodeGenState
ngs

        (Word32
lnum, Maybe NodeGenState
mngs) = 
            case Word32 -> RDFLabel -> NodeGenLookupMap -> Word32
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Word32
0 RDFLabel
lab NodeGenLookupMap
cmap of
              Word32
0 -> let nval :: Word32
nval = Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
cval
                       nmap :: NodeGenLookupMap
nmap = RDFLabel -> Word32 -> NodeGenLookupMap -> NodeGenLookupMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert RDFLabel
lab Word32
nval NodeGenLookupMap
cmap
                   in (Word32
nval, NodeGenState -> Maybe NodeGenState
forall a. a -> Maybe a
Just (NodeGenState
ngs { nodeGen :: Word32
nodeGen = Word32
nval, nodeMap :: NodeGenLookupMap
nodeMap = NodeGenLookupMap
nmap }))

              Word32
n -> (Word32
n, Maybe NodeGenState
forall a. Maybe a
Nothing)

    in (Builder
"_:swish" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
B.fromString (Word32 -> String
forall a. Show a => a -> String
show Word32
lnum), Maybe NodeGenState
mngs)


{-|
Process the state, returning a value extracted from it
after updating the state.
-}

changeState ::
    (a -> (b, a)) -> State a b
changeState :: (a -> (b, a)) -> State a b
changeState a -> (b, a)
f = do
  a
st <- StateT a Identity a
forall s (m :: * -> *). MonadState s m => m s
get
  let (b
rval, a
nst) = a -> (b, a)
f a
st
  a -> StateT a Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put a
nst
  b -> State a b
forall (m :: * -> *) a. Monad m => a -> m a
return b
rval

{-|
Apply the function to the state and return True
if the result is not empty.
-}

hasMore :: (a -> [b]) -> State a Bool
hasMore :: (a -> [b]) -> State a Bool
hasMore a -> [b]
lens = (a -> Bool) -> State a Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([b] -> Bool) -> (a -> [b]) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [b]
lens)


{-|
Removes the first occurrence of the item from the
association list, returning it's contents and the rest
of the list, if it exists.
-}
removeItem :: (Eq a) => [(a,b)] -> a -> Maybe (b, [(a,b)])
removeItem :: [(a, b)] -> a -> Maybe (b, [(a, b)])
removeItem [(a, b)]
os a
x =
  let ([(a, b)]
as, [(a, b)]
bs) = ((a, b) -> Bool) -> [(a, b)] -> ([(a, b)], [(a, b)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(a, b)
a -> (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) [(a, b)]
os
  in case [(a, b)]
bs of
    ((a
_,b
b):[(a, b)]
bbs) -> (b, [(a, b)]) -> Maybe (b, [(a, b)])
forall a. a -> Maybe a
Just (b
b, [(a, b)]
as [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [(a, b)]
bbs)
    [] -> Maybe (b, [(a, b)])
forall a. Maybe a
Nothing

{-|
Given a set of statements and a label, return the details of the
RDF collection referred to by label, or Nothing.

For label to be considered as representing a collection we require the
following conditions to hold (this is only to support the
serialisation using the '(..)' syntax and does not make any statement
about semantics of the statements with regard to RDF Collections):

  - there must be one rdf_first and one rdfRest statement
  - there must be no other predicates for the label

-} 
getCollection ::          
  SubjTree RDFLabel -- ^ statements organized by subject
  -> RDFLabel -- ^ does this label represent a list?
  -> Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
     -- ^ the statements with the elements removed; the
     -- content elements of the collection (the objects of the rdf:first
     -- predicate) and the nodes that represent the spine of the
     -- collection (in reverse order, unlike the actual contents which are in
     -- order).
getCollection :: SubjTree RDFLabel
-> RDFLabel -> Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
getCollection SubjTree RDFLabel
subjList RDFLabel
lbl = SubjTree RDFLabel
-> RDFLabel
-> ([RDFLabel], [RDFLabel])
-> Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
go SubjTree RDFLabel
subjList RDFLabel
lbl ([],[]) 
    where
      go :: SubjTree RDFLabel
-> RDFLabel
-> ([RDFLabel], [RDFLabel])
-> Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
go SubjTree RDFLabel
sl RDFLabel
l ([RDFLabel]
cs,[RDFLabel]
ss) | RDFLabel
l RDFLabel -> RDFLabel -> Bool
forall a. Eq a => a -> a -> Bool
== RDFLabel
resRdfNil = (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
-> Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
forall a. a -> Maybe a
Just (SubjTree RDFLabel
sl, [RDFLabel] -> [RDFLabel]
forall a. [a] -> [a]
reverse [RDFLabel]
cs, [RDFLabel]
ss)
                      | Bool
otherwise = do
        ([(RDFLabel, [RDFLabel])]
pList1, SubjTree RDFLabel
sl') <- SubjTree RDFLabel
-> RDFLabel -> Maybe ([(RDFLabel, [RDFLabel])], SubjTree RDFLabel)
forall a b. Eq a => [(a, b)] -> a -> Maybe (b, [(a, b)])
removeItem SubjTree RDFLabel
sl RDFLabel
l
        ([RDFLabel
pFirst], [(RDFLabel, [RDFLabel])]
pList2) <- [(RDFLabel, [RDFLabel])]
-> RDFLabel -> Maybe ([RDFLabel], [(RDFLabel, [RDFLabel])])
forall a b. Eq a => [(a, b)] -> a -> Maybe (b, [(a, b)])
removeItem [(RDFLabel, [RDFLabel])]
pList1 RDFLabel
resRdfFirst
        ([RDFLabel
pNext], []) <- [(RDFLabel, [RDFLabel])]
-> RDFLabel -> Maybe ([RDFLabel], [(RDFLabel, [RDFLabel])])
forall a b. Eq a => [(a, b)] -> a -> Maybe (b, [(a, b)])
removeItem [(RDFLabel, [RDFLabel])]
pList2 RDFLabel
resRdfRest

        SubjTree RDFLabel
-> RDFLabel
-> ([RDFLabel], [RDFLabel])
-> Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
go SubjTree RDFLabel
sl' RDFLabel
pNext (RDFLabel
pFirst RDFLabel -> [RDFLabel] -> [RDFLabel]
forall a. a -> [a] -> [a]
: [RDFLabel]
cs, RDFLabel
l RDFLabel -> [RDFLabel] -> [RDFLabel]
forall a. a -> [a] -> [a]
: [RDFLabel]
ss)

----------------------------------------------------------------------
--  Graph-related helper functions
----------------------------------------------------------------------

-- partiton up the graph; should this be replaced by Swish.GraphPartition?
-- Also extracts a list of bnodes in the graph
--
processArcs :: RDFGraph -> (SubjTree RDFLabel, [RDFLabel])
processArcs :: RDFGraph -> (SubjTree RDFLabel, [RDFLabel])
processArcs RDFGraph
gr =
    let arcs :: SortedArcs RDFLabel
arcs = ArcSet RDFLabel -> SortedArcs RDFLabel
forall lb. ArcSet lb -> SortedArcs lb
sortArcs (ArcSet RDFLabel -> SortedArcs RDFLabel)
-> ArcSet RDFLabel -> SortedArcs RDFLabel
forall a b. (a -> b) -> a -> b
$ RDFGraph -> ArcSet RDFLabel
forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs RDFGraph
gr
    in (SortedArcs RDFLabel -> SubjTree RDFLabel
forall lb. Eq lb => SortedArcs lb -> SubjTree lb
arcTree SortedArcs RDFLabel
arcs, SortedArcs RDFLabel -> [RDFLabel]
countBnodes SortedArcs RDFLabel
arcs)

newtype SortedArcs lb = SA [Arc lb]

sortArcs :: ArcSet lb -> SortedArcs lb
sortArcs :: ArcSet lb -> SortedArcs lb
sortArcs = [Arc lb] -> SortedArcs lb
forall lb. [Arc lb] -> SortedArcs lb
SA ([Arc lb] -> SortedArcs lb)
-> (ArcSet lb -> [Arc lb]) -> ArcSet lb -> SortedArcs lb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArcSet lb -> [Arc lb]
forall a. Set a -> [a]
S.toAscList

--  Rearrange a list of arcs into a tree of pairs which group together
--  all statements for a single subject, and similarly for multiple
--  objects of a common predicate.
--
arcTree :: (Eq lb) => SortedArcs lb -> SubjTree lb
arcTree :: SortedArcs lb -> SubjTree lb
arcTree (SA [Arc lb]
as) = ([(lb, lb)] -> [(lb, [lb])]) -> [(lb, (lb, lb))] -> SubjTree lb
forall a b c. Eq a => ([b] -> c) -> [(a, b)] -> [(a, c)]
commonFstEq (([lb] -> [lb]) -> [(lb, lb)] -> [(lb, [lb])]
forall a b c. Eq a => ([b] -> c) -> [(a, b)] -> [(a, c)]
commonFstEq [lb] -> [lb]
forall a. a -> a
id) ([(lb, (lb, lb))] -> SubjTree lb)
-> [(lb, (lb, lb))] -> SubjTree lb
forall a b. (a -> b) -> a -> b
$ (Arc lb -> (lb, (lb, lb))) -> [Arc lb] -> [(lb, (lb, lb))]
forall a b. (a -> b) -> [a] -> [b]
map Arc lb -> (lb, (lb, lb))
forall b. Arc b -> (b, (b, b))
spopair [Arc lb]
as
    where
        spopair :: Arc b -> (b, (b, b))
spopair (Arc b
s b
p b
o) = (b
s,(b
p,b
o))

{-
arcTree as = map spopair $ sort as
    where
        spopair (Arc s p o) = (s,[(p,[o])])
-}

--  Rearrange a list of pairs so that multiple occurrences of the first
--  are commoned up, and the supplied function is applied to each sublist
--  with common first elements to obtain the corresponding second value
commonFstEq :: (Eq a) => ( [b] -> c ) -> [(a,b)] -> [(a,c)]
commonFstEq :: ([b] -> c) -> [(a, b)] -> [(a, c)]
commonFstEq [b] -> c
f [(a, b)]
ps =
    [ ((a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> (a, b) -> a
forall a b. (a -> b) -> a -> b
$ [(a, b)] -> (a, b)
forall a. [a] -> a
head [(a, b)]
sps,[b] -> c
f ([b] -> c) -> [b] -> c
forall a b. (a -> b) -> a -> b
$ ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
sps) | [(a, b)]
sps <- ((a, b) -> (a, b) -> Bool) -> [(a, b)] -> [[(a, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (a, b) -> (a, b) -> Bool
forall a b b. Eq a => (a, b) -> (a, b) -> Bool
fstEq [(a, b)]
ps ]
    where
        fstEq :: (a, b) -> (a, b) -> Bool
fstEq (a
f1,b
_) (a
f2,b
_) = a
f1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
f2

{-
-- Diagnostic code for checking arcTree logic:
testArcTree = (arcTree testArcTree1) == testArcTree2
testArcTree1 =
    [Arc "s1" "p11" "o111", Arc "s1" "p11" "o112"
    ,Arc "s1" "p12" "o121", Arc "s1" "p12" "o122"
    ,Arc "s2" "p21" "o211", Arc "s2" "p21" "o212"
    ,Arc "s2" "p22" "o221", Arc "s2" "p22" "o222"
    ]
testArcTree2 =
    [("s1",[("p11",["o111","o112"]),("p12",["o121","o122"])])
    ,("s2",[("p21",["o211","o212"]),("p22",["o221","o222"])])
    ]
-}


findMaxBnode :: RDFGraph -> Word32
findMaxBnode :: RDFGraph -> Word32
findMaxBnode = Set Word32 -> Word32
forall a. Set a -> a
S.findMax (Set Word32 -> Word32)
-> (RDFGraph -> Set Word32) -> RDFGraph -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RDFLabel -> Word32) -> Set RDFLabel -> Set Word32
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map RDFLabel -> Word32
getAutoBnodeIndex (Set RDFLabel -> Set Word32)
-> (RDFGraph -> Set RDFLabel) -> RDFGraph -> Set Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDFGraph -> Set RDFLabel
forall (lg :: * -> *) lb.
(LDGraph lg lb, Ord lb) =>
lg lb -> Set lb
labels

getAutoBnodeIndex   :: RDFLabel -> Word32
getAutoBnodeIndex :: RDFLabel -> Word32
getAutoBnodeIndex (Blank (Char
'_':String
lns)) = Word32
res where
    -- cf. prelude definition of read s ...
    res :: Word32
res = case [Word32
x | (Word32
x,String
t) <- ReadS Word32
forall a. Read a => ReadS a
reads String
lns, (String
"",String
"") <- ReadS String
lex String
t] of
            [Word32
x] -> Word32
x
            [Word32]
_   -> Word32
0
getAutoBnodeIndex RDFLabel
_                   = Word32
0

splitOnLabel :: 
    (Eq a) => a -> SubjTree a -> (SubjTree a, PredTree a)
splitOnLabel :: a -> SubjTree a -> (SubjTree a, PredTree a)
splitOnLabel a
lbl SubjTree a
osubjs = 
    let (SubjTree a
bsubj, SubjTree a
rsubjs) = ((a, PredTree a) -> Bool) -> SubjTree a -> (SubjTree a, SubjTree a)
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
lbl) (a -> Bool) -> ((a, PredTree a) -> a) -> (a, PredTree a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, PredTree a) -> a
forall a b. (a, b) -> a
fst) SubjTree a
osubjs
        rprops :: PredTree a
rprops = case SubjTree a
bsubj of
                   [(a
_, PredTree a
rs)] -> PredTree a
rs
                   SubjTree a
_         -> []
    in (SubjTree a
rsubjs, PredTree a
rprops)
  

{-
Return a list of blank nodes that can not be converted to "[]"
format by Turtle/N3:

 - any blank node that is a predicate
 - any blank node that is an object position multiple times
 - any blank node that is both a subject and object

Note, really need to partition the graph since the last check
means that we can not convert

  _:a :knows _:b . _:b :knows _:a .

to

  _:a :knows [ :knows _:a ] .

-}

countBnodes :: SortedArcs RDFLabel -> [RDFLabel]
countBnodes :: SortedArcs RDFLabel -> [RDFLabel]
countBnodes (SA [Arc RDFLabel]
as) =
  let -- This is only ever used if a label already exists,
      -- so we know that in this case the value to store is True
      upd :: p -> p -> Bool
upd p
_ p
_ = Bool
True

      -- Only want to process the subject after processing all the
      -- arcs that it is the subject of. It could be included into
      -- procPO by passing around the previous subject and processing
      -- it when it changes, but separate out for now.
      procPO :: Map RDFLabel Bool -> Arc RDFLabel -> Map RDFLabel Bool
procPO Map RDFLabel Bool
oMap (Arc RDFLabel
_ RDFLabel
p RDFLabel
o) =
        Bool -> RDFLabel -> Map RDFLabel Bool -> Map RDFLabel Bool
addNode Bool
False RDFLabel
o (Map RDFLabel Bool -> Map RDFLabel Bool)
-> Map RDFLabel Bool -> Map RDFLabel Bool
forall a b. (a -> b) -> a -> b
$ Bool -> RDFLabel -> Map RDFLabel Bool -> Map RDFLabel Bool
addNode Bool
True RDFLabel
p Map RDFLabel Bool
oMap

      procS :: Map RDFLabel Bool -> RDFLabel -> Map RDFLabel Bool
procS Map RDFLabel Bool
oMap RDFLabel
s = Bool -> RDFLabel -> Map RDFLabel Bool -> Map RDFLabel Bool
addNode Bool
False RDFLabel
s Map RDFLabel Bool
oMap

      -- Take advantage of the fact that the arcs are sorted
      --
      isBlank :: RDFLabel -> Bool
isBlank (Blank String
_) = Bool
True
      isBlank RDFLabel
_ = Bool
False
      subjects :: Set RDFLabel
subjects = (RDFLabel -> Bool) -> Set RDFLabel -> Set RDFLabel
forall a. (a -> Bool) -> Set a -> Set a
S.filter RDFLabel -> Bool
isBlank (Set RDFLabel -> Set RDFLabel) -> Set RDFLabel -> Set RDFLabel
forall a b. (a -> b) -> a -> b
$ [RDFLabel] -> Set RDFLabel
forall a. Ord a => [a] -> Set a
S.fromList ([RDFLabel] -> Set RDFLabel) -> [RDFLabel] -> Set RDFLabel
forall a b. (a -> b) -> a -> b
$ (Arc RDFLabel -> RDFLabel) -> [Arc RDFLabel] -> [RDFLabel]
forall a b. (a -> b) -> [a] -> [b]
map Arc RDFLabel -> RDFLabel
forall lb. Arc lb -> lb
arcSubj [Arc RDFLabel]
as

      -- not bothering about lazy/strict insert here
      addNode :: Bool -> RDFLabel -> Map RDFLabel Bool -> Map RDFLabel Bool
addNode Bool
f l :: RDFLabel
l@(Blank String
_) Map RDFLabel Bool
m = (Bool -> Bool -> Bool)
-> RDFLabel -> Bool -> Map RDFLabel Bool -> Map RDFLabel Bool
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Bool -> Bool -> Bool
forall p p. p -> p -> Bool
upd RDFLabel
l Bool
f Map RDFLabel Bool
m
      addNode Bool
_ RDFLabel
_ Map RDFLabel Bool
m = Map RDFLabel Bool
m

      map1 :: Map RDFLabel Bool
map1 = (Map RDFLabel Bool -> Arc RDFLabel -> Map RDFLabel Bool)
-> Map RDFLabel Bool -> [Arc RDFLabel] -> Map RDFLabel Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map RDFLabel Bool -> Arc RDFLabel -> Map RDFLabel Bool
procPO Map RDFLabel Bool
forall k a. Map k a
M.empty [Arc RDFLabel]
as
      map2 :: Map RDFLabel Bool
map2 = (Map RDFLabel Bool -> RDFLabel -> Map RDFLabel Bool)
-> Map RDFLabel Bool -> Set RDFLabel -> Map RDFLabel Bool
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl' Map RDFLabel Bool -> RDFLabel -> Map RDFLabel Bool
procS Map RDFLabel Bool
map1 Set RDFLabel
subjects
      
  in Map RDFLabel Bool -> [RDFLabel]
forall k a. Map k a -> [k]
M.keys (Map RDFLabel Bool -> [RDFLabel])
-> Map RDFLabel Bool -> [RDFLabel]
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> Map RDFLabel Bool -> Map RDFLabel Bool
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter Bool -> Bool
forall a. a -> a
id Map RDFLabel Bool
map2

-- N3-like output

-- temporary conversion, also note that it is not obvious that all
-- the uses of quoteB are valid (e.g. when formatting a URL for use
-- in a prefix statement). TODO: review
--
quoteB :: Bool -> String -> B.Builder
quoteB :: Bool -> String -> Builder
quoteB Bool
f String
v = String -> Builder
B.fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Bool -> ShowS
quote Bool
f String
v

-- Force the "basic" display, that is act as if it is to be
-- surrounded by "...".
quoteBString :: String -> B.Builder
quoteBString :: String -> Builder
quoteBString = Bool -> String -> Builder
quoteB Bool
True

{-|
Convert text into a format for display in Turtle. The idea
is to use one double quote unless three are needed, and to
handle adding necessary @\\@ characters, or conversion
for Unicode characters.

Turtle supports 4 ways of quoting text,

  (1) @\'...\'@

  (2) @\'\'\'...\'\'\'@

  (3) @\"...\"@

  (4) @\"\"\"...\"\"\"@

where there are slightly-different
constraints on @...@ for each one. At present
we assume that the string is to be quoted as 3 or 4; this
could be extended to allow for 1 or 2 as well.

For now option 4 is only used when the contents contain a
@\n@ character and does not contain @\"\"\"@.
-}

-- The original thinking was that a scan of the string is worthwhile
-- if it avoids having to quote characters, but we always need to
-- scan through to protect certain characters.
--
quoteText :: T.Text -> B.Builder
quoteText :: Text -> Builder
quoteText Text
txt = 
  let -- assume the magical ghc pixie will fuse all these loops
      -- (the docs say that T.findIndex can fuse, but that
      -- T.isInfixOf doesn't)
      hasNL :: Bool
hasNL = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Int
T.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
txt
      hasSQ :: Bool
hasSQ = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Int
T.findIndex (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"') Text
txt
      has3Q :: Bool
has3Q = Text
"\"\"\"" Text -> Text -> Bool
`T.isInfixOf` Text
txt
        
      n :: Int
n = if Bool
has3Q Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
hasNL Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasSQ) then Int
1 else Int
3
            
      qch :: Builder
qch = String -> Builder
B.fromString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'"')
      qst :: Builder
qst = Text -> Builder
B.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
quoteT (Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1) Text
txt

  in [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
qch, Builder
qst, Builder
qch]

-- TODO: need to be a bit more clever with this than we did in NTriples
--       not sure the following counts as clever enough ...
--  
showScopedName :: ScopedName -> B.Builder
showScopedName :: ScopedName -> Builder
showScopedName = String -> Builder
quoteBString (String -> Builder)
-> (ScopedName -> String) -> ScopedName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedName -> String
forall a. Show a => a -> String
show

formatScopedName :: ScopedName -> M.Map (Maybe T.Text) URI -> B.Builder
formatScopedName :: ScopedName -> Map (Maybe Text) URI -> Builder
formatScopedName ScopedName
sn Map (Maybe Text) URI
prmap =
  let nsuri :: URI
nsuri = ScopedName -> URI
getScopeURI ScopedName
sn
      local :: Text
local = LName -> Text
getLName (LName -> Text) -> LName -> Text
forall a b. (a -> b) -> a -> b
$ ScopedName -> LName
getScopeLocal ScopedName
sn
  in case URI -> Map (Maybe Text) URI -> Maybe (Maybe Text)
forall a. URI -> Map a URI -> Maybe a
findPrefix URI
nsuri Map (Maybe Text) URI
prmap of
       Just (Just Text
p) -> Text -> Builder
B.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
quoteT Bool
True (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
p, Text
":", Text
local]
       Maybe (Maybe Text)
_             -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Builder
"<"
                                , String -> Builder
quoteBString (URI -> String
forall a. Show a => a -> String
show URI
nsuri String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
local)
                                , Builder
">"
                                ]

formatPlainLit :: T.Text -> B.Builder
formatPlainLit :: Text -> Builder
formatPlainLit = Text -> Builder
quoteText

formatLangLit :: T.Text -> LanguageTag -> B.Builder
formatLangLit :: Text -> LanguageTag -> Builder
formatLangLit Text
lit LanguageTag
lcode = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Text -> Builder
quoteText Text
lit, Builder
"@", Text -> Builder
B.fromText (LanguageTag -> Text
fromLangTag LanguageTag
lcode)]

-- The canonical notation for xsd:double in XSD, with an upper-case E,
-- does not match the syntax used in N3, so we need to convert here.     
-- Rather than converting back to a Double and then displaying that       
-- we just convert E to e for now.      
--
-- However, I am moving away from storing a canonical representation
-- of a datatyped literal in the resource since it is messy and makes
-- some comparisons difficult, in particular for the W3C Turtle test
-- suite [I think] (unless equality of RDFLabels is made dependent on
-- types, and then it gets messy). I am also not as concerned about
-- issues in the N3 parser/formatter as in the Turtle one.
--
formatTypedLit :: Bool -> T.Text -> ScopedName -> B.Builder
formatTypedLit :: Bool -> Text -> ScopedName -> Builder
formatTypedLit Bool
n3flag Text
lit ScopedName
dtype
    | ScopedName
dtype ScopedName -> ScopedName -> Bool
forall a. Eq a => a -> a -> Bool
== ScopedName
xsdDouble = Text -> Builder
B.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ if Bool
n3flag then Text -> Text
T.toLower Text
lit else Text
lit
    | ScopedName
dtype ScopedName -> [ScopedName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScopedName
xsdBoolean, ScopedName
xsdDecimal, ScopedName
xsdInteger] = Text -> Builder
B.fromText Text
lit
    | Bool
otherwise = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Text -> Builder
quoteText Text
lit, Builder
"^^", ScopedName -> Builder
showScopedName ScopedName
dtype]
                           
{-
Add a list inline. We are given the labels that constitute
the list, in order, so just need to display them surrounded
by ().
-}
insertList ::
    (RDFLabel -> State a B.Builder)
    -> [RDFLabel]
    -> State a B.Builder
insertList :: (RDFLabel -> State a Builder) -> [RDFLabel] -> State a Builder
insertList RDFLabel -> State a Builder
_ [] = Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
"()" -- QUS: can this happen in a valid graph?
insertList RDFLabel -> State a Builder
f [RDFLabel]
xs = do
    [Builder]
ls <- (RDFLabel -> State a Builder)
-> [RDFLabel] -> StateT a Identity [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RDFLabel -> State a Builder
f [RDFLabel]
xs
    Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder
"( " Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
" " [Builder]
ls) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
" )" 

nextLine_ ::
    (a -> B.Builder)      -- ^ indentation
    -> SLens a Bool       -- ^ line break lens
    -> B.Builder -> State a B.Builder
nextLine_ :: (a -> Builder) -> SLens a Bool -> Builder -> State a Builder
nextLine_ a -> Builder
indent SLens a Bool
_lineBreak Builder
str = do
  Builder
ind <- (a -> Builder) -> State a Builder
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets a -> Builder
indent
  Bool
brk <- (a -> Bool) -> StateT a Identity Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((a -> Bool) -> StateT a Identity Bool)
-> (a -> Bool) -> StateT a Identity Bool
forall a b. (a -> b) -> a -> b
$ SLens a Bool -> a -> Bool
forall a b. SLens a b -> a -> b
glens SLens a Bool
_lineBreak
  if Bool
brk
    then Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ Builder
ind Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
str
    else do
      --  After first line, always insert line break
      (a -> a) -> StateT a Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((a -> a) -> StateT a Identity ())
-> (a -> a) -> StateT a Identity ()
forall a b. (a -> b) -> a -> b
$ \a
st -> SLens a Bool -> a -> Bool -> a
forall a b. SLens a b -> a -> b -> a
slens SLens a Bool
_lineBreak a
st Bool
True
      Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
str

mapBlankNode_ :: SLens a NodeGenState -> RDFLabel -> State a B.Builder
mapBlankNode_ :: SLens a NodeGenState -> RDFLabel -> State a Builder
mapBlankNode_ SLens a NodeGenState
_nodeGen RDFLabel
lab = do
  NodeGenState
ngs <- (a -> NodeGenState) -> StateT a Identity NodeGenState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((a -> NodeGenState) -> StateT a Identity NodeGenState)
-> (a -> NodeGenState) -> StateT a Identity NodeGenState
forall a b. (a -> b) -> a -> b
$ SLens a NodeGenState -> a -> NodeGenState
forall a b. SLens a b -> a -> b
glens SLens a NodeGenState
_nodeGen
  let (Builder
lval, Maybe NodeGenState
mngs) = RDFLabel -> NodeGenState -> (Builder, Maybe NodeGenState)
getBNodeLabel RDFLabel
lab NodeGenState
ngs
  case Maybe NodeGenState
mngs of
    Just NodeGenState
ngs' -> (a -> a) -> StateT a Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((a -> a) -> StateT a Identity ())
-> (a -> a) -> StateT a Identity ()
forall a b. (a -> b) -> a -> b
$ \a
st -> SLens a NodeGenState -> a -> NodeGenState -> a
forall a b. SLens a b -> a -> b -> a
slens SLens a NodeGenState
_nodeGen a
st NodeGenState
ngs'
    Maybe NodeGenState
_ -> () -> StateT a Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
lval

formatPrefixLines :: NamespaceMap -> [B.Builder]
formatPrefixLines :: Map (Maybe Text) URI -> [Builder]
formatPrefixLines = ((Maybe Text, URI) -> Builder) -> [(Maybe Text, URI)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Text, URI) -> Builder
forall a. Show a => (Maybe Text, a) -> Builder
pref ([(Maybe Text, URI)] -> [Builder])
-> (Map (Maybe Text) URI -> [(Maybe Text, URI)])
-> Map (Maybe Text) URI
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Maybe Text) URI -> [(Maybe Text, URI)]
forall k a. Map k a -> [(k, a)]
M.assocs
    where
      pref :: (Maybe Text, a) -> Builder
pref (Just Text
p,a
u) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"@prefix ", Text -> Builder
B.fromText Text
p, Builder
": <", String -> Builder
quoteBString (a -> String
forall a. Show a => a -> String
show a
u), Builder
"> ."]
      pref (Maybe Text
_,a
u)      = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"@prefix : <", String -> Builder
quoteBString (a -> String
forall a. Show a => a -> String
show a
u), Builder
"> ."]

formatPrefixes_ ::
    (B.Builder -> State a B.Builder)  -- ^ Create a new line
    -> NamespaceMap
    -> State a B.Builder
formatPrefixes_ :: (Builder -> State a Builder)
-> Map (Maybe Text) URI -> State a Builder
formatPrefixes_ Builder -> State a Builder
nextLine Map (Maybe Text) URI
pmap = 
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> StateT a Identity [Builder] -> State a Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Builder -> State a Builder)
-> [Builder] -> StateT a Identity [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Builder -> State a Builder
nextLine (Map (Maybe Text) URI -> [Builder]
formatPrefixLines Map (Maybe Text) URI
pmap)

formatGraph_ :: 
    (B.Builder -> State a ()) -- set indent
    -> (Bool -> State a ())   -- set line-break flag
    -> (RDFGraph -> a -> a)        -- create a new state from the graph
    -> (NamespaceMap -> State a B.Builder) -- format prefixes
    -> (a -> SubjTree RDFLabel)      -- get the subjects
    -> State a B.Builder              -- format the subjects
    -> 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
    -> State a B.Builder
formatGraph_ :: (Builder -> State a ())
-> (Bool -> State a ())
-> (RDFGraph -> a -> a)
-> (Map (Maybe Text) URI -> State a Builder)
-> (a -> SubjTree RDFLabel)
-> State a Builder
-> Builder
-> Builder
-> Bool
-> Bool
-> RDFGraph
-> State a Builder
formatGraph_ Builder -> State a ()
setIndent Bool -> State a ()
setLineBreak RDFGraph -> a -> a
newState Map (Maybe Text) URI -> State a Builder
formatPrefixes a -> SubjTree RDFLabel
subjs State a Builder
formatSubjects Builder
ind Builder
end Bool
dobreak Bool
dopref RDFGraph
gr = do
  Builder -> State a ()
setIndent Builder
ind
  Bool -> State a ()
setLineBreak Bool
dobreak
  (a -> a) -> State a ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (RDFGraph -> a -> a
newState RDFGraph
gr)
  
  Builder
fp <- if Bool
dopref
        then Map (Maybe Text) URI -> State a Builder
formatPrefixes (RDFGraph -> Map (Maybe Text) URI
forall lb. NSGraph lb -> Map (Maybe Text) URI
getNamespaces RDFGraph
gr)
        else Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
forall a. Monoid a => a
mempty
  Bool
more <- (a -> SubjTree RDFLabel) -> State a Bool
forall a b. (a -> [b]) -> State a Bool
hasMore a -> SubjTree RDFLabel
subjs
  if Bool
more
    then do
      Builder
fr <- State a Builder
formatSubjects
      Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
fp, Builder
fr, Builder
end]
    else Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
fp

formatSubjects_ ::
    State a RDFLabel     -- ^ next subject
    -> (LabelContext -> RDFLabel -> State a B.Builder)  -- ^ convert label into text
    -> (a -> PredTree RDFLabel) -- ^ extract properties
    -> (RDFLabel -> B.Builder -> State a B.Builder)   -- ^ format properties
    -> (a -> SubjTree RDFLabel) -- ^ extract subjects
    -> (B.Builder -> State a B.Builder) -- ^ next line
    -> State a B.Builder
formatSubjects_ :: State a RDFLabel
-> (LabelContext -> RDFLabel -> State a Builder)
-> (a -> [(RDFLabel, [RDFLabel])])
-> (RDFLabel -> Builder -> State a Builder)
-> (a -> SubjTree RDFLabel)
-> (Builder -> State a Builder)
-> State a Builder
formatSubjects_ State a RDFLabel
nextSubject LabelContext -> RDFLabel -> State a Builder
formatLabel a -> [(RDFLabel, [RDFLabel])]
props RDFLabel -> Builder -> State a Builder
formatProperties a -> SubjTree RDFLabel
subjs Builder -> State a Builder
nextLine = do
  RDFLabel
sb    <- State a RDFLabel
nextSubject
  Builder
sbstr <- LabelContext -> RDFLabel -> State a Builder
formatLabel LabelContext
SubjContext RDFLabel
sb
  
  Bool
flagP <- (a -> [(RDFLabel, [RDFLabel])]) -> State a Bool
forall a b. (a -> [b]) -> State a Bool
hasMore a -> [(RDFLabel, [RDFLabel])]
props
  if Bool
flagP
    then do
      Builder
prstr <- RDFLabel -> Builder -> State a Builder
formatProperties RDFLabel
sb Builder
sbstr
      Bool
flagS <- (a -> SubjTree RDFLabel) -> State a Bool
forall a b. (a -> [b]) -> State a Bool
hasMore a -> SubjTree RDFLabel
subjs
      if Bool
flagS
        then do
          Builder
fr <- State a RDFLabel
-> (LabelContext -> RDFLabel -> State a Builder)
-> (a -> [(RDFLabel, [RDFLabel])])
-> (RDFLabel -> Builder -> State a Builder)
-> (a -> SubjTree RDFLabel)
-> (Builder -> State a Builder)
-> State a Builder
forall a.
State a RDFLabel
-> (LabelContext -> RDFLabel -> State a Builder)
-> (a -> [(RDFLabel, [RDFLabel])])
-> (RDFLabel -> Builder -> State a Builder)
-> (a -> SubjTree RDFLabel)
-> (Builder -> State a Builder)
-> State a Builder
formatSubjects_ State a RDFLabel
nextSubject LabelContext -> RDFLabel -> State a Builder
formatLabel a -> [(RDFLabel, [RDFLabel])]
props RDFLabel -> Builder -> State a Builder
formatProperties a -> SubjTree RDFLabel
subjs Builder -> State a Builder
nextLine
          Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
prstr, Builder
" .", Builder
fr]
        else Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
prstr
           
    else do
      Builder
txt <- Builder -> State a Builder
nextLine Builder
sbstr
    
      Bool
flagS <- (a -> SubjTree RDFLabel) -> State a Bool
forall a b. (a -> [b]) -> State a Bool
hasMore a -> SubjTree RDFLabel
subjs
      if Bool
flagS
        then do
          Builder
fr <- State a RDFLabel
-> (LabelContext -> RDFLabel -> State a Builder)
-> (a -> [(RDFLabel, [RDFLabel])])
-> (RDFLabel -> Builder -> State a Builder)
-> (a -> SubjTree RDFLabel)
-> (Builder -> State a Builder)
-> State a Builder
forall a.
State a RDFLabel
-> (LabelContext -> RDFLabel -> State a Builder)
-> (a -> [(RDFLabel, [RDFLabel])])
-> (RDFLabel -> Builder -> State a Builder)
-> (a -> SubjTree RDFLabel)
-> (Builder -> State a Builder)
-> State a Builder
formatSubjects_ State a RDFLabel
nextSubject LabelContext -> RDFLabel -> State a Builder
formatLabel a -> [(RDFLabel, [RDFLabel])]
props RDFLabel -> Builder -> State a Builder
formatProperties a -> SubjTree RDFLabel
subjs Builder -> State a Builder
nextLine
          Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
txt, Builder
" .", Builder
fr]
        else Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
txt


{-
TODO: now we are throwing a Builder around it is awkward to
get the length of the text to calculate the indentation

So

  a) change the indentation scheme
  b) pass around text instead of builder

mkIndent :: L.Text -> L.Text
mkIndent inVal = L.replicate (L.length inVal) " "
-}

hackIndent :: B.Builder
hackIndent :: Builder
hackIndent = Builder
"    "

formatProperties_ :: 
    (RDFLabel -> State a RDFLabel)        -- ^ next property for the given subject
    -> (LabelContext -> RDFLabel -> State a B.Builder) -- ^ convert label into text
    -> (RDFLabel -> RDFLabel -> B.Builder -> State a B.Builder) -- ^ format objects
    -> (a -> PredTree RDFLabel) -- ^ extract properties
    -> (B.Builder -> State a B.Builder) -- ^ next line
    -> RDFLabel             -- ^ property being processed
    -> B.Builder            -- ^ current output
    -> State a B.Builder
formatProperties_ :: (RDFLabel -> State a RDFLabel)
-> (LabelContext -> RDFLabel -> State a Builder)
-> (RDFLabel -> RDFLabel -> Builder -> State a Builder)
-> (a -> [(RDFLabel, [RDFLabel])])
-> (Builder -> State a Builder)
-> RDFLabel
-> Builder
-> State a Builder
formatProperties_ RDFLabel -> State a RDFLabel
nextProperty LabelContext -> RDFLabel -> State a Builder
formatLabel RDFLabel -> RDFLabel -> Builder -> State a Builder
formatObjects a -> [(RDFLabel, [RDFLabel])]
props Builder -> State a Builder
nextLine RDFLabel
sb Builder
sbstr = do
  RDFLabel
pr <- RDFLabel -> State a RDFLabel
nextProperty RDFLabel
sb
  Builder
prstr <- LabelContext -> RDFLabel -> State a Builder
formatLabel LabelContext
PredContext RDFLabel
pr
  Builder
obstr <- RDFLabel -> RDFLabel -> Builder -> State a Builder
formatObjects RDFLabel
sb RDFLabel
pr (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
sbstr, Builder
" ", Builder
prstr]
  Bool
more  <- (a -> [(RDFLabel, [RDFLabel])]) -> State a Bool
forall a b. (a -> [b]) -> State a Bool
hasMore a -> [(RDFLabel, [RDFLabel])]
props
  let sbindent :: Builder
sbindent = Builder
hackIndent -- mkIndent sbstr
  if Bool
more
    then do
      Builder
fr <- (RDFLabel -> State a RDFLabel)
-> (LabelContext -> RDFLabel -> State a Builder)
-> (RDFLabel -> RDFLabel -> Builder -> State a Builder)
-> (a -> [(RDFLabel, [RDFLabel])])
-> (Builder -> State a Builder)
-> RDFLabel
-> Builder
-> State a Builder
forall a.
(RDFLabel -> State a RDFLabel)
-> (LabelContext -> RDFLabel -> State a Builder)
-> (RDFLabel -> RDFLabel -> Builder -> State a Builder)
-> (a -> [(RDFLabel, [RDFLabel])])
-> (Builder -> State a Builder)
-> RDFLabel
-> Builder
-> State a Builder
formatProperties_ RDFLabel -> State a RDFLabel
nextProperty LabelContext -> RDFLabel -> State a Builder
formatLabel RDFLabel -> RDFLabel -> Builder -> State a Builder
formatObjects a -> [(RDFLabel, [RDFLabel])]
props Builder -> State a Builder
nextLine RDFLabel
sb Builder
sbindent
      Builder
nl <- Builder -> State a Builder
nextLine (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ Builder
obstr Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
" ;"
      Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ Builder
nl Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
fr
    else Builder -> State a Builder
nextLine Builder
obstr

formatObjects_ :: 
    (RDFLabel -> RDFLabel -> State a RDFLabel) -- ^ get the next object for the (subject,property) pair
    -> (LabelContext -> RDFLabel -> State a B.Builder) -- ^ format a label
    -> (a -> [RDFLabel])   -- ^ extract objects
    -> (B.Builder -> State a B.Builder) -- ^ insert a new line
    -> RDFLabel      -- ^ subject
    -> RDFLabel      -- ^ property
    -> B.Builder     -- ^ current text
    -> State a B.Builder
formatObjects_ :: (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 a RDFLabel
nextObject LabelContext -> RDFLabel -> State a Builder
formatLabel a -> [RDFLabel]
objs Builder -> State a Builder
nextLine RDFLabel
sb RDFLabel
pr Builder
prstr = do
  RDFLabel
ob    <- RDFLabel -> RDFLabel -> State a RDFLabel
nextObject RDFLabel
sb RDFLabel
pr
  Builder
obstr <- LabelContext -> RDFLabel -> State a Builder
formatLabel LabelContext
ObjContext RDFLabel
ob
  Bool
more  <- (a -> [RDFLabel]) -> State a Bool
forall a b. (a -> [b]) -> State a Bool
hasMore a -> [RDFLabel]
objs
  if Bool
more
    then do
      let prindent :: Builder
prindent = Builder
hackIndent -- mkIndent prstr
      Builder
fr <- (RDFLabel -> RDFLabel -> State a RDFLabel)
-> (LabelContext -> RDFLabel -> State a Builder)
-> (a -> [RDFLabel])
-> (Builder -> State a Builder)
-> RDFLabel
-> RDFLabel
-> Builder
-> State a 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 a RDFLabel
nextObject LabelContext -> RDFLabel -> State a Builder
formatLabel a -> [RDFLabel]
objs Builder -> State a Builder
nextLine RDFLabel
sb RDFLabel
pr Builder
prindent
      Builder
nl <- Builder -> State a Builder
nextLine (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
prstr, Builder
" ", Builder
obstr, Builder
","]
      Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ Builder
nl Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
fr
    else Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
prstr, Builder
" ", Builder
obstr]

{-
Processing a Bnode when not a subject.
-}
insertBnode_ ::
    (a -> SubjTree RDFLabel)  -- ^ extract subjects
    -> (a -> PredTree RDFLabel) -- ^ extract properties
    -> (a -> [RDFLabel]) -- ^ extract objects
    -> (a -> SubjTree RDFLabel -> PredTree RDFLabel -> [RDFLabel] -> a) -- ^ update state to new settings
    -> (RDFLabel -> B.Builder -> State a B.Builder) -- ^ format properties
    -> RDFLabel
    -> State a B.Builder
insertBnode_ :: (a -> SubjTree RDFLabel)
-> (a -> [(RDFLabel, [RDFLabel])])
-> (a -> [RDFLabel])
-> (a
    -> SubjTree RDFLabel
    -> [(RDFLabel, [RDFLabel])]
    -> [RDFLabel]
    -> a)
-> (RDFLabel -> Builder -> State a Builder)
-> RDFLabel
-> State a Builder
insertBnode_ a -> SubjTree RDFLabel
subjs a -> [(RDFLabel, [RDFLabel])]
props a -> [RDFLabel]
objs a
-> SubjTree RDFLabel -> [(RDFLabel, [RDFLabel])] -> [RDFLabel] -> a
updateState RDFLabel -> Builder -> State a Builder
formatProperties RDFLabel
lbl = do
  a
ost <- StateT a Identity a
forall s (m :: * -> *). MonadState s m => m s
get
  let osubjs :: SubjTree RDFLabel
osubjs = a -> SubjTree RDFLabel
subjs a
ost
      (SubjTree RDFLabel
rsubjs, [(RDFLabel, [RDFLabel])]
rprops) = RDFLabel
-> SubjTree RDFLabel
-> (SubjTree RDFLabel, [(RDFLabel, [RDFLabel])])
forall a. Eq a => a -> SubjTree a -> (SubjTree a, PredTree a)
splitOnLabel RDFLabel
lbl SubjTree RDFLabel
osubjs
  a -> StateT a Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (a -> StateT a Identity ()) -> a -> StateT a Identity ()
forall a b. (a -> b) -> a -> b
$ a
-> SubjTree RDFLabel -> [(RDFLabel, [RDFLabel])] -> [RDFLabel] -> a
updateState a
ost SubjTree RDFLabel
rsubjs [(RDFLabel, [RDFLabel])]
rprops []
  Bool
flag <- (a -> [(RDFLabel, [RDFLabel])]) -> State a Bool
forall a b. (a -> [b]) -> State a Bool
hasMore a -> [(RDFLabel, [RDFLabel])]
props
  Builder
txt <- if Bool
flag
         then (Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
"\n") (Builder -> Builder) -> State a Builder -> State a Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` RDFLabel -> Builder -> State a Builder
formatProperties RDFLabel
lbl Builder
""
         else Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
""

  -- restore the original data (where appropriate)
  a
nst <- StateT a Identity a
forall s (m :: * -> *). MonadState s m => m s
get
  let slist :: [RDFLabel]
slist  = ((RDFLabel, [(RDFLabel, [RDFLabel])]) -> RDFLabel)
-> SubjTree RDFLabel -> [RDFLabel]
forall a b. (a -> b) -> [a] -> [b]
map (RDFLabel, [(RDFLabel, [RDFLabel])]) -> RDFLabel
forall a b. (a, b) -> a
fst (SubjTree RDFLabel -> [RDFLabel])
-> SubjTree RDFLabel -> [RDFLabel]
forall a b. (a -> b) -> a -> b
$ a -> SubjTree RDFLabel
subjs a
nst
      nsubjs :: SubjTree RDFLabel
nsubjs = ((RDFLabel, [(RDFLabel, [RDFLabel])]) -> Bool)
-> SubjTree RDFLabel -> SubjTree RDFLabel
forall a. (a -> Bool) -> [a] -> [a]
filter (\(RDFLabel
l,[(RDFLabel, [RDFLabel])]
_) -> RDFLabel
l RDFLabel -> [RDFLabel] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RDFLabel]
slist) SubjTree RDFLabel
osubjs

  a -> StateT a Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (a -> StateT a Identity ()) -> a -> StateT a Identity ()
forall a b. (a -> b) -> a -> b
$ a
-> SubjTree RDFLabel -> [(RDFLabel, [RDFLabel])] -> [RDFLabel] -> a
updateState a
nst SubjTree RDFLabel
nsubjs (a -> [(RDFLabel, [RDFLabel])]
props a
ost) (a -> [RDFLabel]
objs a
ost)

  -- TODO: handle indentation?
  Builder -> State a Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State a Builder) -> Builder -> State a Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"[", Builder
txt, Builder
"]"]


maybeExtractList :: 
  SubjTree RDFLabel
  -> PredTree RDFLabel
  -> LabelContext
  -> RDFLabel
  -> Maybe ([RDFLabel], SubjTree RDFLabel, PredTree RDFLabel)
maybeExtractList :: SubjTree RDFLabel
-> [(RDFLabel, [RDFLabel])]
-> LabelContext
-> RDFLabel
-> Maybe ([RDFLabel], SubjTree RDFLabel, [(RDFLabel, [RDFLabel])])
maybeExtractList SubjTree RDFLabel
osubjs [(RDFLabel, [RDFLabel])]
oprops LabelContext
lctxt RDFLabel
ln =
  let mlst :: Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
mlst = SubjTree RDFLabel
-> RDFLabel -> Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
getCollection SubjTree RDFLabel
osubjs' RDFLabel
ln

      -- we only want to send in rdf:first/rdf:rest here
      fprops :: [(RDFLabel, [RDFLabel])]
fprops = ((RDFLabel, [RDFLabel]) -> Bool)
-> [(RDFLabel, [RDFLabel])] -> [(RDFLabel, [RDFLabel])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((RDFLabel -> [RDFLabel] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RDFLabel
resRdfFirst, RDFLabel
resRdfRest]) (RDFLabel -> Bool)
-> ((RDFLabel, [RDFLabel]) -> RDFLabel)
-> (RDFLabel, [RDFLabel])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RDFLabel, [RDFLabel]) -> RDFLabel
forall a b. (a, b) -> a
fst) [(RDFLabel, [RDFLabel])]
oprops

      osubjs' :: SubjTree RDFLabel
osubjs' =
          case LabelContext
lctxt of
            LabelContext
SubjContext -> (RDFLabel
ln, [(RDFLabel, [RDFLabel])]
fprops) (RDFLabel, [(RDFLabel, [RDFLabel])])
-> SubjTree RDFLabel -> SubjTree RDFLabel
forall a. a -> [a] -> [a]
: SubjTree RDFLabel
osubjs
            LabelContext
_ -> SubjTree RDFLabel
osubjs 

  in case Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
mlst of
    Just (SubjTree RDFLabel
sl, [RDFLabel]
ls, [RDFLabel]
_) -> 
      let oprops' :: [(RDFLabel, [RDFLabel])]
oprops' = if LabelContext
lctxt LabelContext -> LabelContext -> Bool
forall a. Eq a => a -> a -> Bool
== LabelContext
SubjContext
                    then ((RDFLabel, [RDFLabel]) -> Bool)
-> [(RDFLabel, [RDFLabel])] -> [(RDFLabel, [RDFLabel])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((RDFLabel -> [RDFLabel] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [RDFLabel
resRdfFirst, RDFLabel
resRdfRest]) (RDFLabel -> Bool)
-> ((RDFLabel, [RDFLabel]) -> RDFLabel)
-> (RDFLabel, [RDFLabel])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RDFLabel, [RDFLabel]) -> RDFLabel
forall a b. (a, b) -> a
fst) [(RDFLabel, [RDFLabel])]
oprops
                    else [(RDFLabel, [RDFLabel])]
oprops
      in ([RDFLabel], SubjTree RDFLabel, [(RDFLabel, [RDFLabel])])
-> Maybe ([RDFLabel], SubjTree RDFLabel, [(RDFLabel, [RDFLabel])])
forall a. a -> Maybe a
Just ([RDFLabel]
ls, SubjTree RDFLabel
sl, [(RDFLabel, [RDFLabel])]
oprops')

    Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
_ -> Maybe ([RDFLabel], SubjTree RDFLabel, [(RDFLabel, [RDFLabel])])
forall a. Maybe a
Nothing

extractList_ :: 
    (a -> SubjTree RDFLabel) -- ^ extract subjects
    -> (a -> PredTree RDFLabel) -- ^ extract properties
    -> (SubjTree RDFLabel -> State a ())  -- ^ set subjects
    -> (PredTree RDFLabel -> State a ())  -- ^ set properties
    -> LabelContext 
    -> RDFLabel 
    -> State a (Maybe [RDFLabel])
extractList_ :: (a -> SubjTree RDFLabel)
-> (a -> [(RDFLabel, [RDFLabel])])
-> (SubjTree RDFLabel -> State a ())
-> ([(RDFLabel, [RDFLabel])] -> State a ())
-> LabelContext
-> RDFLabel
-> State a (Maybe [RDFLabel])
extractList_ a -> SubjTree RDFLabel
subjs a -> [(RDFLabel, [RDFLabel])]
props SubjTree RDFLabel -> State a ()
setSubjs [(RDFLabel, [RDFLabel])] -> State a ()
setProps LabelContext
lctxt RDFLabel
ln = do
  SubjTree RDFLabel
osubjs <- (a -> SubjTree RDFLabel) -> StateT a Identity (SubjTree RDFLabel)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets a -> SubjTree RDFLabel
subjs
  [(RDFLabel, [RDFLabel])]
oprops <- (a -> [(RDFLabel, [RDFLabel])])
-> StateT a Identity [(RDFLabel, [RDFLabel])]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets a -> [(RDFLabel, [RDFLabel])]
props
  case SubjTree RDFLabel
-> [(RDFLabel, [RDFLabel])]
-> LabelContext
-> RDFLabel
-> Maybe ([RDFLabel], SubjTree RDFLabel, [(RDFLabel, [RDFLabel])])
maybeExtractList SubjTree RDFLabel
osubjs [(RDFLabel, [RDFLabel])]
oprops LabelContext
lctxt RDFLabel
ln of
    Just ([RDFLabel]
ls, SubjTree RDFLabel
osubjs', [(RDFLabel, [RDFLabel])]
oprops') -> do
      SubjTree RDFLabel -> State a ()
setSubjs SubjTree RDFLabel
osubjs'
      [(RDFLabel, [RDFLabel])] -> State a ()
setProps [(RDFLabel, [RDFLabel])]
oprops'
      Maybe [RDFLabel] -> State a (Maybe [RDFLabel])
forall (m :: * -> *) a. Monad m => a -> m a
return ([RDFLabel] -> Maybe [RDFLabel]
forall a. a -> Maybe a
Just [RDFLabel]
ls)

    Maybe ([RDFLabel], SubjTree RDFLabel, [(RDFLabel, [RDFLabel])])
_ -> Maybe [RDFLabel] -> State a (Maybe [RDFLabel])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [RDFLabel]
forall a. Maybe a
Nothing
  
--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2013, 2014, 2016, 2018, 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
--
--------------------------------------------------------------------------------