module Swish.Monad
( SwishStateIO, SwishState(..), SwishStatus(..)
, SwishFormat(..)
, NamedGraphMap
, emptyState
, setFormat, setBase, setGraph
, modGraphs, findGraph, findFormula
, modRules, findRule
, modRulesets, findRuleset
, findOpenVarModify, findDatatype
, setInfo, resetInfo, setError, resetError
, setStatus
, swishError
, reportLine
)
where
import Swish.Namespace (ScopedName, getScopeNamespace)
import Swish.QName (QName)
import Swish.Ruleset (getMaybeContextAxiom, getMaybeContextRule)
import Swish.Rule(Formula(..))
import Swish.RDF.Datatype (RDFDatatype)
import Swish.RDF.Graph (RDFGraph, emptyRDFGraph)
import Swish.RDF.Ruleset (RDFFormula, RDFRule, RDFRuleMap, RDFRuleset, RDFRulesetMap)
import Swish.RDF.VarBinding (RDFOpenVarBindingModify)
import Swish.RDF.BuiltIn (findRDFOpenVarBindingModifier, findRDFDatatype, rdfRulesetMap)
import Control.Monad.Trans (MonadTrans(..))
import Control.Monad.State (StateT(..), modify)
import Data.List (nub)
import System.IO (hPutStrLn, stderr)
import qualified Data.Map as M
data SwishFormat =
Turtle
| N3
| NT
deriving Eq
instance Show SwishFormat where
show N3 = "N3"
show NT = "Ntriples"
show Turtle = "Turtle"
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 = M.empty
, rules = M.empty
, 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 = M.lookup nam (graphs state)
findFormula :: ScopedName -> SwishState -> Maybe RDFFormula
findFormula nam state = case findGraph nam state of
Nothing -> getMaybeContextAxiom nam (nub $ M.elems $ 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 =
case M.lookup nam (rules state) of
Nothing -> getMaybeContextRule nam $ nub $ M.elems $ rulesets state
justlr -> justlr
modRulesets ::
( RDFRulesetMap -> RDFRulesetMap ) -> SwishState -> SwishState
modRulesets rsmod state = state { rulesets = rsmod (rulesets state) }
findRuleset ::
ScopedName -> SwishState -> Maybe RDFRuleset
findRuleset nam state = M.lookup (getScopeNamespace 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 }
type NamedGraphMap = M.Map ScopedName [RDFGraph]
swishError :: String -> SwishStatus -> SwishStateIO ()
swishError msg sts = do
mapM_ reportLine [msg, show sts ++ "\n"]
modify $ setStatus sts
reportLine :: String -> SwishStateIO ()
reportLine = lift . hPutStrLn stderr