--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Monad
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--                 2011, 2012 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  H98
--
--  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 SwishFormat -> SwishFormat -> Bool
(SwishFormat -> SwishFormat -> Bool)
-> (SwishFormat -> SwishFormat -> Bool) -> Eq SwishFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwishFormat -> SwishFormat -> Bool
$c/= :: SwishFormat -> SwishFormat -> Bool
== :: SwishFormat -> SwishFormat -> Bool
$c== :: 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 (SwishStatus -> SwishStatus -> Bool
(SwishStatus -> SwishStatus -> Bool)
-> (SwishStatus -> SwishStatus -> Bool) -> Eq SwishStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwishStatus -> SwishStatus -> Bool
$c/= :: SwishStatus -> SwishStatus -> Bool
== :: SwishStatus -> SwishStatus -> Bool
$c== :: 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
enumFromThenTo :: SwishStatus -> SwishStatus -> SwishStatus -> [SwishStatus]
$cenumFromThenTo :: SwishStatus -> SwishStatus -> SwishStatus -> [SwishStatus]
enumFromTo :: SwishStatus -> SwishStatus -> [SwishStatus]
$cenumFromTo :: SwishStatus -> SwishStatus -> [SwishStatus]
enumFromThen :: SwishStatus -> SwishStatus -> [SwishStatus]
$cenumFromThen :: SwishStatus -> SwishStatus -> [SwishStatus]
enumFrom :: SwishStatus -> [SwishStatus]
$cenumFrom :: SwishStatus -> [SwishStatus]
fromEnum :: SwishStatus -> Int
$cfromEnum :: SwishStatus -> Int
toEnum :: Int -> SwishStatus
$ctoEnum :: Int -> SwishStatus
pred :: SwishStatus -> SwishStatus
$cpred :: SwishStatus -> SwishStatus
succ :: SwishStatus -> SwishStatus
$csucc :: 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 :: SwishFormat
-> Maybe QName
-> RDFGraph
-> NamedGraphMap
-> RDFRuleMap
-> RDFRulesetMap
-> Maybe String
-> Maybe String
-> SwishStatus
-> SwishState
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 :: SwishFormat
format = SwishFormat
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 :: Maybe QName
base = Maybe QName
bs }

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

-- | Modify the named graphs.
modGraphs ::
    ( NamedGraphMap -> NamedGraphMap ) -> SwishState -> SwishState
modGraphs :: (NamedGraphMap -> NamedGraphMap) -> SwishState -> SwishState
modGraphs NamedGraphMap -> NamedGraphMap
grmod SwishState
state = SwishState
state { graphs :: NamedGraphMap
graphs = NamedGraphMap -> NamedGraphMap
grmod (SwishState -> NamedGraphMap
graphs SwishState
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)
        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]
grs -> 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] -> RDFGraph
forall a. [a] -> a
head [RDFGraph]
grs)

-- | Modify the named rules.
modRules ::
    ( RDFRuleMap -> RDFRuleMap ) -> SwishState -> SwishState
modRules :: (RDFRuleMap -> RDFRuleMap) -> SwishState -> SwishState
modRules RDFRuleMap -> RDFRuleMap
rlmod SwishState
state = SwishState
state { rules :: RDFRuleMap
rules = RDFRuleMap -> RDFRuleMap
rlmod (SwishState -> RDFRuleMap
rules SwishState
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 :: RDFRulesetMap
rulesets = RDFRulesetMap -> RDFRulesetMap
rsmod (SwishState -> RDFRulesetMap
rulesets SwishState
state) }

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

-- | Find a modify rule.
findOpenVarModify :: ScopedName -> SwishState -> Maybe RDFOpenVarBindingModify
findOpenVarModify :: ScopedName -> SwishState -> Maybe RDFOpenVarBindingModify
findOpenVarModify ScopedName
nam SwishState
_ = ScopedName -> Maybe RDFOpenVarBindingModify
findRDFOpenVarBindingModifier ScopedName
nam

-- | Find a data type declaration.
findDatatype :: ScopedName -> SwishState -> Maybe RDFDatatype
findDatatype :: ScopedName -> SwishState -> Maybe RDFDatatype
findDatatype ScopedName
nam SwishState
_ = ScopedName -> Maybe RDFDatatype
findRDFDatatype ScopedName
nam

-- | Set the information message.
setInfo :: String -> SwishState -> SwishState
setInfo :: String -> SwishState -> SwishState
setInfo String
msg SwishState
state = SwishState
state { infomsg :: Maybe String
infomsg = String -> Maybe String
forall a. a -> Maybe a
Just String
msg }

-- | Clear the information message.
resetInfo :: SwishState -> SwishState
resetInfo :: SwishState -> SwishState
resetInfo SwishState
state = SwishState
state { infomsg :: Maybe String
infomsg = Maybe String
forall a. Maybe a
Nothing }

-- | Set the error message.
setError :: String -> SwishState -> SwishState
setError :: String -> SwishState -> SwishState
setError String
msg SwishState
state = SwishState
state { errormsg :: Maybe String
errormsg = String -> Maybe String
forall a. a -> Maybe a
Just String
msg }

-- | Clear the error message.
resetError :: SwishState -> SwishState
resetError :: SwishState -> SwishState
resetError SwishState
state = SwishState
state { errormsg :: Maybe String
errormsg = Maybe String
forall a. Maybe a
Nothing }

-- | Set the status.
setStatus :: SwishStatus -> SwishState -> SwishState
setStatus :: SwishStatus -> SwishState -> SwishState
setStatus SwishStatus
ec SwishState
state = SwishState
state { exitcode :: SwishStatus
exitcode = SwishStatus
ec }

{-
setVerbose :: Bool -> SwishState -> SwishState
setVerbose f state = state { banner = f }
-}

{-
-- | The graphs dictionary contains named graphs and/or lists
--  of graphs that are created and used by script statements.

data NamedGraph = NamedGraph
    { ngName    :: ScopedName
    , ngGraph   :: [RDFGraph]
    }

-}

-- | A LookupMap for the graphs dictionary.
type NamedGraphMap = M.Map ScopedName [RDFGraph]

-- | Report error and set exit status code

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

-- | Output the text to the standard error stream (a new line is
-- added to the output).
reportLine  :: String -> SwishStateIO ()
reportLine :: String -> SwishStateIO ()
reportLine = IO () -> SwishStateIO ()
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

--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012 Douglas Burke 
--  All rights reserved.
--
--  This file is part of Swish.
--
--  Swish is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  Swish is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with Swish; if not, write to:
--    The Free Software Foundation, Inc.,
--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--
--------------------------------------------------------------------------------