{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Swish.RDF.Formatter.Turtle
( NodeGenLookupMap
, formatGraphAsText
, formatGraphAsLazyText
, formatGraphAsBuilder
, formatGraphIndent
, formatGraphDiag
)
where
import Swish.RDF.Formatter.Internal (NodeGenLookupMap, SubjTree, PredTree
, SLens(..)
, LabelContext(..)
, NodeGenState(..)
, changeState
, hasMore
, emptyNgs
, findMaxBnode
, processArcs
, formatScopedName
, formatPlainLit
, formatLangLit
, formatTypedLit
, insertList
, nextLine_
, mapBlankNode_
, formatPrefixes_
, formatGraph_
, formatSubjects_
, formatProperties_
, formatObjects_
, insertBnode_
, extractList_
)
import Swish.RDF.Graph (
RDFGraph, RDFLabel(..)
, NamespaceMap
, emptyNamespaceMap
, getNamespaces
, emptyRDFGraph
)
import Swish.RDF.Vocabulary (rdfType, rdfNil)
#if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 808)
import Control.Applicative ((<$>))
#endif
import Control.Monad.State (State, modify, gets, runState)
import Data.Char (isDigit)
import Data.List (uncons)
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 TurtleFormatterState = TFS
{ TurtleFormatterState -> Builder
indent :: B.Builder
, TurtleFormatterState -> Bool
lineBreak :: Bool
, TurtleFormatterState -> RDFGraph
graph :: RDFGraph
, TurtleFormatterState -> SubjTree RDFLabel
subjs :: SubjTree RDFLabel
, TurtleFormatterState -> PredTree RDFLabel
props :: PredTree RDFLabel
, TurtleFormatterState -> [RDFLabel]
objs :: [RDFLabel]
, TurtleFormatterState -> NamespaceMap
prefixes :: NamespaceMap
, TurtleFormatterState -> NodeGenState
nodeGenSt :: NodeGenState
, TurtleFormatterState -> [RDFLabel]
bNodesCheck :: [RDFLabel]
, TurtleFormatterState -> [[Char]]
traceBuf :: [String]
}
type SL a = SLens TurtleFormatterState a
_lineBreak :: SL Bool
_lineBreak :: SL Bool
_lineBreak = forall a b. (a -> b) -> (a -> b -> a) -> SLens a b
SLens TurtleFormatterState -> Bool
lineBreak forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
a Bool
b -> TurtleFormatterState
a { lineBreak :: Bool
lineBreak = Bool
b }
_nodeGen :: SL NodeGenState
_nodeGen :: SL NodeGenState
_nodeGen = forall a b. (a -> b) -> (a -> b -> a) -> SLens a b
SLens TurtleFormatterState -> NodeGenState
nodeGenSt forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
a NodeGenState
b -> TurtleFormatterState
a { nodeGenSt :: NodeGenState
nodeGenSt = NodeGenState
b }
type Formatter a = State TurtleFormatterState a
updateState ::
TurtleFormatterState
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> TurtleFormatterState
updateState :: TurtleFormatterState
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> TurtleFormatterState
updateState TurtleFormatterState
ost SubjTree RDFLabel
nsubjs PredTree RDFLabel
nprops [RDFLabel]
nobjs = TurtleFormatterState
ost { subjs :: SubjTree RDFLabel
subjs = SubjTree RDFLabel
nsubjs, props :: PredTree RDFLabel
props = PredTree RDFLabel
nprops, objs :: [RDFLabel]
objs = [RDFLabel]
nobjs }
emptyTFS :: NodeGenState -> TurtleFormatterState
emptyTFS :: NodeGenState -> TurtleFormatterState
emptyTFS NodeGenState
ngs = TFS
{ indent :: Builder
indent = Builder
"\n"
, lineBreak :: Bool
lineBreak = Bool
False
, graph :: RDFGraph
graph = RDFGraph
emptyRDFGraph
, subjs :: SubjTree RDFLabel
subjs = []
, props :: PredTree RDFLabel
props = []
, objs :: [RDFLabel]
objs = []
, prefixes :: NamespaceMap
prefixes = NamespaceMap
emptyNamespaceMap
, nodeGenSt :: NodeGenState
nodeGenSt = NodeGenState
ngs
, bNodesCheck :: [RDFLabel]
bNodesCheck = []
, traceBuf :: [[Char]]
traceBuf = []
}
setIndent :: B.Builder -> Formatter ()
setIndent :: Builder -> Formatter ()
setIndent Builder
ind = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st -> TurtleFormatterState
st { indent :: Builder
indent = Builder
ind }
setLineBreak :: Bool -> Formatter ()
setLineBreak :: Bool -> Formatter ()
setLineBreak Bool
brk = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st -> TurtleFormatterState
st { lineBreak :: Bool
lineBreak = Bool
brk }
setSubjs :: SubjTree RDFLabel -> Formatter ()
setSubjs :: SubjTree RDFLabel -> Formatter ()
setSubjs SubjTree RDFLabel
sl = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st -> TurtleFormatterState
st { subjs :: SubjTree RDFLabel
subjs = SubjTree RDFLabel
sl }
setProps :: PredTree RDFLabel -> Formatter ()
setProps :: PredTree RDFLabel -> Formatter ()
setProps PredTree RDFLabel
ps = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st -> TurtleFormatterState
st { props :: PredTree RDFLabel
props = PredTree RDFLabel
ps }
extractList :: 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_ TurtleFormatterState -> SubjTree RDFLabel
subjs TurtleFormatterState -> PredTree RDFLabel
props SubjTree RDFLabel -> Formatter ()
setSubjs PredTree RDFLabel -> Formatter ()
setProps
formatGraphAsText :: RDFGraph -> T.Text
formatGraphAsText :: RDFGraph -> Text
formatGraphAsText = Text -> Text
L.toStrict 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 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 Builder
"\n" Bool
True
formatGraphIndent ::
B.Builder
-> Bool
-> RDFGraph
-> B.Builder
formatGraphIndent :: Builder -> Bool -> RDFGraph -> Builder
formatGraphIndent Builder
indnt Bool
flag RDFGraph
gr =
let (Builder
res, NodeGenLookupMap
_, Word32
_, [[Char]]
_) = Builder
-> Bool
-> RDFGraph
-> (Builder, NodeGenLookupMap, Word32, [[Char]])
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, [[Char]])
formatGraphDiag Builder
indnt Bool
flag RDFGraph
gr =
let fg :: Formatter Builder
fg = Builder -> Builder -> Bool -> Bool -> RDFGraph -> Formatter Builder
formatGraph Builder
indnt Builder
" .\n" Bool
False Bool
flag RDFGraph
gr
ngs :: NodeGenState
ngs = NodeGenState
emptyNgs { nodeGen :: Word32
nodeGen = RDFGraph -> Word32
findMaxBnode RDFGraph
gr }
(Builder
out, TurtleFormatterState
fgs) = forall s a. State s a -> s -> (a, s)
runState Formatter Builder
fg (NodeGenState -> TurtleFormatterState
emptyTFS NodeGenState
ngs)
ogs :: NodeGenState
ogs = TurtleFormatterState -> NodeGenState
nodeGenSt TurtleFormatterState
fgs
in (Builder
out, NodeGenState -> NodeGenLookupMap
nodeMap NodeGenState
ogs, NodeGenState -> Word32
nodeGen NodeGenState
ogs, TurtleFormatterState -> [[Char]]
traceBuf TurtleFormatterState
fgs)
formatGraph ::
B.Builder
-> B.Builder
-> Bool
-> Bool
-> RDFGraph
-> Formatter B.Builder
formatGraph :: Builder -> Builder -> Bool -> Bool -> RDFGraph -> Formatter Builder
formatGraph = 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 -> TurtleFormatterState -> TurtleFormatterState
newState NamespaceMap -> Formatter Builder
formatPrefixes TurtleFormatterState -> SubjTree RDFLabel
subjs Formatter Builder
formatSubjects
formatPrefixes :: NamespaceMap -> Formatter B.Builder
formatPrefixes :: NamespaceMap -> Formatter Builder
formatPrefixes = forall a.
(Builder -> State a Builder) -> NamespaceMap -> State a Builder
formatPrefixes_ Builder -> Formatter Builder
nextLine
formatSubjects :: Formatter B.Builder
formatSubjects :: Formatter Builder
formatSubjects = 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_ Formatter RDFLabel
nextSubject LabelContext -> RDFLabel -> Formatter Builder
formatLabel TurtleFormatterState -> PredTree RDFLabel
props RDFLabel -> Builder -> Formatter Builder
formatProperties TurtleFormatterState -> SubjTree RDFLabel
subjs Builder -> Formatter Builder
nextLine
formatProperties :: RDFLabel -> B.Builder -> Formatter B.Builder
formatProperties :: RDFLabel -> Builder -> Formatter Builder
formatProperties = 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 -> Formatter RDFLabel
nextProperty LabelContext -> RDFLabel -> Formatter Builder
formatLabel RDFLabel -> RDFLabel -> Builder -> Formatter Builder
formatObjects TurtleFormatterState -> PredTree RDFLabel
props Builder -> Formatter Builder
nextLine
formatObjects :: RDFLabel -> RDFLabel -> B.Builder -> Formatter B.Builder
formatObjects :: RDFLabel -> RDFLabel -> Builder -> Formatter 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 -> Formatter RDFLabel
nextObject LabelContext -> RDFLabel -> Formatter Builder
formatLabel TurtleFormatterState -> [RDFLabel]
objs Builder -> Formatter Builder
nextLine
insertBnode :: LabelContext -> RDFLabel -> Formatter B.Builder
insertBnode :: LabelContext -> RDFLabel -> Formatter Builder
insertBnode LabelContext
SubjContext RDFLabel
lbl = do
Bool
flag <- forall a b. (a -> [b]) -> State a Bool
hasMore TurtleFormatterState -> PredTree RDFLabel
props
if Bool
flag
then do
Builder
txt <- (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 -> Formatter Builder
formatProperties RDFLabel
lbl Builder
""
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]
else forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Internal error: expected properties with label: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show RDFLabel
lbl
insertBnode LabelContext
_ RDFLabel
lbl = 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_ TurtleFormatterState -> SubjTree RDFLabel
subjs TurtleFormatterState -> PredTree RDFLabel
props TurtleFormatterState -> [RDFLabel]
objs TurtleFormatterState
-> SubjTree RDFLabel
-> PredTree RDFLabel
-> [RDFLabel]
-> TurtleFormatterState
updateState RDFLabel -> Builder -> Formatter Builder
formatProperties RDFLabel
lbl
newState :: RDFGraph -> TurtleFormatterState -> TurtleFormatterState
newState :: RDFGraph -> TurtleFormatterState -> TurtleFormatterState
newState RDFGraph
gr TurtleFormatterState
st =
let pre' :: NamespaceMap
pre' = TurtleFormatterState -> NamespaceMap
prefixes TurtleFormatterState
st forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` forall lb. NSGraph lb -> NamespaceMap
getNamespaces RDFGraph
gr
(SubjTree RDFLabel
arcSubjs, [RDFLabel]
bNodes) = RDFGraph -> (SubjTree RDFLabel, [RDFLabel])
processArcs RDFGraph
gr
in TurtleFormatterState
st { graph :: RDFGraph
graph = RDFGraph
gr
, subjs :: SubjTree RDFLabel
subjs = SubjTree RDFLabel
arcSubjs
, props :: PredTree RDFLabel
props = []
, objs :: [RDFLabel]
objs = []
, prefixes :: NamespaceMap
prefixes = NamespaceMap
pre'
, bNodesCheck :: [RDFLabel]
bNodesCheck = [RDFLabel]
bNodes
}
getNext :: [a] -> (a, [a])
getNext :: forall a. [a] -> (a, [a])
getNext [a]
xs = case forall a. [a] -> Maybe (a, [a])
uncons [a]
xs of
Just (a
a, [a]
as) -> (a
a, [a]
as)
Maybe (a, [a])
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invariant broken: list is empty"
nextSubject :: Formatter RDFLabel
nextSubject :: Formatter RDFLabel
nextSubject =
forall a b. (a -> (b, a)) -> State a b
changeState forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st ->
let ((RDFLabel
a,PredTree RDFLabel
b), SubjTree RDFLabel
sbs) = forall a. [a] -> (a, [a])
getNext (TurtleFormatterState -> SubjTree RDFLabel
subjs TurtleFormatterState
st)
nst :: TurtleFormatterState
nst = TurtleFormatterState
st { subjs :: SubjTree RDFLabel
subjs = SubjTree RDFLabel
sbs
, props :: PredTree RDFLabel
props = PredTree RDFLabel
b
, objs :: [RDFLabel]
objs = []
}
in (RDFLabel
a, TurtleFormatterState
nst)
nextProperty :: RDFLabel -> Formatter RDFLabel
nextProperty :: RDFLabel -> Formatter RDFLabel
nextProperty RDFLabel
_ =
forall a b. (a -> (b, a)) -> State a b
changeState forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st ->
let ((RDFLabel
a,[RDFLabel]
b), PredTree RDFLabel
prs) = forall a. [a] -> (a, [a])
getNext (TurtleFormatterState -> PredTree RDFLabel
props TurtleFormatterState
st)
nst :: TurtleFormatterState
nst = TurtleFormatterState
st { props :: PredTree RDFLabel
props = PredTree RDFLabel
prs
, objs :: [RDFLabel]
objs = [RDFLabel]
b
}
in (RDFLabel
a, TurtleFormatterState
nst)
nextObject :: RDFLabel -> RDFLabel -> Formatter RDFLabel
nextObject :: RDFLabel -> RDFLabel -> Formatter RDFLabel
nextObject RDFLabel
_ RDFLabel
_ =
forall a b. (a -> (b, a)) -> State a b
changeState forall a b. (a -> b) -> a -> b
$ \TurtleFormatterState
st ->
let (RDFLabel
ob, [RDFLabel]
obs) = forall a. [a] -> (a, [a])
getNext (TurtleFormatterState -> [RDFLabel]
objs TurtleFormatterState
st)
nst :: TurtleFormatterState
nst = TurtleFormatterState
st { objs :: [RDFLabel]
objs = [RDFLabel]
obs }
in (RDFLabel
ob, TurtleFormatterState
nst)
nextLine :: B.Builder -> Formatter B.Builder
nextLine :: Builder -> Formatter Builder
nextLine = forall a.
(a -> Builder) -> SLens a Bool -> Builder -> State a Builder
nextLine_ TurtleFormatterState -> Builder
indent SL Bool
_lineBreak
formatLabel :: LabelContext -> RDFLabel -> Formatter B.Builder
formatLabel :: LabelContext -> RDFLabel -> Formatter Builder
formatLabel LabelContext
lctxt lab :: RDFLabel
lab@(Blank (Char
_:[Char]
_)) = do
Maybe [RDFLabel]
mlst <- LabelContext -> RDFLabel -> Formatter (Maybe [RDFLabel])
extractList LabelContext
lctxt RDFLabel
lab
case Maybe [RDFLabel]
mlst of
Just [RDFLabel]
lst -> forall a.
(RDFLabel -> State a Builder) -> [RDFLabel] -> State a Builder
insertList (LabelContext -> RDFLabel -> Formatter Builder
formatLabel LabelContext
ObjContext) [RDFLabel]
lst
Maybe [RDFLabel]
Nothing -> do
[RDFLabel]
nb1 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TurtleFormatterState -> [RDFLabel]
bNodesCheck
if LabelContext
lctxt forall a. Eq a => a -> a -> Bool
/= LabelContext
PredContext Bool -> Bool -> Bool
&& RDFLabel
lab forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [RDFLabel]
nb1
then LabelContext -> RDFLabel -> Formatter Builder
insertBnode LabelContext
lctxt RDFLabel
lab
else RDFLabel -> Formatter Builder
formatNodeId RDFLabel
lab
formatLabel LabelContext
ctxt (Res ScopedName
sn)
| LabelContext
ctxt forall a. Eq a => a -> a -> Bool
== LabelContext
PredContext Bool -> Bool -> Bool
&& ScopedName
sn forall a. Eq a => a -> a -> Bool
== ScopedName
rdfType = forall (m :: * -> *) a. Monad m => a -> m a
return Builder
"a"
| LabelContext
ctxt forall a. Eq a => a -> a -> Bool
== LabelContext
ObjContext Bool -> Bool -> Bool
&& ScopedName
sn forall a. Eq a => a -> a -> Bool
== ScopedName
rdfNil = forall (m :: * -> *) a. Monad m => a -> m a
return Builder
"()"
| Bool
otherwise = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (ScopedName -> NamespaceMap -> Builder
formatScopedName ScopedName
sn forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtleFormatterState -> NamespaceMap
prefixes)
formatLabel LabelContext
_ (Lit Text
lit) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Builder
formatPlainLit Text
lit
formatLabel LabelContext
_ (LangLit Text
lit LanguageTag
lcode) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> LanguageTag -> Builder
formatLangLit Text
lit LanguageTag
lcode
formatLabel LabelContext
_ (TypedLit Text
lit ScopedName
dtype) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Text -> ScopedName -> Builder
formatTypedLit Bool
False Text
lit ScopedName
dtype
formatLabel LabelContext
_ RDFLabel
lab = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Builder
B.fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show RDFLabel
lab
formatNodeId :: RDFLabel -> Formatter B.Builder
formatNodeId :: RDFLabel -> Formatter Builder
formatNodeId lab :: RDFLabel
lab@(Blank (Char
lnc:[Char]
_)) =
if Char -> Bool
isDigit Char
lnc then RDFLabel -> Formatter Builder
mapBlankNode RDFLabel
lab else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Builder
B.fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show RDFLabel
lab
formatNodeId RDFLabel
other = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"formatNodeId not expecting a " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show RDFLabel
other
mapBlankNode :: RDFLabel -> Formatter B.Builder
mapBlankNode :: RDFLabel -> Formatter Builder
mapBlankNode = forall a. SLens a NodeGenState -> RDFLabel -> State a Builder
mapBlankNode_ SL NodeGenState
_nodeGen