module Swish.RDF.SwishMonad
( SwishStateIO, SwishState(..), SwishStatus(..)
, setFormat, setBase, setGraph
, modGraphs, findGraph, findFormula
, modRules, findRule
, modRulesets, findRuleset
, findOpenVarModify, findDatatype
, setInfo, resetInfo, setError, resetError
, setStatus
, emptyState
, SwishFormat(..)
, NamedGraph(..), NamedGraphMap
, swishError
, reportLines, reportLine
)
where
import Swish.RDF.RDFGraph
( RDFGraph, emptyRDFGraph )
import Swish.RDF.RDFRuleset
( RDFFormula, RDFRule, RDFRuleMap, RDFRuleset, RDFRulesetMap )
import Swish.RDF.RDFDatatype
( RDFDatatype )
import Swish.RDF.RDFVarBinding
( RDFOpenVarBindingModify
)
import Swish.RDF.BuiltInMap
( findRDFOpenVarBindingModifier
, findRDFDatatype
, rdfRulesetMap
)
import Swish.RDF.Ruleset
( getMaybeContextAxiom
, getMaybeContextRule
)
import Swish.RDF.Rule
( Formula(..)
)
import Swish.Utils.Namespace (ScopedName(..))
import Swish.Utils.QName (QName)
import Swish.Utils.LookupMap
( LookupEntryClass(..), LookupMap(..)
, emptyLookupMap
, mapFindMaybe
, mapVals
)
import Control.Monad.Trans (MonadTrans(..))
import Control.Monad.State (StateT(..), modify)
import System.IO (hPutStrLn, stderr)
data SwishFormat =
N3
| NT
deriving Eq
instance Show SwishFormat where
show N3 = "N3"
show NT = "Ntriples"
data SwishState = SwishState
{ format :: SwishFormat
, base :: Maybe QName
, graph :: RDFGraph
, graphs :: NamedGraphMap
, rules :: RDFRuleMap
, rulesets :: RDFRulesetMap
, infomsg :: Maybe String
, errormsg :: Maybe String
, exitcode :: SwishStatus
}
data SwishStatus =
SwishSuccess
| SwishGraphCompareError
| SwishDataInputError
| SwishDataAccessError
| SwishArgumentError
| SwishExecutionError
deriving (Eq, Enum)
instance Show SwishStatus where
show SwishSuccess = "Success."
show SwishGraphCompareError = "The graphs do not compare as equal."
show SwishDataInputError = "There was a format or syntax error in the input data."
show SwishDataAccessError = "There was a problem accessing data."
show SwishArgumentError = "Argument error: use -h or -? for help."
show SwishExecutionError = "There was a problem executing a Swish script."
type SwishStateIO a = StateT SwishState IO a
emptyState :: SwishState
emptyState = SwishState
{ format = N3
, base = Nothing
, graph = emptyRDFGraph
, graphs = emptyLookupMap
, rules = emptyLookupMap
, rulesets = rdfRulesetMap
, infomsg = Nothing
, errormsg = Nothing
, exitcode = SwishSuccess
}
setFormat :: SwishFormat -> SwishState -> SwishState
setFormat fm state = state { format = fm }
setBase :: Maybe QName -> SwishState -> SwishState
setBase bs state = state { base = bs }
setGraph :: RDFGraph -> SwishState -> SwishState
setGraph gr state = state { graph = gr }
modGraphs ::
( NamedGraphMap -> NamedGraphMap ) -> SwishState -> SwishState
modGraphs grmod state = state { graphs = grmod (graphs state) }
findGraph :: ScopedName -> SwishState -> Maybe [RDFGraph]
findGraph nam state = mapFindMaybe nam (graphs state)
findFormula :: ScopedName -> SwishState -> Maybe RDFFormula
findFormula nam state = case findGraph nam state of
Nothing -> getMaybeContextAxiom nam (mapVals $ rulesets state)
Just [] -> Just $ Formula nam emptyRDFGraph
Just grs -> Just $ Formula nam (head grs)
modRules ::
( RDFRuleMap -> RDFRuleMap ) -> SwishState -> SwishState
modRules rlmod state = state { rules = rlmod (rules state) }
findRule :: ScopedName -> SwishState -> Maybe RDFRule
findRule nam state =
let
localrule = mapFindMaybe nam (rules state)
contextrule = getMaybeContextRule nam $ mapVals $ rulesets state
in
case localrule of
Nothing -> contextrule
justlr -> justlr
modRulesets ::
( RDFRulesetMap -> RDFRulesetMap ) -> SwishState -> SwishState
modRulesets rsmod state = state { rulesets = rsmod (rulesets state) }
findRuleset ::
ScopedName -> SwishState -> Maybe RDFRuleset
findRuleset nam state = mapFindMaybe (snScope nam) (rulesets state)
findOpenVarModify :: ScopedName -> SwishState -> Maybe RDFOpenVarBindingModify
findOpenVarModify nam _ = findRDFOpenVarBindingModifier nam
findDatatype :: ScopedName -> SwishState -> Maybe RDFDatatype
findDatatype nam _ = findRDFDatatype nam
setInfo :: String -> SwishState -> SwishState
setInfo msg state = state { infomsg = Just msg }
resetInfo :: SwishState -> SwishState
resetInfo state = state { infomsg = Nothing }
setError :: String -> SwishState -> SwishState
setError msg state = state { errormsg = Just msg }
resetError :: SwishState -> SwishState
resetError state = state { errormsg = Nothing }
setStatus :: SwishStatus -> SwishState -> SwishState
setStatus ec state = state { exitcode = ec }
data NamedGraph = NamedGraph
{ ngName :: ScopedName
, ngGraph :: [RDFGraph]
}
instance LookupEntryClass NamedGraph ScopedName [RDFGraph]
where
keyVal (NamedGraph k v) = (k,v)
newEntry (k,v) = NamedGraph k v
type NamedGraphMap = LookupMap NamedGraph
swishError :: String -> SwishStatus -> SwishStateIO ()
swishError msg sts = do
reportLines [msg, show sts ++ "\n"]
modify $ setStatus sts
reportLines :: [String] -> SwishStateIO ()
reportLines = mapM_ reportLine
reportLine :: String -> SwishStateIO ()
reportLine line =
lift $ hPutStrLn stderr line