{-# LANGUAGE CPP #-}
#if (__GLASGOW_HASKELL__ >= 802)
{-# LANGUAGE DerivingStrategies #-}
#endif
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
#if (__GLASGOW_HASKELL__ >= 802)
stock
#endif
SwishFormat -> SwishFormat -> Bool
(SwishFormat -> SwishFormat -> Bool)
-> (SwishFormat -> SwishFormat -> Bool) -> Eq SwishFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwishFormat -> SwishFormat -> Bool
== :: SwishFormat -> SwishFormat -> Bool
$c/= :: SwishFormat -> SwishFormat -> Bool
/= :: SwishFormat -> SwishFormat -> Bool
Eq
instance Show SwishFormat where
show :: SwishFormat -> String
show SwishFormat
N3 = String
"N3"
show SwishFormat
NT = String
"Ntriples"
show SwishFormat
Turtle = String
"Turtle"
data SwishState = SwishState
{ SwishState -> SwishFormat
format :: SwishFormat
, SwishState -> Maybe QName
base :: Maybe QName
, SwishState -> RDFGraph
graph :: RDFGraph
, SwishState -> NamedGraphMap
graphs :: NamedGraphMap
, SwishState -> RDFRuleMap
rules :: RDFRuleMap
, SwishState -> RDFRulesetMap
rulesets :: RDFRulesetMap
, SwishState -> Maybe String
infomsg :: Maybe String
, SwishState -> Maybe String
errormsg :: Maybe String
, SwishState -> SwishStatus
exitcode :: SwishStatus
}
data SwishStatus =
SwishSuccess
| SwishGraphCompareError
| SwishDataInputError
| SwishDataAccessError
| SwishArgumentError
| SwishExecutionError
deriving
#if (__GLASGOW_HASKELL__ >= 802)
stock
#endif
(SwishStatus -> SwishStatus -> Bool
(SwishStatus -> SwishStatus -> Bool)
-> (SwishStatus -> SwishStatus -> Bool) -> Eq SwishStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwishStatus -> SwishStatus -> Bool
== :: SwishStatus -> SwishStatus -> Bool
$c/= :: SwishStatus -> SwishStatus -> Bool
/= :: SwishStatus -> SwishStatus -> Bool
Eq, Int -> SwishStatus
SwishStatus -> Int
SwishStatus -> [SwishStatus]
SwishStatus -> SwishStatus
SwishStatus -> SwishStatus -> [SwishStatus]
SwishStatus -> SwishStatus -> SwishStatus -> [SwishStatus]
(SwishStatus -> SwishStatus)
-> (SwishStatus -> SwishStatus)
-> (Int -> SwishStatus)
-> (SwishStatus -> Int)
-> (SwishStatus -> [SwishStatus])
-> (SwishStatus -> SwishStatus -> [SwishStatus])
-> (SwishStatus -> SwishStatus -> [SwishStatus])
-> (SwishStatus -> SwishStatus -> SwishStatus -> [SwishStatus])
-> Enum SwishStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SwishStatus -> SwishStatus
succ :: SwishStatus -> SwishStatus
$cpred :: SwishStatus -> SwishStatus
pred :: SwishStatus -> SwishStatus
$ctoEnum :: Int -> SwishStatus
toEnum :: Int -> SwishStatus
$cfromEnum :: SwishStatus -> Int
fromEnum :: SwishStatus -> Int
$cenumFrom :: SwishStatus -> [SwishStatus]
enumFrom :: SwishStatus -> [SwishStatus]
$cenumFromThen :: SwishStatus -> SwishStatus -> [SwishStatus]
enumFromThen :: SwishStatus -> SwishStatus -> [SwishStatus]
$cenumFromTo :: SwishStatus -> SwishStatus -> [SwishStatus]
enumFromTo :: SwishStatus -> SwishStatus -> [SwishStatus]
$cenumFromThenTo :: SwishStatus -> SwishStatus -> SwishStatus -> [SwishStatus]
enumFromThenTo :: SwishStatus -> SwishStatus -> SwishStatus -> [SwishStatus]
Enum)
instance Show SwishStatus where
show :: SwishStatus -> String
show SwishStatus
SwishSuccess = String
"Success."
show SwishStatus
SwishGraphCompareError = String
"The graphs do not compare as equal."
show SwishStatus
SwishDataInputError = String
"There was a format or syntax error in the input data."
show SwishStatus
SwishDataAccessError = String
"There was a problem accessing data."
show SwishStatus
SwishArgumentError = String
"Argument error: use -h or -? for help."
show SwishStatus
SwishExecutionError = String
"There was a problem executing a Swish script."
type SwishStateIO a = StateT SwishState IO a
emptyState :: SwishState
emptyState :: SwishState
emptyState = SwishState
{ format :: SwishFormat
format = SwishFormat
N3
, base :: Maybe QName
base = Maybe QName
forall a. Maybe a
Nothing
, graph :: RDFGraph
graph = RDFGraph
emptyRDFGraph
, graphs :: NamedGraphMap
graphs = NamedGraphMap
forall k a. Map k a
M.empty
, rules :: RDFRuleMap
rules = RDFRuleMap
forall k a. Map k a
M.empty
, rulesets :: RDFRulesetMap
rulesets = RDFRulesetMap
rdfRulesetMap
, infomsg :: Maybe String
infomsg = Maybe String
forall a. Maybe a
Nothing
, errormsg :: Maybe String
errormsg = Maybe String
forall a. Maybe a
Nothing
, exitcode :: SwishStatus
exitcode = SwishStatus
SwishSuccess
}
setFormat :: SwishFormat -> SwishState -> SwishState
setFormat :: SwishFormat -> SwishState -> SwishState
setFormat SwishFormat
fm SwishState
state = SwishState
state { format = fm }
setBase :: Maybe QName -> SwishState -> SwishState
setBase :: Maybe QName -> SwishState -> SwishState
setBase Maybe QName
bs SwishState
state = SwishState
state { base = bs }
setGraph :: RDFGraph -> SwishState -> SwishState
setGraph :: RDFGraph -> SwishState -> SwishState
setGraph RDFGraph
gr SwishState
state = SwishState
state { graph = gr }
modGraphs ::
( NamedGraphMap -> NamedGraphMap ) -> SwishState -> SwishState
modGraphs :: (NamedGraphMap -> NamedGraphMap) -> SwishState -> SwishState
modGraphs NamedGraphMap -> NamedGraphMap
grmod SwishState
state = SwishState
state { graphs = grmod (graphs state) }
findGraph :: ScopedName -> SwishState -> Maybe [RDFGraph]
findGraph :: ScopedName -> SwishState -> Maybe [RDFGraph]
findGraph ScopedName
nam SwishState
state = ScopedName -> NamedGraphMap -> Maybe [RDFGraph]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ScopedName
nam (SwishState -> NamedGraphMap
graphs SwishState
state)
findFormula :: ScopedName -> SwishState -> Maybe RDFFormula
findFormula :: ScopedName -> SwishState -> Maybe RDFFormula
findFormula ScopedName
nam SwishState
state = case ScopedName -> SwishState -> Maybe [RDFGraph]
findGraph ScopedName
nam SwishState
state of
Maybe [RDFGraph]
Nothing -> ScopedName -> [Ruleset RDFGraph] -> Maybe RDFFormula
forall ex. ScopedName -> [Ruleset ex] -> Maybe (Formula ex)
getMaybeContextAxiom ScopedName
nam ([Ruleset RDFGraph] -> [Ruleset RDFGraph]
forall a. Eq a => [a] -> [a]
nub ([Ruleset RDFGraph] -> [Ruleset RDFGraph])
-> [Ruleset RDFGraph] -> [Ruleset RDFGraph]
forall a b. (a -> b) -> a -> b
$ RDFRulesetMap -> [Ruleset RDFGraph]
forall k a. Map k a -> [a]
M.elems (RDFRulesetMap -> [Ruleset RDFGraph])
-> RDFRulesetMap -> [Ruleset RDFGraph]
forall a b. (a -> b) -> a -> b
$ SwishState -> RDFRulesetMap
rulesets SwishState
state)
Just [] -> RDFFormula -> Maybe RDFFormula
forall a. a -> Maybe a
Just (RDFFormula -> Maybe RDFFormula) -> RDFFormula -> Maybe RDFFormula
forall a b. (a -> b) -> a -> b
$ ScopedName -> RDFGraph -> RDFFormula
forall ex. ScopedName -> ex -> Formula ex
Formula ScopedName
nam RDFGraph
emptyRDFGraph
Just (RDFGraph
gr:[RDFGraph]
_) -> RDFFormula -> Maybe RDFFormula
forall a. a -> Maybe a
Just (RDFFormula -> Maybe RDFFormula) -> RDFFormula -> Maybe RDFFormula
forall a b. (a -> b) -> a -> b
$ ScopedName -> RDFGraph -> RDFFormula
forall ex. ScopedName -> ex -> Formula ex
Formula ScopedName
nam RDFGraph
gr
modRules ::
( RDFRuleMap -> RDFRuleMap ) -> SwishState -> SwishState
modRules :: (RDFRuleMap -> RDFRuleMap) -> SwishState -> SwishState
modRules RDFRuleMap -> RDFRuleMap
rlmod SwishState
state = SwishState
state { rules = rlmod (rules state) }
findRule :: ScopedName -> SwishState -> Maybe RDFRule
findRule :: ScopedName -> SwishState -> Maybe RDFRule
findRule ScopedName
nam SwishState
state =
case ScopedName -> RDFRuleMap -> Maybe RDFRule
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ScopedName
nam (SwishState -> RDFRuleMap
rules SwishState
state) of
Maybe RDFRule
Nothing -> ScopedName -> [Ruleset RDFGraph] -> Maybe RDFRule
forall ex. ScopedName -> [Ruleset ex] -> Maybe (Rule ex)
getMaybeContextRule ScopedName
nam ([Ruleset RDFGraph] -> Maybe RDFRule)
-> [Ruleset RDFGraph] -> Maybe RDFRule
forall a b. (a -> b) -> a -> b
$ [Ruleset RDFGraph] -> [Ruleset RDFGraph]
forall a. Eq a => [a] -> [a]
nub ([Ruleset RDFGraph] -> [Ruleset RDFGraph])
-> [Ruleset RDFGraph] -> [Ruleset RDFGraph]
forall a b. (a -> b) -> a -> b
$ RDFRulesetMap -> [Ruleset RDFGraph]
forall k a. Map k a -> [a]
M.elems (RDFRulesetMap -> [Ruleset RDFGraph])
-> RDFRulesetMap -> [Ruleset RDFGraph]
forall a b. (a -> b) -> a -> b
$ SwishState -> RDFRulesetMap
rulesets SwishState
state
Maybe RDFRule
justlr -> Maybe RDFRule
justlr
modRulesets ::
( RDFRulesetMap -> RDFRulesetMap ) -> SwishState -> SwishState
modRulesets :: (RDFRulesetMap -> RDFRulesetMap) -> SwishState -> SwishState
modRulesets RDFRulesetMap -> RDFRulesetMap
rsmod SwishState
state = SwishState
state { rulesets = rsmod (rulesets state) }
findRuleset ::
ScopedName -> SwishState -> Maybe RDFRuleset
findRuleset :: ScopedName -> SwishState -> Maybe (Ruleset RDFGraph)
findRuleset ScopedName
nam SwishState
state = Namespace -> RDFRulesetMap -> Maybe (Ruleset RDFGraph)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ScopedName -> Namespace
getScopeNamespace ScopedName
nam) (SwishState -> RDFRulesetMap
rulesets SwishState
state)
findOpenVarModify :: ScopedName -> SwishState -> Maybe RDFOpenVarBindingModify
findOpenVarModify :: ScopedName -> SwishState -> Maybe RDFOpenVarBindingModify
findOpenVarModify ScopedName
nam SwishState
_ = ScopedName -> Maybe RDFOpenVarBindingModify
findRDFOpenVarBindingModifier ScopedName
nam
findDatatype :: ScopedName -> SwishState -> Maybe RDFDatatype
findDatatype :: ScopedName -> SwishState -> Maybe RDFDatatype
findDatatype ScopedName
nam SwishState
_ = ScopedName -> Maybe RDFDatatype
findRDFDatatype ScopedName
nam
setInfo :: String -> SwishState -> SwishState
setInfo :: String -> SwishState -> SwishState
setInfo String
msg SwishState
state = SwishState
state { infomsg = Just msg }
resetInfo :: SwishState -> SwishState
resetInfo :: SwishState -> SwishState
resetInfo SwishState
state = SwishState
state { infomsg = Nothing }
setError :: String -> SwishState -> SwishState
setError :: String -> SwishState -> SwishState
setError String
msg SwishState
state = SwishState
state { errormsg = Just msg }
resetError :: SwishState -> SwishState
resetError :: SwishState -> SwishState
resetError SwishState
state = SwishState
state { errormsg = Nothing }
setStatus :: SwishStatus -> SwishState -> SwishState
setStatus :: SwishStatus -> SwishState -> SwishState
setStatus SwishStatus
ec SwishState
state = SwishState
state { exitcode = ec }
type NamedGraphMap = M.Map ScopedName [RDFGraph]
swishError :: String -> SwishStatus -> SwishStateIO ()
swishError :: String -> SwishStatus -> SwishStateIO ()
swishError String
msg SwishStatus
sts = do
(String -> SwishStateIO ()) -> [String] -> SwishStateIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> SwishStateIO ()
reportLine [String
msg, SwishStatus -> String
forall a. Show a => a -> String
show SwishStatus
sts String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"]
(SwishState -> SwishState) -> SwishStateIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SwishState -> SwishState) -> SwishStateIO ())
-> (SwishState -> SwishState) -> SwishStateIO ()
forall a b. (a -> b) -> a -> b
$ SwishStatus -> SwishState -> SwishState
setStatus SwishStatus
sts
reportLine :: String -> SwishStateIO ()
reportLine :: String -> SwishStateIO ()
reportLine = IO () -> SwishStateIO ()
forall (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> SwishStateIO ())
-> (String -> IO ()) -> String -> SwishStateIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr