{-# LANGUAGE CPP #-}

#if (__GLASGOW_HASKELL__ >= 802)
{-# LANGUAGE DerivingStrategies #-}
#endif

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Monad
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--                 2011, 2012, 2022, 2024 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  CPP, DerivingStrategies
--
--  Composed state and IO monad for Swish
--
--------------------------------------------------------------------------------

module Swish.Monad
    ( SwishStateIO, SwishState(..), SwishStatus(..)
    , SwishFormat(..)
    , NamedGraphMap
    -- * Create and modify the Swish state
    , emptyState
    , setFormat, setBase, setGraph
    , modGraphs, findGraph, findFormula
    , modRules, findRule
    , modRulesets, findRuleset
    , findOpenVarModify, findDatatype
    , setInfo, resetInfo, setError, resetError
    , setStatus
    -- * Error handling
    , 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

{-|
The supported input and output formats.
-}
data SwishFormat = 
  Turtle  -- ^ Turtle format
  | N3    -- ^ N3 format
  | NT    -- ^ NTriples format
    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"
  -- show RDF = "RDF/XML"

-- | The State for a Swish \"program\".
  
data SwishState = SwishState
    { SwishState -> SwishFormat
format    :: SwishFormat      -- ^ format to use for I/O
    , SwishState -> Maybe QName
base      :: Maybe QName      -- ^ base to use rather than file name
    , SwishState -> RDFGraph
graph     :: RDFGraph         -- ^ current graph
    , SwishState -> NamedGraphMap
graphs    :: NamedGraphMap    -- ^ script processor named graphs
    , SwishState -> RDFRuleMap
rules     :: RDFRuleMap       -- ^ script processor named rules
    , SwishState -> RDFRulesetMap
rulesets  :: RDFRulesetMap    -- ^ script processor rulesets
    , SwishState -> Maybe String
infomsg   :: Maybe String     -- ^ information message, or Nothing
    , SwishState -> Maybe String
errormsg  :: Maybe String     -- ^ error message, or Nothing
    , SwishState -> SwishStatus
exitcode  :: SwishStatus      -- ^ current status
    }

-- | Status of the processor
--
data SwishStatus =
  SwishSuccess               -- ^ successful run
  | SwishGraphCompareError   -- ^ graphs do not compare
  | SwishDataInputError      -- ^ input data problem (ie format/syntax)
  | SwishDataAccessError     -- ^ data access error
  | SwishArgumentError       -- ^ command-line argument error
  | SwishExecutionError      -- ^ error executing a Swish script
    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."

-- | The state monad used in executing Swish programs.
type SwishStateIO a = StateT SwishState IO a

-- | The default state for Swish: no loaded graphs or rules, and format
-- set to 'N3'.
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
    }

-- | Change the format.
setFormat :: SwishFormat -> SwishState -> SwishState
setFormat :: SwishFormat -> SwishState -> SwishState
setFormat   SwishFormat
fm SwishState
state = SwishState
state { format = fm }

-- | Change (or remove) the base URI.
setBase :: Maybe QName -> SwishState -> SwishState
setBase :: Maybe QName -> SwishState -> SwishState
setBase Maybe QName
bs SwishState
state = SwishState
state { base = bs }

-- | Change the current graph.
setGraph :: RDFGraph -> SwishState -> SwishState
setGraph :: RDFGraph -> SwishState -> SwishState
setGraph    RDFGraph
gr SwishState
state = SwishState
state { graph = gr }

-- | Modify the named graphs.
modGraphs ::
    ( NamedGraphMap -> NamedGraphMap ) -> SwishState -> SwishState
modGraphs :: (NamedGraphMap -> NamedGraphMap) -> SwishState -> SwishState
modGraphs NamedGraphMap -> NamedGraphMap
grmod SwishState
state = SwishState
state { graphs = grmod (graphs state) }

-- | Find a named graph.
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)

-- | Find a formula. The search is first made in the named graphs
-- and then, if not found, the rulesets.
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)
        -- does it make sense to allow an empty graph?
        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

-- | Modify the named rules.
modRules ::
    ( RDFRuleMap -> RDFRuleMap ) -> SwishState -> SwishState
modRules :: (RDFRuleMap -> RDFRuleMap) -> SwishState -> SwishState
modRules RDFRuleMap -> RDFRuleMap
rlmod SwishState
state = SwishState
state { rules = rlmod (rules state) }

-- | Find a named rule.
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

-- | Modify the rule sets.
modRulesets ::
    ( RDFRulesetMap -> RDFRulesetMap ) -> SwishState -> SwishState
modRulesets :: (RDFRulesetMap -> RDFRulesetMap) -> SwishState -> SwishState
modRulesets RDFRulesetMap -> RDFRulesetMap
rsmod SwishState
state = SwishState
state { rulesets = rsmod (rulesets state) }

-- | Find a rule set.
findRuleset ::
    ScopedName -> SwishState -> Maybe