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

#if (__GLASGOW_HASKELL__ >= 802)
{-# LANGUAGE DerivingStrategies #-}
#endif

--------------------------------------------------------------------------------
--  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, 2022 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  CPP, DerivingStrategies, 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 :: forall a. URI -> Map a URI -> Maybe a
findPrefix URI
u = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup URI
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b. 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 :: forall a b. 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
#if (__GLASGOW_HASKELL__ >= 802)
                      stock
#endif
                      (LabelContext -> LabelContext -> Bool
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
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 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 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 = forall a. Enum a => a -> a
succ Word32
cval
                       nmap :: NodeGenLookupMap
nmap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert RDFLabel
lab Word32
nval NodeGenLookupMap
cmap
                   in (Word32
nval, forall a. a -> Maybe a
Just (NodeGenState
ngs { nodeGen :: Word32
nodeGen = Word32
nval, nodeMap :: NodeGenLookupMap
nodeMap = NodeGenLookupMap
nmap }))

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

    in (Builder
"_:swish" forall a. Monoid a => a -> a -> a
`mappend` String -> Builder
B.fromString (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 :: forall a b. (a -> (b, a)) -> State a b
changeState a -> (b, a)
f = do
  a
st <- forall s (m :: * -> *). MonadState s m => m s
get
  let (b
rval, a
nst) = a -> (b, a)
f a
st
  forall s (m :: * -> *). MonadState s m => s -> m ()
put a
nst
  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 :: forall a b. (a -> [b]) -> State a Bool
hasMore a -> [b]
lens = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null 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 :: forall a b. Eq a => [(a, b)] -> a -> Maybe (b, [(a, b)])
removeItem [(a, b)]
os a
x =
  let ([(a, b)]
as, [(a, b)]
bs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\(a, b)
a -> forall a b. (a, b) -> a
fst (a, b)
a forall a. Eq a => a -> a -> Bool
== a
x) [(a, b)]
os
  in case [(a, b)]
bs of
    ((a
_,b
b):[(a, b)]
bbs) -> forall a. a -> Maybe a
Just (b
b, [(a, b)]
as forall a. [a] -> [a] -> [a]
++ [(a, b)]
bbs)
    [] -> 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 forall a. Eq a => a -> a -> Bool
== RDFLabel
resRdfNil = forall a. a -> Maybe a
Just (SubjTree RDFLabel
sl, forall a. [a] -> [a]
reverse [RDFLabel]
cs, [RDFLabel]
ss)
                      | Bool
otherwise = do
        ([(RDFLabel, [RDFLabel])]
pList1, SubjTree RDFLabel
sl') <- forall a b. Eq a => [(a, b)] -> a -> Maybe (b, [(a, b)])
removeItem SubjTree RDFLabel
sl RDFLabel
l
        ([RDFLabel
pFirst], [(RDFLabel, [RDFLabel])]
pList2) <- forall a b. Eq a => [(a, b)] -> a -> Maybe (b, [(a, b)])
removeItem [(RDFLabel, [RDFLabel])]
pList1 RDFLabel
resRdfFirst
        ([RDFLabel
pNext], []) <- 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 forall a. a -> [a] -> [a]
: [RDFLabel]
cs, RDFLabel
l 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 = forall lb. ArcSet lb -> SortedArcs lb
sortArcs forall a b. (a -> b) -> a -> b
$ forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs RDFGraph
gr
    in (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 :: forall lb. ArcSet lb -> SortedArcs lb
sortArcs = forall lb. [Arc lb] -> SortedArcs lb
SA forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall lb. Eq lb => SortedArcs lb -> SubjTree lb
arcTree (SA [Arc lb]
as) = forall a b c. Eq a => ([b] -> c) -> [(a, b)] -> [(a, c)]
commonFstEq (forall a b c. Eq a => ([b] -> c) -> [(a, b)] -> [(a, c)]
commonFstEq forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 :: forall a b c. Eq a => ([b] -> c) -> [(a, b)] -> [(a, c)]
commonFstEq [b] -> c
f [(a, b)]
ps =
    [ (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(a, b)]
sps,[b] -> c
f forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, b)]
sps) | [(a, b)]
sps <- forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy 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 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 = forall a. Set a -> a
S.findMax forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map RDFLabel -> Word32
getAutoBnodeIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) <- 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 :: forall a. Eq a => a -> SubjTree a -> (SubjTree a, PredTree a)
splitOnLabel a
lbl SubjTree a
osubjs = 
    let (SubjTree a
bsubj, SubjTree a
rsubjs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Eq a => a -> a -> Bool
== a
lbl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 = forall a. (a -> Bool) -> Set a -> Set a
S.filter RDFLabel -> Bool
isBlank forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map RDFLabel Bool -> Arc RDFLabel -> Map RDFLabel Bool
procPO forall k a. Map k a
M.empty [Arc RDFLabel]
as
      map2 :: Map RDFLabel Bool
map2 = 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 forall k a. Map k a -> [k]
M.keys forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter 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 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 = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Int
T.findIndex (forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
txt
      hasSQ :: Bool
hasSQ = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Int
T.findIndex (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 (forall a. Int -> a -> [a]
replicate Int
n Char
'"')
      qst :: Builder
qst = Text -> Builder
B.fromText forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
quoteT (Int
n forall a. Eq a => a -> a -> Bool
== Int
1) Text
txt

  in 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ ScopedName -> LName
getScopeLocal ScopedName
sn
  in case 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 forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
quoteT Bool
True forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text
p, Text
":", Text
local]
       Maybe (Maybe Text)
_             -> forall a. Monoid a => [a] -> a
mconcat [ Builder
"<"
                                , String -> Builder
quoteBString (forall a. Show a => a -> String
show URI
nsuri 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 = 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 forall a. Eq a => a -> a -> Bool
== ScopedName
xsdDouble = Text -> Builder
B.fromText forall a b. (a -> b) -> a -> b
$ if Bool
n3flag then Text -> Text
T.toLower Text
lit else Text
lit
    | ScopedName
dtype 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 = 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 :: forall a.
(RDFLabel -> State a Builder) -> [RDFLabel] -> State a Builder
insertList RDFLabel -> 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 <- 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat (Builder
"( " forall a. a -> [a] -> [a]
: forall a. a -> [a] -> [a]
intersperse Builder
" " [Builder]
ls) 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_ :: forall a.
(a -> Builder) -> SLens a Bool -> Builder -> State a Builder
nextLine_ a -> Builder
indent SLens a Bool
_lineBreak Builder
str = do
  Builder
ind <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets a -> Builder
indent
  Bool
brk <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall a b. SLens a b -> a -> b
glens SLens a Bool
_lineBreak
  if Bool
brk
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Builder
ind forall a. Monoid a => a -> a -> a
`mappend` Builder
str
    else do
      --  After first line, always insert line break
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \a
st -> forall a b. SLens a b -> a -> b -> a
slens SLens a Bool
_lineBreak a
st Bool
True
      forall (m :: * -> *) a. Monad m => a -> m a
return Builder
str

mapBlankNode_ :: SLens a NodeGenState -> RDFLabel -> State a B.Builder
mapBlankNode_ :: forall a. SLens a NodeGenState -> RDFLabel -> State a Builder
mapBlankNode_ SLens a NodeGenState
_nodeGen RDFLabel
lab = do
  NodeGenState
ngs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ 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' -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \a
st -> forall a b. SLens a b -> a -> b -> a
slens SLens a NodeGenState
_nodeGen a
st NodeGenState
ngs'
    Maybe NodeGenState
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  forall (m :: * -> *) a. Monad m => a -> m a
return Builder
lval

formatPrefixLines :: NamespaceMap -> [B.Builder]
formatPrefixLines :: Map (Maybe Text) URI -> [Builder]
formatPrefixLines = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (Maybe Text, a) -> Builder
pref forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.assocs
    where
      pref :: (Maybe Text, a) -> Builder
pref (Just Text
p,a
u) = forall a. Monoid a => [a] -> a
mconcat [Builder
"@prefix ", Text -> Builder
B.fromText Text
p, Builder
": <", String -> Builder
quoteBString (forall a. Show a => a -> String
show a
u), Builder
"> ."]
      pref (Maybe Text
_,a
u)      = forall a. Monoid a => [a] -> a
mconcat [Builder
"@prefix : <", String -> Builder
quoteBString (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_ :: forall a.
(Builder -> State a Builder)
-> Map (Maybe Text) URI -> State a Builder
formatPrefixes_ Builder -> State a Builder
nextLine Map (Maybe Text) URI
pmap = 
    forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` 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_ :: forall a.
(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
  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 (forall lb. NSGraph lb -> Map (Maybe Text) URI
getNamespaces RDFGraph
gr)
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  Bool
more <- forall a b. (a -> [b]) -> State a Bool
hasMore a -> SubjTree RDFLabel
subjs
  if Bool
more
    then do
      Builder
fr <- State a Builder
formatSubjects
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Builder
fp, Builder
fr, Builder
end]
    else 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_ :: 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 = do
  RDFLabel
sb    <- State a RDFLabel
nextSubject
  Builder
sbstr <- LabelContext -> RDFLabel -> State a Builder
formatLabel LabelContext
SubjContext RDFLabel
sb
  
  Bool
flagP <- 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 <- forall a b. (a -> [b]) -> State a Bool
hasMore a -> SubjTree RDFLabel
subjs
      if Bool
flagS
        then do
          Builder
fr <- 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
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Builder
prstr, Builder
" .", Builder
fr]
        else forall (m :: * -> *) a. Monad m => a -> m a
return Builder
prstr
           
    else do
      Builder
txt <- Builder -> State a Builder
nextLine Builder
sbstr
    
      Bool
flagS <- forall a b. (a -> [b]) -> State a Bool
hasMore a -> SubjTree RDFLabel
subjs
      if Bool
flagS
        then do
          Builder
fr <- 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
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Builder
txt, Builder
" .", Builder
fr]
        else 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_ :: 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
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 forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Builder
sbstr, Builder
" ", Builder
prstr]
  Bool
more  <- 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 <- 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 forall a b. (a -> b) -> a -> b
$ Builder
obstr forall a. Monoid a => a -> a -> a
`mappend` Builder
" ;"
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Builder
nl 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_ :: 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
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  <- 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 <- 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 forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Builder
prstr, Builder
" ", Builder
obstr, Builder
","]
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Builder
nl forall a. Monoid a => a -> a -> a
`mappend` Builder
fr
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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_ :: forall a.
(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 <- 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) = forall a. Eq a => a -> SubjTree a -> (SubjTree a, PredTree a)
splitOnLabel RDFLabel
lbl SubjTree RDFLabel
osubjs
  forall s (m :: * -> *). MonadState s m => s -> m ()
put 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 <- forall a b. (a -> [b]) -> State a Bool
hasMore a -> [(RDFLabel, [RDFLabel])]
props
  Builder
txt <- if Bool
flag
         then (forall a. Monoid a => a -> a -> a
`mappend` Builder
"\n") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` RDFLabel -> Builder -> State a Builder
formatProperties RDFLabel
lbl Builder
""
         else forall (m :: * -> *) a. Monad m => a -> m a
return Builder
""

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

  forall s (m :: * -> *). MonadState s m => s -> m ()
put 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?
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RDFLabel
resRdfFirst, RDFLabel
resRdfRest]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) 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 forall a. Eq a => a -> a -> Bool
== LabelContext
SubjContext
                    then forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [RDFLabel
resRdfFirst, RDFLabel
resRdfRest]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(RDFLabel, [RDFLabel])]
oprops
                    else [(RDFLabel, [RDFLabel])]
oprops
      in forall a. a -> Maybe a
Just ([RDFLabel]
ls, SubjTree RDFLabel
sl, [(RDFLabel, [RDFLabel])]
oprops')

    Maybe (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_ :: forall a.
(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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets a -> SubjTree RDFLabel
subjs
  [(RDFLabel, [RDFLabel])]
oprops <- 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'
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just [RDFLabel]
ls)

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