{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Swish.RDF.Formatter.N3
( NodeGenLookupMap
, formatGraphAsText
, formatGraphAsLazyText
, formatGraphAsBuilder
, formatGraphIndent
, formatGraphDiag
)
where
import Swish.RDF.Formatter.Internal (NodeGenLookupMap, SubjTree, PredTree
, SLens(..)
, LabelContext(..)
, NodeGenState(..)
, changeState
, hasMore
, emptyNgs
, findMaxBnode
, processArcs
, quoteB
, formatScopedName
, formatPlainLit
, formatLangLit
, formatTypedLit
, insertList
, nextLine_
, mapBlankNode_
, formatPrefixes_
, formatGraph_
, formatSubjects_
, formatProperties_
, formatObjects_
, insertBnode_
, extractList_
)
import Swish.Namespace (ScopedName)
import Swish.RDF.Graph (
RDFGraph, RDFLabel(..),
NamespaceMap,
emptyNamespaceMap,
FormulaMap, emptyFormulaMap,
setNamespaces, getNamespaces,
getFormulae,
emptyRDFGraph
)
import Swish.RDF.Vocabulary (
rdfType,
rdfNil,
owlSameAs, logImplies
)
import Control.Monad (liftM, void)
import Control.Monad.State (State, modify, get, gets, put, runState)
import Data.Char (isDigit)
import Data.Word (Word32)
#if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)
import Data.Monoid (Monoid(..))
#endif
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Builder as B
data N3FormatterState = N3FS
{ N3FormatterState -> Builder
indent :: B.Builder
, N3FormatterState -> Bool
lineBreak :: Bool
, N3FormatterState -> RDFGraph
graph :: RDFGraph
, N3FormatterState -> SubjTree RDFLabel
subjs :: SubjTree RDFLabel
, N3FormatterState -> PredTree RDFLabel
props :: PredTree RDFLabel
, N3FormatterState -> [RDFLabel]
objs :: [RDFLabel]
, N3FormatterState -> FormulaMap RDFLabel
formAvail :: FormulaMap RDFLabel
, N3FormatterState -> [(RDFLabel, RDFGraph)]
formQueue :: [(RDFLabel,RDFGraph)]
, N3FormatterState -> NamespaceMap
prefixes :: NamespaceMap
, N3FormatterState -> NodeGenState
nodeGenSt :: NodeGenState
, N3FormatterState -> [RDFLabel]
bNodesCheck :: [RDFLabel]
, N3FormatterState -> [String]
traceBuf :: [String]
}
type SL a = SLens N3FormatterState a
_lineBreak :: SL Bool
_lineBreak :: SL Bool
_lineBreak = (N3FormatterState -> Bool)
-> (N3FormatterState -> Bool -> N3FormatterState) -> SL Bool
forall a b. (a -> b) -> (a -> b -> a) -> SLens a b
SLens N3FormatterState -> Bool
lineBreak ((N3FormatterState -> Bool -> N3FormatterState) -> SL Bool)
-> (N3FormatterState -> Bool -> N3FormatterState) -> SL Bool
forall a b. (a -> b) -> a -> b
$ \a :: N3FormatterState
a b :: Bool
b -> N3FormatterState
a { lineBreak :: Bool
lineBreak = Bool
b }
_nodeGen :: SL NodeGenState
_nodeGen :: SL NodeGenState
_nodeGen = (N3FormatterState -> NodeGenState)
-> (N3FormatterState -> NodeGenState -> N3FormatterState)
-> SL NodeGenState
forall a b. (a -> b) -> (a -> b -> a) -> SLens a b
SLens N3FormatterState -> NodeGenState
nodeGenSt ((N3FormatterState -> NodeGenState -> N3FormatterState)
-> SL NodeGenState)
-> (N3FormatterState -> NodeGenState -> N3FormatterState)
-> SL NodeGenState
forall a b. (a -> b) -> a -> b
$ \a :: N3FormatterState
a b :: NodeGenState
b -> N3FormatterState
a { nodeGenSt :: NodeGenState
nodeGenSt = NodeGenState
b }
type Formatter a = State N3FormatterState a
updateState :: N3FormatterState -> SubjTree RDFLabel -> PredTree RDFLabel -> [RDFLabel] -> N3FormatterState
updateState :: N3FormatterState
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> N3FormatterState
updateState ost :: N3FormatterState
ost nsubjs :: SubjTree RDFLabel
nsubjs nprops :: PredTree RDFLabel
nprops nobjs :: [RDFLabel]
nobjs = N3FormatterState
ost { subjs :: SubjTree RDFLabel
subjs = SubjTree RDFLabel
nsubjs, props :: PredTree RDFLabel
props = PredTree RDFLabel
nprops, objs :: [RDFLabel]
objs = [RDFLabel]
nobjs }
emptyN3FS :: NamespaceMap -> NodeGenState -> N3FormatterState
emptyN3FS :: NamespaceMap -> NodeGenState -> N3FormatterState
emptyN3FS pmap :: NamespaceMap
pmap ngs :: NodeGenState
ngs = N3FS :: Builder
-> Bool
-> RDFGraph
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> FormulaMap RDFLabel
-> [(RDFLabel, RDFGraph)]
-> NamespaceMap
-> NodeGenState
-> [RDFLabel]
-> [String]
-> N3FormatterState
N3FS
{ indent :: Builder
indent = "\n"
, lineBreak :: Bool
lineBreak = Bool
False
, graph :: RDFGraph
graph = RDFGraph
emptyRDFGraph
, subjs :: SubjTree RDFLabel
subjs = []
, props :: PredTree RDFLabel
props = []
, objs :: [RDFLabel]
objs = []
, formAvail :: FormulaMap RDFLabel
formAvail = FormulaMap RDFLabel
emptyFormulaMap
, formQueue :: [(RDFLabel, RDFGraph)]
formQueue = []
, prefixes :: NamespaceMap
prefixes = NamespaceMap
pmap
, nodeGenSt :: NodeGenState
nodeGenSt = NodeGenState
ngs
, bNodesCheck :: [RDFLabel]
bNodesCheck = []
, traceBuf :: [String]
traceBuf = []
}
setIndent :: B.Builder -> Formatter ()
setIndent :: Builder -> Formatter ()
setIndent ind :: Builder
ind = (N3FormatterState -> N3FormatterState) -> Formatter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((N3FormatterState -> N3FormatterState) -> Formatter ())
-> (N3FormatterState -> N3FormatterState) -> Formatter ()
forall a b. (a -> b) -> a -> b
$ \st :: N3FormatterState
st -> N3FormatterState
st { indent :: Builder
indent = Builder
ind }
setLineBreak :: Bool -> Formatter ()
setLineBreak :: Bool -> Formatter ()
setLineBreak brk :: Bool
brk = (N3FormatterState -> N3FormatterState) -> Formatter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((N3FormatterState -> N3FormatterState) -> Formatter ())
-> (N3FormatterState -> N3FormatterState) -> Formatter ()
forall a b. (a -> b) -> a -> b
$ \st :: N3FormatterState
st -> N3FormatterState
st { lineBreak :: Bool
lineBreak = Bool
brk }
setSubjs :: SubjTree RDFLabel -> Formatter ()
setSubjs :: SubjTree RDFLabel -> Formatter ()
setSubjs sl :: SubjTree RDFLabel
sl = (N3FormatterState -> N3FormatterState) -> Formatter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((N3FormatterState -> N3FormatterState) -> Formatter ())
-> (N3FormatterState -> N3FormatterState) -> Formatter ()
forall a b. (a -> b) -> a -> b
$ \st :: N3FormatterState
st -> N3FormatterState
st { subjs :: SubjTree RDFLabel
subjs = SubjTree RDFLabel
sl }
setProps :: PredTree RDFLabel -> Formatter ()
setProps :: PredTree RDFLabel -> Formatter ()
setProps ps :: PredTree RDFLabel
ps = (N3FormatterState -> N3FormatterState) -> Formatter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((N3FormatterState -> N3FormatterState) -> Formatter ())
-> (N3FormatterState -> N3FormatterState) -> Formatter ()
forall a b. (a -> b) -> a -> b
$ \st :: N3FormatterState
st -> N3FormatterState
st { props :: PredTree RDFLabel
props = PredTree RDFLabel
ps }
queueFormula :: RDFLabel -> Formatter ()
queueFormula :: RDFLabel -> Formatter ()
queueFormula fn :: RDFLabel
fn = do
N3FormatterState
st <- StateT N3FormatterState Identity N3FormatterState
forall s (m :: * -> *). MonadState s m => m s
get
let fa :: FormulaMap RDFLabel
fa = N3FormatterState -> FormulaMap RDFLabel
formAvail N3FormatterState
st
_newState :: RDFGraph -> N3FormatterState
_newState fv :: RDFGraph
fv = N3FormatterState
st {
formAvail :: FormulaMap RDFLabel
formAvail = RDFLabel -> FormulaMap RDFLabel -> FormulaMap RDFLabel
forall k a. Ord k => k -> Map k a -> Map k a
M.delete RDFLabel
fn FormulaMap RDFLabel
fa,
formQueue :: [(RDFLabel, RDFGraph)]
formQueue = (RDFLabel
fn,RDFGraph
fv) (RDFLabel, RDFGraph)
-> [(RDFLabel, RDFGraph)] -> [(RDFLabel, RDFGraph)]
forall a. a -> [a] -> [a]
: N3FormatterState -> [(RDFLabel, RDFGraph)]
formQueue N3FormatterState
st
}
case RDFLabel -> FormulaMap RDFLabel -> Maybe RDFGraph
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup RDFLabel
fn FormulaMap RDFLabel
fa of
Nothing -> () -> Formatter ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just v :: RDFGraph
v -> Formatter () -> Formatter ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Formatter () -> Formatter ()) -> Formatter () -> Formatter ()
forall a b. (a -> b) -> a -> b
$ N3FormatterState -> Formatter ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (N3FormatterState -> Formatter ())
-> N3FormatterState -> Formatter ()
forall a b. (a -> b) -> a -> b
$ RDFGraph -> N3FormatterState
_newState RDFGraph
v
extractFormula :: RDFLabel -> Formatter (Maybe RDFGraph)
fn :: RDFLabel
fn = do
N3FormatterState
st <- StateT N3FormatterState Identity N3FormatterState
forall s (m :: * -> *). MonadState s m => m s
get
let (rval :: Maybe RDFGraph
rval, nform :: FormulaMap RDFLabel
nform) = (RDFLabel -> RDFGraph -> Maybe RDFGraph)
-> RDFLabel
-> FormulaMap RDFLabel
-> (Maybe RDFGraph, FormulaMap RDFLabel)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
M.updateLookupWithKey (\_ _ -> Maybe RDFGraph
forall a. Maybe a
Nothing) RDFLabel
fn (FormulaMap RDFLabel -> (Maybe RDFGraph, FormulaMap RDFLabel))
-> FormulaMap RDFLabel -> (Maybe RDFGraph, FormulaMap RDFLabel)
forall a b. (a -> b) -> a -> b
$ N3FormatterState -> FormulaMap RDFLabel
formAvail N3FormatterState
st
N3FormatterState -> Formatter ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (N3FormatterState -> Formatter ())
-> N3FormatterState -> Formatter ()
forall a b. (a -> b) -> a -> b
$ N3FormatterState
st { formAvail :: FormulaMap RDFLabel
formAvail = FormulaMap RDFLabel
nform }
Maybe RDFGraph -> Formatter (Maybe RDFGraph)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RDFGraph
rval
extractList :: LabelContext -> RDFLabel -> Formatter (Maybe [RDFLabel])
= (N3FormatterState -> SubjTree RDFLabel)
-> (N3FormatterState -> PredTree RDFLabel)
-> (SubjTree RDFLabel -> Formatter ())
-> (PredTree RDFLabel -> Formatter ())
-> LabelContext
-> RDFLabel
-> Formatter (Maybe [RDFLabel])
forall a.
(a -> SubjTree RDFLabel)
-> (a -> PredTree RDFLabel)
-> (SubjTree RDFLabel -> State a ())
-> (PredTree RDFLabel -> State a ())
-> LabelContext
-> RDFLabel
-> State a (Maybe [RDFLabel])
extractList_ N3FormatterState -> SubjTree RDFLabel
subjs N3FormatterState -> PredTree RDFLabel
props SubjTree RDFLabel -> Formatter ()
setSubjs PredTree RDFLabel -> Formatter ()
setProps
formatGraphAsText :: RDFGraph -> T.Text
formatGraphAsText :: RDFGraph -> Text
formatGraphAsText = Text -> Text
L.toStrict (Text -> Text) -> (RDFGraph -> Text) -> RDFGraph -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDFGraph -> Text
formatGraphAsLazyText
formatGraphAsLazyText :: RDFGraph -> L.Text
formatGraphAsLazyText :: RDFGraph -> Text
formatGraphAsLazyText = Builder -> Text
B.toLazyText (Builder -> Text) -> (RDFGraph -> Builder) -> RDFGraph -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDFGraph -> Builder
formatGraphAsBuilder
formatGraphAsBuilder :: RDFGraph -> B.Builder
formatGraphAsBuilder :: RDFGraph -> Builder
formatGraphAsBuilder = Builder -> Bool -> RDFGraph -> Builder
formatGraphIndent "\n" Bool
True
formatGraphIndent ::
B.Builder
-> Bool
-> RDFGraph
-> B.Builder
formatGraphIndent :: Builder -> Bool -> RDFGraph -> Builder
formatGraphIndent indnt :: Builder
indnt flag :: Bool
flag gr :: RDFGraph
gr =
let (res :: Builder
res, _, _, _) = Builder
-> Bool
-> RDFGraph
-> (Builder, NodeGenLookupMap, Word32, [String])
formatGraphDiag Builder
indnt Bool
flag RDFGraph
gr
in Builder
res
formatGraphDiag ::
B.Builder
-> Bool
-> RDFGraph
-> (B.Builder, NodeGenLookupMap, Word32, [String])
formatGraphDiag :: Builder
-> Bool
-> RDFGraph
-> (Builder, NodeGenLookupMap, Word32, [String])
formatGraphDiag indnt :: Builder
indnt flag :: Bool
flag gr :: RDFGraph
gr =
let fg :: Formatter Builder
fg = Builder -> Builder -> Bool -> Bool -> RDFGraph -> Formatter Builder
formatGraph Builder
indnt " .\n" Bool
False Bool
flag RDFGraph
gr
ngs :: NodeGenState
ngs = NodeGenState
emptyNgs { nodeGen :: Word32
nodeGen = RDFGraph -> Word32
findMaxBnode RDFGraph
gr }
(out :: Builder
out, fgs :: N3FormatterState
fgs) = Formatter Builder
-> N3FormatterState -> (Builder, N3FormatterState)
forall s a. State s a -> s -> (a, s)
runState Formatter Builder
fg (NamespaceMap -> NodeGenState -> N3FormatterState
emptyN3FS NamespaceMap
emptyNamespaceMap NodeGenState
ngs)
ogs :: NodeGenState
ogs = N3FormatterState -> NodeGenState
nodeGenSt N3FormatterState
fgs
in (Builder
out, NodeGenState -> NodeGenLookupMap
nodeMap NodeGenState
ogs, NodeGenState -> Word32
nodeGen NodeGenState
ogs, N3FormatterState -> [String]
traceBuf N3FormatterState
fgs)
formatGraph ::
B.Builder
-> B.Builder
-> Bool
-> Bool
-> RDFGraph
-> Formatter B.Builder
formatGraph :: Builder -> Builder -> Bool -> Bool -> RDFGraph -> Formatter Builder
formatGraph = (Builder -> Formatter ())
-> (Bool -> Formatter ())
-> (RDFGraph -> N3FormatterState -> N3FormatterState)
-> (NamespaceMap -> Formatter Builder)
-> (N3FormatterState -> SubjTree RDFLabel)
-> Formatter Builder
-> Builder
-> Builder
-> Bool
-> Bool
-> RDFGraph
-> Formatter Builder
forall a.
(Builder -> State a ())
-> (Bool -> State a ())
-> (RDFGraph -> a -> a)
-> (NamespaceMap -> State a Builder)
-> (a -> SubjTree RDFLabel)
-> State a Builder
-> Builder
-> Builder
-> Bool
-> Bool
-> RDFGraph
-> State a Builder
formatGraph_ Builder -> Formatter ()
setIndent Bool -> Formatter ()
setLineBreak RDFGraph -> N3FormatterState -> N3FormatterState
newState NamespaceMap -> Formatter Builder
formatPrefixes N3FormatterState -> SubjTree RDFLabel
subjs Formatter Builder
formatSubjects
formatPrefixes :: NamespaceMap -> Formatter B.Builder
formatPrefixes :: NamespaceMap -> Formatter Builder
formatPrefixes = (Builder -> Formatter Builder) -> NamespaceMap -> Formatter Builder
forall a.
(Builder -> State a Builder) -> NamespaceMap -> State a Builder
formatPrefixes_ Builder -> Formatter Builder
nextLine
formatSubjects :: Formatter B.Builder
formatSubjects :: Formatter Builder
formatSubjects = State N3FormatterState RDFLabel
-> (LabelContext -> RDFLabel -> Formatter Builder)
-> (N3FormatterState -> PredTree RDFLabel)
-> (RDFLabel -> Builder -> Formatter Builder)
-> (N3FormatterState -> SubjTree RDFLabel)
-> (Builder -> Formatter Builder)
-> Formatter Builder
forall a.
State a RDFLabel
-> (LabelContext -> RDFLabel -> State a Builder)
-> (a -> PredTree RDFLabel)
-> (RDFLabel -> Builder -> State a Builder)
-> (a -> SubjTree RDFLabel)
-> (Builder -> State a Builder)
-> State a Builder
formatSubjects_ State N3FormatterState RDFLabel
nextSubject LabelContext -> RDFLabel -> Formatter Builder
formatLabel N3FormatterState -> PredTree RDFLabel
props RDFLabel -> Builder -> Formatter Builder
formatProperties N3FormatterState -> SubjTree RDFLabel
subjs Builder -> Formatter Builder
nextLine
formatProperties :: RDFLabel -> B.Builder -> Formatter B.Builder
formatProperties :: RDFLabel -> Builder -> Formatter Builder
formatProperties = (RDFLabel -> State N3FormatterState RDFLabel)
-> (LabelContext -> RDFLabel -> Formatter Builder)
-> (RDFLabel -> RDFLabel -> Builder -> Formatter Builder)
-> (N3FormatterState -> PredTree RDFLabel)
-> (Builder -> Formatter Builder)
-> RDFLabel
-> Builder
-> Formatter Builder
forall a.
(RDFLabel -> State a RDFLabel)
-> (LabelContext -> RDFLabel -> State a Builder)
-> (RDFLabel -> RDFLabel -> Builder -> State a Builder)
-> (a -> PredTree RDFLabel)
-> (Builder -> State a Builder)
-> RDFLabel
-> Builder
-> State a Builder
formatProperties_ RDFLabel -> State N3FormatterState RDFLabel
nextProperty LabelContext -> RDFLabel -> Formatter Builder
formatLabel RDFLabel -> RDFLabel -> Builder -> Formatter Builder
formatObjects N3FormatterState -> PredTree RDFLabel
props Builder -> Formatter Builder
nextLine
formatObjects :: RDFLabel -> RDFLabel -> B.Builder -> Formatter B.Builder
formatObjects :: RDFLabel -> RDFLabel -> Builder -> Formatter Builder
formatObjects = (RDFLabel -> RDFLabel -> State N3FormatterState RDFLabel)
-> (LabelContext -> RDFLabel -> Formatter Builder)
-> (N3FormatterState -> [RDFLabel])
-> (Builder -> Formatter Builder)
-> RDFLabel
-> RDFLabel
-> Builder
-> Formatter Builder
forall a.
(RDFLabel -> RDFLabel -> State a RDFLabel)
-> (LabelContext -> RDFLabel -> State a Builder)
-> (a -> [RDFLabel])
-> (Builder -> State a Builder)
-> RDFLabel
-> RDFLabel
-> Builder
-> State a Builder
formatObjects_ RDFLabel -> RDFLabel -> State N3FormatterState RDFLabel
nextObject LabelContext -> RDFLabel -> Formatter Builder
formatLabel N3FormatterState -> [RDFLabel]
objs Builder -> Formatter Builder
nextLine
insertFormula :: RDFGraph -> Formatter B.Builder
insertFormula :: RDFGraph -> Formatter Builder
insertFormula gr :: RDFGraph
gr = do
NamespaceMap
pmap0 <- (N3FormatterState -> NamespaceMap)
-> StateT N3FormatterState Identity NamespaceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets N3FormatterState -> NamespaceMap
prefixes
NodeGenState
ngs0 <- (N3FormatterState -> NodeGenState)
-> StateT N3FormatterState Identity NodeGenState
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets N3FormatterState -> NodeGenState
nodeGenSt
Builder
ind <- (N3FormatterState -> Builder) -> Formatter Builder
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets N3FormatterState -> Builder
indent
let grm :: Formatter Builder
grm = Builder -> Builder -> Bool -> Bool -> RDFGraph -> Formatter Builder
formatGraph (Builder
ind Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` " ") "" Bool
True Bool
False
(NamespaceMap -> RDFGraph -> RDFGraph
forall lb. NamespaceMap -> NSGraph lb -> NSGraph lb
setNamespaces NamespaceMap
emptyNamespaceMap RDFGraph
gr)
(f3str :: Builder
f3str, fgs' :: N3FormatterState
fgs') = Formatter Builder
-> N3FormatterState -> (Builder, N3FormatterState)
forall s a. State s a -> s -> (a, s)
runState Formatter Builder
grm (NamespaceMap -> NodeGenState -> N3FormatterState
emptyN3FS NamespaceMap
pmap0 NodeGenState
ngs0)
(N3FormatterState -> N3FormatterState) -> Formatter ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((N3FormatterState -> N3FormatterState) -> Formatter ())
-> (N3FormatterState -> N3FormatterState) -> Formatter ()
forall a b. (a -> b) -> a -> b
$ \st :: N3FormatterState
st -> N3FormatterState
st { nodeGenSt :: NodeGenState
nodeGenSt = N3FormatterState -> NodeGenState
nodeGenSt N3FormatterState
fgs'
, prefixes :: NamespaceMap
prefixes = N3FormatterState -> NamespaceMap
prefixes N3FormatterState
fgs' }
Builder
f4str <- Builder -> Formatter Builder
nextLine " } "
Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [" { ",Builder
f3str, Builder
f4str]
insertBnode :: LabelContext -> RDFLabel -> Formatter B.Builder
insertBnode :: LabelContext -> RDFLabel -> Formatter Builder
insertBnode SubjContext lbl :: RDFLabel
lbl = do
Bool
flag <- (N3FormatterState -> PredTree RDFLabel)
-> State N3FormatterState Bool
forall a b. (a -> [b]) -> State a Bool
hasMore N3FormatterState -> PredTree RDFLabel
props
Builder
txt <- if Bool
flag
then (Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` "\n") (Builder -> Builder) -> Formatter Builder -> Formatter Builder
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` RDFLabel -> Builder -> Formatter Builder
formatProperties RDFLabel
lbl ""
else Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return ""
Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ["[", Builder
txt, "]"]
insertBnode _ lbl :: RDFLabel
lbl = (N3FormatterState -> SubjTree RDFLabel)
-> (N3FormatterState -> PredTree RDFLabel)
-> (N3FormatterState -> [RDFLabel])
-> (N3FormatterState
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> N3FormatterState)
-> (RDFLabel -> Builder -> Formatter Builder)
-> RDFLabel
-> Formatter Builder
forall a.
(a -> SubjTree RDFLabel)
-> (a -> PredTree RDFLabel)
-> (a -> [RDFLabel])
-> (a -> SubjTree RDFLabel -> PredTree RDFLabel -> [RDFLabel] -> a)
-> (RDFLabel -> Builder -> State a Builder)
-> RDFLabel
-> State a Builder
insertBnode_ N3FormatterState -> SubjTree RDFLabel
subjs N3FormatterState -> PredTree RDFLabel
props N3FormatterState -> [RDFLabel]
objs N3FormatterState
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> N3FormatterState
updateState RDFLabel -> Builder -> Formatter Builder
formatProperties RDFLabel
lbl
newState :: RDFGraph -> N3FormatterState -> N3FormatterState
newState :: RDFGraph -> N3FormatterState -> N3FormatterState
newState gr :: RDFGraph
gr st :: N3FormatterState
st =
let pre' :: NamespaceMap
pre' = N3FormatterState -> NamespaceMap
prefixes N3FormatterState
st NamespaceMap -> NamespaceMap -> NamespaceMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` RDFGraph -> NamespaceMap
forall lb. NSGraph lb -> NamespaceMap
getNamespaces RDFGraph
gr
(arcSubjs :: SubjTree RDFLabel
arcSubjs, bNodes :: [RDFLabel]
bNodes) = RDFGraph -> (SubjTree RDFLabel, [RDFLabel])
processArcs RDFGraph
gr
in N3FormatterState
st { graph :: RDFGraph
graph = RDFGraph
gr
, subjs :: SubjTree RDFLabel
subjs = SubjTree RDFLabel
arcSubjs
, props :: PredTree RDFLabel
props = []
, objs :: [RDFLabel]
objs = []
, formAvail :: FormulaMap RDFLabel
formAvail = RDFGraph -> FormulaMap RDFLabel
forall lb. NSGraph lb -> FormulaMap lb
getFormulae RDFGraph
gr
, prefixes :: NamespaceMap
prefixes = NamespaceMap
pre'
, bNodesCheck :: [RDFLabel]
bNodesCheck = [RDFLabel]
bNodes
}
nextSubject :: Formatter RDFLabel
nextSubject :: State N3FormatterState RDFLabel
nextSubject =
(N3FormatterState -> (RDFLabel, N3FormatterState))
-> State N3FormatterState RDFLabel
forall a b. (a -> (b, a)) -> State a b
changeState ((N3FormatterState -> (RDFLabel, N3FormatterState))
-> State N3FormatterState RDFLabel)
-> (N3FormatterState -> (RDFLabel, N3FormatterState))
-> State N3FormatterState RDFLabel
forall a b. (a -> b) -> a -> b
$ \st :: N3FormatterState
st ->
let (a :: RDFLabel
a,b :: PredTree RDFLabel
b):sbs :: SubjTree RDFLabel
sbs = N3FormatterState -> SubjTree RDFLabel
subjs N3FormatterState
st
nst :: N3FormatterState
nst = N3FormatterState
st { subjs :: SubjTree RDFLabel
subjs = SubjTree RDFLabel
sbs
, props :: PredTree RDFLabel
props = PredTree RDFLabel
b
, objs :: [RDFLabel]
objs = []
}
in (RDFLabel
a, N3FormatterState
nst)
nextProperty :: RDFLabel -> Formatter RDFLabel
nextProperty :: RDFLabel -> State N3FormatterState RDFLabel
nextProperty _ =
(N3FormatterState -> (RDFLabel, N3FormatterState))
-> State N3FormatterState RDFLabel
forall a b. (a -> (b, a)) -> State a b
changeState ((N3FormatterState -> (RDFLabel, N3FormatterState))
-> State N3FormatterState RDFLabel)
-> (N3FormatterState -> (RDFLabel, N3FormatterState))
-> State N3FormatterState RDFLabel
forall a b. (a -> b) -> a -> b
$ \st :: N3FormatterState
st ->
let (a :: RDFLabel
a,b :: [RDFLabel]
b):prs :: PredTree RDFLabel
prs = N3FormatterState -> PredTree RDFLabel
props N3FormatterState
st
nst :: N3FormatterState
nst = N3FormatterState
st { props :: PredTree RDFLabel
props = PredTree RDFLabel
prs
, objs :: [RDFLabel]
objs = [RDFLabel]
b
}
in (RDFLabel
a, N3FormatterState
nst)
nextObject :: RDFLabel -> RDFLabel -> Formatter RDFLabel
nextObject :: RDFLabel -> RDFLabel -> State N3FormatterState RDFLabel
nextObject _ _ =
(N3FormatterState -> (RDFLabel, N3FormatterState))
-> State N3FormatterState RDFLabel
forall a b. (a -> (b, a)) -> State a b
changeState ((N3FormatterState -> (RDFLabel, N3FormatterState))
-> State N3FormatterState RDFLabel)
-> (N3FormatterState -> (RDFLabel, N3FormatterState))
-> State N3FormatterState RDFLabel
forall a b. (a -> b) -> a -> b
$ \st :: N3FormatterState
st ->
let ob :: RDFLabel
ob:obs :: [RDFLabel]
obs = N3FormatterState -> [RDFLabel]
objs N3FormatterState
st
nst :: N3FormatterState
nst = N3FormatterState
st { objs :: [RDFLabel]
objs = [RDFLabel]
obs }
in (RDFLabel
ob, N3FormatterState
nst)
nextLine :: B.Builder -> Formatter B.Builder
nextLine :: Builder -> Formatter Builder
nextLine = (N3FormatterState -> Builder)
-> SL Bool -> Builder -> Formatter Builder
forall a.
(a -> Builder) -> SLens a Bool -> Builder -> State a Builder
nextLine_ N3FormatterState -> Builder
indent SL Bool
_lineBreak
specialTable :: [(ScopedName, String)]
specialTable :: [(ScopedName, String)]
specialTable =
[ (ScopedName
rdfType, "a")
, (ScopedName
owlSameAs, "=")
, (ScopedName
logImplies, "=>")
, (ScopedName
rdfNil, "()")
]
formatLabel :: LabelContext -> RDFLabel -> Formatter B.Builder
formatLabel :: LabelContext -> RDFLabel -> Formatter Builder
formatLabel lctxt :: LabelContext
lctxt lab :: RDFLabel
lab@(Blank (_:_)) = do
Maybe [RDFLabel]
mlst <- LabelContext -> RDFLabel -> Formatter (Maybe [RDFLabel])
extractList LabelContext
lctxt RDFLabel
lab
case Maybe [RDFLabel]
mlst of
Just lst :: [RDFLabel]
lst -> (RDFLabel -> Formatter Builder) -> [RDFLabel] -> Formatter Builder
forall a.
(RDFLabel -> State a Builder) -> [RDFLabel] -> State a Builder
insertList (LabelContext -> RDFLabel -> Formatter Builder
formatLabel LabelContext
ObjContext) [RDFLabel]
lst
Nothing -> do
Maybe RDFGraph
mfml <- RDFLabel -> Formatter (Maybe RDFGraph)
extractFormula RDFLabel
lab
case Maybe RDFGraph
mfml of
Just fml :: RDFGraph
fml -> RDFGraph -> Formatter Builder
insertFormula RDFGraph
fml
Nothing -> do
[RDFLabel]
nb1 <- (N3FormatterState -> [RDFLabel])
-> StateT N3FormatterState Identity [RDFLabel]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets N3FormatterState -> [RDFLabel]
bNodesCheck
if LabelContext
lctxt LabelContext -> LabelContext -> Bool
forall a. Eq a => a -> a -> Bool
/= LabelContext
PredContext Bool -> Bool -> Bool
&& RDFLabel
lab RDFLabel -> [RDFLabel] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [RDFLabel]
nb1
then LabelContext -> RDFLabel -> Formatter Builder
insertBnode LabelContext
lctxt RDFLabel
lab
else RDFLabel -> Formatter Builder
formatNodeId RDFLabel
lab
formatLabel _ lab :: RDFLabel
lab@(Res sn :: ScopedName
sn) =
case ScopedName -> [(ScopedName, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ScopedName
sn [(ScopedName, String)]
specialTable of
Just txt :: String
txt -> Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Builder
quoteB Bool
True String
txt
Nothing -> do
NamespaceMap
pr <- (N3FormatterState -> NamespaceMap)
-> StateT N3FormatterState Identity NamespaceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets N3FormatterState -> NamespaceMap
prefixes
RDFLabel -> Formatter ()
queueFormula RDFLabel
lab
Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ ScopedName -> NamespaceMap -> Builder
formatScopedName ScopedName
sn NamespaceMap
pr
formatLabel _ (Lit lit :: Text
lit) = Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ Text -> Builder
formatPlainLit Text
lit
formatLabel _ (LangLit lit :: Text
lit lcode :: LanguageTag
lcode) = Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ Text -> LanguageTag -> Builder
formatLangLit Text
lit LanguageTag
lcode
formatLabel _ (TypedLit lit :: Text
lit dtype :: ScopedName
dtype) = Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> ScopedName -> Builder
formatTypedLit Bool
True Text
lit ScopedName
dtype
formatLabel _ lab :: RDFLabel
lab = Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ String -> Builder
B.fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ RDFLabel -> String
forall a. Show a => a -> String
show RDFLabel
lab
formatNodeId :: RDFLabel -> Formatter B.Builder
formatNodeId :: RDFLabel -> Formatter Builder
formatNodeId lab :: RDFLabel
lab@(Blank (lnc :: Char
lnc:_)) =
if Char -> Bool
isDigit Char
lnc then RDFLabel -> Formatter Builder
mapBlankNode RDFLabel
lab else Builder -> Formatter Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Formatter Builder) -> Builder -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ String -> Builder
B.fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ RDFLabel -> String
forall a. Show a => a -> String
show RDFLabel
lab
formatNodeId other :: RDFLabel
other = String -> Formatter Builder
forall a. HasCallStack => String -> a
error (String -> Formatter Builder) -> String -> Formatter Builder
forall a b. (a -> b) -> a -> b
$ "formatNodeId not expecting a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RDFLabel -> String
forall a. Show a => a -> String
show RDFLabel
other
mapBlankNode :: RDFLabel -> Formatter B.Builder
mapBlankNode :: RDFLabel -> Formatter Builder
mapBlankNode = SL NodeGenState -> RDFLabel -> Formatter Builder
forall a. SLens a NodeGenState -> RDFLabel -> State a Builder
mapBlankNode_ SL NodeGenState
_nodeGen