{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
#if (__GLASGOW_HASKELL__ >= 802)
{-# LANGUAGE DerivingStrategies #-}
#endif
module Swish.RDF.Formatter.Internal
( NodeGenLookupMap
, SLens(..)
, SubjTree
, PredTree
, LabelContext(..)
, NodeGenState(..)
, changeState
, hasMore
, emptyNgs
, getBNodeLabel
, findMaxBnode
, splitOnLabel
, getCollection
, processArcs
, findPrefix
, 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.Foldable(Foldable(..))
import Data.Function (on)
import Data.List (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)
import Prelude hiding (Foldable(..))
findPrefix :: URI -> M.Map a URI -> Maybe a
findPrefix :: forall a. 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
data SLens a b = SLens (a -> b) (a -> b -> a)
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
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
type NodeGenLookupMap = M.Map RDFLabel Word32
type SubjTree lb = [(lb,PredTree lb)]
type PredTree lb = [(lb,[lb])]
data LabelContext = SubjContext | PredContext | ObjContext
deriving
#if (__GLASGOW_HASKELL__ >= 802)
stock
#endif
(LabelContext -> LabelContext -> Bool
(LabelContext -> LabelContext -> Bool)
-> (LabelContext -> LabelContext -> Bool) -> Eq LabelContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LabelContext -> LabelContext -> Bool
== :: LabelContext -> LabelContext -> Bool
$c/= :: LabelContext -> LabelContext -> Bool
/= :: 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
$cshowsPrec :: Int -> LabelContext -> ShowS
showsPrec :: Int -> LabelContext -> ShowS
$cshow :: LabelContext -> String
show :: LabelContext -> String
$cshowList :: [LabelContext] -> ShowS
showList :: [LabelContext] -> ShowS
Show)
data NodeGenState = Ngs
{ NodeGenState -> NodeGenLookupMap
nodeMap :: NodeGenLookupMap
, NodeGenState -> Word32
nodeGen :: Word32
}
emptyNgs :: NodeGenState
emptyNgs :: NodeGenState
emptyNgs = NodeGenLookupMap -> Word32 -> NodeGenState
Ngs NodeGenLookupMap
forall k a. Map k a
M.empty Word32
0
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 = nval, nodeMap = 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)
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 <- 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 a. a -> StateT a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return b
rval
hasMore :: (a -> [b]) -> State a Bool
hasMore :: forall a b. (a -> [b]) -> State a Bool
hasMore a -> [b]
lens = (a -> Bool) -> StateT a Identity 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 a. [a] -> 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)
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) = ((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
getCollection ::
SubjTree RDFLabel
-> RDFLabel
-> Maybe (SubjTree RDFLabel, [RDFLabel], [RDFLabel])
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)
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 :: forall lb. 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
arcTree :: (Eq lb) => SortedArcs lb -> SubjTree lb
arcTree :: forall lb. Eq lb => SortedArcs lb -> SubjTree lb
arcTree (SA [Arc lb]
as) = ([(lb, lb)] -> PredTree lb)
-> [(lb, (lb, lb))] -> [(lb, PredTree lb)]
forall a b c. Eq a => ([b] -> c) -> [(a, b)] -> [(a, c)]
commonFstEq (([lb] -> [lb]) -> [(lb, lb)] -> PredTree lb
forall a b c. Eq a => ([b] -> c) -> [(a, b)] -> [(a, c)]
commonFstEq [lb] -> [lb]
forall a. a -> a
id) ([(lb, (lb, lb))] -> [(lb, PredTree lb)])
-> [(lb, (lb, lb))] -> [(lb, PredTree 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))
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 = ([(a, b)] -> (a, c)) -> [[(a, b)]] -> [(a, c)]
forall a b. (a -> b) -> [a] -> [b]
map [(a, b)] -> (a, c)
forall {a}. [(a, b)] -> (a, c)
conv (((a, b) -> (a, b) -> Bool) -> [(a, b)] -> [[(a, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (a, b) -> (a, b) -> Bool
forall {b}. (a, b) -> (a, b) -> Bool
fstEq [(a, b)]
ps)
where
fstEq :: (a, b) -> (a, b) -> Bool
fstEq = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (a -> a -> Bool) -> ((a, b) -> a) -> (a, b) -> (a, b) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, b) -> a
forall a b. (a, b) -> a
fst
conv :: [(a, b)] -> (a, c)
conv [] = String -> (a, c)
forall a. HasCallStack => String -> a
error String
"internal error"
conv sps :: [(a, b)]
sps@((a
h, b
_) : [(a, b)]
_) = (a
h, [b] -> c
f (((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))
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
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 :: forall a. Eq a => 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)
countBnodes :: SortedArcs RDFLabel -> [RDFLabel]
countBnodes :: SortedArcs RDFLabel -> [RDFLabel]
countBnodes (SA [Arc RDFLabel]
as) =
let
upd :: p -> p -> Bool
upd p
_ p
_ = Bool
True
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
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
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 b a. (b -> a -> b) -> b -> [a] -> b
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
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
quoteBString :: String -> B.Builder
quoteBString :: String -> Builder
quoteBString = Bool -> String -> Builder
quoteB Bool
True
quoteText :: T.Text -> B.Builder
quoteText :: Text -> Builder
quoteText Text
txt =
let
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
n Int -> 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]
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)]
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 a. Eq a => a -> [a] -> 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]
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
_ [] = Builder -> State a Builder
forall a. a -> StateT a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
"()"
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RDFLabel -> State a Builder
f [RDFLabel]
xs
Builder -> State a Builder
forall a. a -> StateT a Identity a
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)
-> SLens a Bool
-> 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 <- (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 a. a -> StateT a Identity a
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
(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 a. a -> StateT a Identity a
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 <- (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 a. a -> StateT a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Builder -> State a Builder
forall a. a -> StateT a Identity a
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)
-> 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 =
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> StateT a Identity [Builder] -> State a Builder
forall a b. (a -> b) -> StateT a Identity a -> StateT a Identity b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Builder -> State a Builder
nextLine (Map (Maybe Text) URI -> [Builder]
formatPrefixLines Map (Maybe Text) URI
pmap)
formatGraph_ ::
(B.Builder -> State a ())
-> (Bool -> State a ())
-> (RDFGraph -> a -> a)
-> (NamespaceMap -> State a B.Builder)
-> (a -> SubjTree RDFLabel)
-> State a B.Builder
-> B.Builder
-> B.Builder
-> Bool
-> Bool
-> RDFGraph
-> 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
(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 a. a -> StateT a Identity a
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 a. a -> StateT a Identity a
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 a. a -> StateT a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
fp
formatSubjects_ ::
State a RDFLabel
-> (LabelContext -> RDFLabel -> State a B.Builder)
-> (a -> PredTree RDFLabel)
-> (RDFLabel -> B.Builder -> State a B.Builder)
-> (a -> SubjTree RDFLabel)
-> (B.Builder -> State a B.Builder)
-> 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 <- (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 a. a -> StateT a Identity a
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 a. a -> StateT a Identity a
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 a. a -> StateT a Identity a
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 a. a -> StateT a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
txt
hackIndent :: B.Builder
hackIndent :: Builder
hackIndent = Builder
" "
formatProperties_ ::
(RDFLabel -> State a RDFLabel)
-> (LabelContext -> RDFLabel -> State a B.Builder)
-> (RDFLabel -> RDFLabel -> B.Builder -> State a B.Builder)
-> (a -> PredTree RDFLabel)
-> (B.Builder -> State a B.Builder)
-> RDFLabel
-> B.Builder
-> 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 (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
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 a. a -> StateT a Identity a
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)
-> (LabelContext -> RDFLabel -> State a B.Builder)
-> (a -> [RDFLabel])
-> (B.Builder -> State a B.Builder)
-> RDFLabel
-> RDFLabel
-> B.Builder
-> 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 <- (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
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 a. a -> StateT a Identity a
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 a. a -> StateT a Identity a
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]
insertBnode_ ::
(a -> SubjTree RDFLabel)
-> (a -> PredTree RDFLabel)
-> (a -> [RDFLabel])
-> (a -> SubjTree RDFLabel -> PredTree RDFLabel -> [RDFLabel] -> a)
-> (RDFLabel -> B.Builder -> State a B.Builder)
-> 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 <- 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 a b. (a -> b) -> StateT a Identity a -> StateT a Identity b
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 a. a -> StateT a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
""
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 a. Eq a => a -> [a] -> 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)
Builder -> State a Builder
forall a. a -> StateT a Identity a
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)
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
fprops :: [(RDFLabel, [RDFLabel])]
fprops = ((RDFLabel, [RDFLabel]) -> Bool)
-> [(RDFLabel, [RDFLabel])] -> [(RDFLabel, [RDFLabel])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((RDFLabel -> [RDFLabel] -> Bool
forall a. Eq a => a -> [a] -> 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)
-> (a -> PredTree RDFLabel)
-> (SubjTree RDFLabel -> State a ())
-> (PredTree RDFLabel -> State a ())
-> LabelContext
-> RDFLabel
-> State a (Maybe [RDFLabel])
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 a. a -> StateT a Identity a
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 a. a -> StateT a Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [RDFLabel]
forall a. Maybe a
Nothing