--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Swish
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2020 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  H98
--
--  Swish:  Semantic Web Inference Scripting in Haskell
--
--  This program is a simple skeleton for constructing Semantic Web [1]
--  inference tools in Haskell, using the RDF graph and several RDF
--  parsers (at present Notation 3 and NTriples).
--
--  It might be viewed as a kind of embroyonic CWM [2] in Haskell,
--  except that the intent is that Haskell will be used as a primary
--  language for defining inferences.  As such, Swish is an open-ended
--  toolkit for constructing new special-purpose Semantic Web
--  applications rather than a closed, self-contained general-purpose
--  SW application.  As such, it is part of another experiment along
--  the lines described in [3].
--
--  The script format used by Swish is described in
--  "Swish.Script".
--
--  Users wishing to process RDF data directly may prefer to look at
--  the following modules; "Swish.RDF", "Swish.RDF.Parser.Turtle",
--  "Swish.RDF.Parser.N3", "Swish.RDF.Parser.NTriples",
--  "Swish.RDF.Formatter.Turtle", "Swish.RDF.Formatter.N3"
--  and "Swish.RDF.Formatter.NTriples".
--
--  (1) Semantic web: <http://www.w3.org/2001/sw/>
--
--  (2) CWM:          <http://www.w3.org/2000/10/swap/doc/cwm.html>
--
--  (3) Motivation:   <http://www.w3.org/2000/10/swap/doc/Motivation.html>
--
--  (4) Notation 3:   <http://www.w3.org/TeamSubmission/2008/SUBM-n3-20080114/>
--
--  (5) Turtle:       <http://www.w3.org/TR/turtle/>
--
--  (6) RDF:          <http://www.w3.org/RDF/>
--
--  Notes
--
--  I anticipate that this module may be used as a starting point for
--  creating new programs rather then as a complete program in its own
--  right.  The functionality built into this code is selected with a
--  view to testing the Haskell modules for handling RDF rather than
--  for performing any particular application processing (though
--  development as a tool with some broader utility is not ruled out).
--
--  With the following in ghci:
--
-- >>> :m + Swish
-- >>> :set prompt "swish> "
--
-- then we can run a Swish script (format described in "Swish.Script")
-- by saying:
--
-- >>> runSwish "-s=script.ss"
-- ExitSuccess
--
-- or convert a file from Turtle to NTriples format with:
--
-- >>> runSwish "-ttl -i=foo.ttl -nt -o=foo.nt"
-- ExitSuccess
--
-- You can also use `validateCommands` by giving it the individual commands,
-- such as
--
-- >>> let Right cs = validateCommands ["-ttl", "-i=file1.ttl", "-c=file2.ttl"]
-- >>> cs
-- [SwishAction: -ttl,SwishAction: -i=file1.ttl,SwishAction: -c=file2.ttl]
-- >>> st <- runSwishActions cs
-- >>> st
-- The graphs do not compare as equal.
--
--------------------------------------------------------------------------------

module Swish ( SwishStatus(..)
             , SwishAction
             , runSwish
             , runSwishActions
             , displaySwishHelp
             , splitArguments
             , validateCommands
             ) where

import Swish.Commands
    ( swishFormat
    , swishBase
    , swishInput
    , swishOutput
    , swishMerge
    , swishCompare
    , swishGraphDiff
    , swishScript
    )

import Swish.Monad (SwishStateIO, SwishState(..), SwishStatus(..)
                   , SwishFormat(..)
                   , emptyState)
import Swish.QName (qnameFromURI)


import Control.Monad.State (execStateT)

import Network.URI (parseURI)

import Data.Char (isSpace)
import Data.Either (partitionEithers)

import System.Exit (ExitCode(ExitSuccess, ExitFailure))

------------------------------------------------------------
--  Command line description
------------------------------------------------------------

-- we do not display the version in the help file to avoid having
-- to include the Paths_swish module (so that we can use this from
-- an interactive environment).
--

usageText :: [String]
usageText :: [String]
usageText =
    [ String
"Swish: Read, merge, write, compare and process RDF graphs."
    , String
""
    , String
"Usage: swish option option ..."
    , String
""
    , String
"where the options are processed from left to right, and may be"
    , String
"any of the following:"
    , String
"-h        display this message."
    , String
"-?        display this message."
    , String
"-v        display Swish version and quit."
    , String
"-q        do not display Swish version on start up."
    , String
"-nt       use Ntriples format for subsequent input and output."
    , String
"-ttl      use Turtle format for subsequent input and output."
    , String
"-n3       use Notation3 format for subsequent input and output (default)"
    , String
"-i[=file] read file in selected format into the graph workspace,"
    , String
"          replacing any existing graph."
    , String
"-m[=file] merge file in selected format with the graph workspace."
    , String
"-c[=file] compare file in selected format with the graph workspace."
    , String
"-d[=file] show graph differences between the file in selected"
    , String
"          format and the graph workspace.  Differences are displayed"
    , String
"          to the standard output stream."
    , String
"-o[=file] write the graph workspace to a file in the selected format."
    , String
"-s[=file] read and execute Swish script commands from the named file."
    , String
"-b[=base] set or clear the base URI. The semantics of this are not"
    , String
"          fully defined yet."
    , String
""
    , String
"    If an optional filename value is omitted, the standard input"
    , String
"    or output stream is used, as appropriate."
    , String
""
    , String
"Exit status codes:"
    , String
"Success - operation completed successfully/graphs compare equal"
    , String
"1 - graphs compare different"
    , String
"2 - input data format error"
    , String
"3 - file access problem"
    , String
"4 - command line error"
    , String
"5 - script file execution error"
    , String
""
    , String
"Examples:"
    , String
""
    , String
"swish -i=file"
    , String
"    read file as Notation3, and report any syntax errors."
    , String
"swish -i=file1 -o=file2"
    , String
"    read file1 as Notation3, report any syntax errors, and output the"
    , String
"    resulting graph as reformatted Notation3 (the output format"
    , String
"    is not perfect but may be improved)."
    , String
"swish -nt -i=file -n3 -o"
    , String
"    read file as NTriples and output as Notation3 to the screen."
    , String
"swich -i=file1 -c=file2"
    , String
"    read file1 and file2 as notation3, report any syntax errors, and"
    , String
"    if both are OK, compare the resulting graphs to indicate whether"
    , String
"    or not they are equivalent."
    ]

-- | Write out the help for Swish
displaySwishHelp :: IO ()
displaySwishHelp :: IO ()
displaySwishHelp = (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn [String]
usageText

------------------------------------------------------------
--  Swish command line interpreter
------------------------------------------------------------
--
--  This is a composite monad combining some state with an IO
--  Monad.  lift allows a pure IO monad to be used as a step
--  of the computation.
--
        
-- | Return any arguments that need processing immediately, namely                     
-- the \"help\", \"quiet\" and \"version\" options.
--
splitArguments :: [String] -> ([String], [String])
splitArguments :: [String] -> ([String], [String])
splitArguments = [Either String String] -> ([String], [String])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either String String] -> ([String], [String]))
-> ([String] -> [Either String String])
-> [String]
-> ([String], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Either String String)
-> [String] -> [Either String String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either String String
splitArgument

splitArgument :: String -> Either String String
splitArgument :: String -> Either String String
splitArgument String
"-?" = String -> Either String String
forall a b. a -> Either a b
Left String
"-h"
splitArgument String
"-h" = String -> Either String String
forall a b. a -> Either a b
Left String
"-h"
splitArgument String
"-v" = String -> Either String String
forall a b. a -> Either a b
Left String
"-v"
splitArgument String
"-q" = String -> Either String String
forall a b. a -> Either a b
Left String
"-q"
splitArgument String
x    = String -> Either String String
forall a b. b -> Either a b
Right String
x

-- | Represent a Swish action. At present there is no way to create these
-- actions other than 'validateCommands'.
-- 
newtype SwishAction = SA (String, SwishStateIO ())

instance Show SwishAction where
  show :: SwishAction -> String
show (SA (String
lbl,SwishStateIO ()
_)) = String
"SwishAction: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
lbl

-- | Given a list of command-line arguments create the list of actions
-- to perform or a string and status value indicating an input error.
validateCommands :: [String] -> Either (String, SwishStatus) [SwishAction]
validateCommands :: [String] -> Either (String, SwishStatus) [SwishAction]
validateCommands [String]
args = 
  let ([(String, SwishStatus)]
ls, [SwishAction]
rs) = [Either (String, SwishStatus) SwishAction]
-> ([(String, SwishStatus)], [SwishAction])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((String -> Either (String, SwishStatus) SwishAction)
-> [String] -> [Either (String, SwishStatus) SwishAction]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either (String, SwishStatus) SwishAction
validateCommand [String]
args)
  in case [(String, SwishStatus)]
ls of
    ((String, SwishStatus)
e:[(String, SwishStatus)]
_) -> (String, SwishStatus) -> Either (String, SwishStatus) [SwishAction]
forall a b. a -> Either a b
Left (String, SwishStatus)
e
    []    -> [SwishAction] -> Either (String, SwishStatus) [SwishAction]
forall a b. b -> Either a b
Right [SwishAction]
rs
  
-- This allows you to say "-nt=foo" and currently ignores the values
-- passed through. This may change
--    
validateCommand :: String -> Either (String, SwishStatus) SwishAction
validateCommand :: String -> Either (String, SwishStatus) SwishAction
validateCommand String
cmd =
  let (String
nam,String
more) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') String
cmd
      arg :: String
arg        = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
more
      marg :: Maybe String
marg       = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
arg then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
arg
      
      wrap :: (Maybe String -> SwishStateIO ()) -> Either a SwishAction
wrap Maybe String -> SwishStateIO ()
f = SwishAction -> Either a SwishAction
forall a b. b -> Either a b
Right (SwishAction -> Either a SwishAction)
-> SwishAction -> Either a SwishAction
forall a b. (a -> b) -> a -> b
$ (String, SwishStateIO ()) -> SwishAction
SA (String
cmd, Maybe String -> SwishStateIO ()
f Maybe String
marg)
      wrap1 :: SwishStateIO () -> Either a SwishAction
wrap1 SwishStateIO ()
f = SwishAction -> Either a SwishAction
forall a b. b -> Either a b
Right (SwishAction -> Either a SwishAction)
-> SwishAction -> Either a SwishAction
forall a b. (a -> b) -> a -> b
$ (String, SwishStateIO ()) -> SwishAction
SA (String
cmd, SwishStateIO ()
f)

  in case String
nam of
    String
"-ttl"  -> SwishStateIO () -> Either (String, SwishStatus) SwishAction
forall {a}. SwishStateIO () -> Either a SwishAction
wrap1 (SwishStateIO () -> Either (String, SwishStatus) SwishAction)
-> SwishStateIO () -> Either (String, SwishStatus) SwishAction
forall a b. (a -> b) -> a -> b
$ SwishFormat -> SwishStateIO ()
swishFormat SwishFormat
Turtle
    String
"-nt"   -> SwishStateIO () -> Either (String, SwishStatus) SwishAction
forall {a}. SwishStateIO () -> Either a SwishAction
wrap1 (SwishStateIO () -> Either (String, SwishStatus) SwishAction)
-> SwishStateIO () -> Either (String, SwishStatus) SwishAction
forall a b. (a -> b) -> a -> b
$ SwishFormat -> SwishStateIO ()
swishFormat SwishFormat
NT
    String
"-n3"   -> SwishStateIO () -> Either (String, SwishStatus) SwishAction
forall {a}. SwishStateIO () -> Either a SwishAction
wrap1 (SwishStateIO () -> Either (String, SwishStatus) SwishAction)
-> SwishStateIO () -> Either (String, SwishStatus) SwishAction
forall a b. (a -> b) -> a -> b
$ SwishFormat -> SwishStateIO ()
swishFormat SwishFormat
N3
    String
"-i"    -> (Maybe String -> SwishStateIO ())
-> Either (String, SwishStatus) SwishAction
forall {a}.
(Maybe String -> SwishStateIO ()) -> Either a SwishAction
wrap Maybe String -> SwishStateIO ()
swishInput
    String
"-m"    -> (Maybe String -> SwishStateIO ())
-> Either (String, SwishStatus) SwishAction
forall {a}.
(Maybe String -> SwishStateIO ()) -> Either a SwishAction
wrap Maybe String -> SwishStateIO ()
swishMerge
    String
"-c"    -> (Maybe String -> SwishStateIO ())
-> Either (String, SwishStatus) SwishAction
forall {a}.
(Maybe String -> SwishStateIO ()) -> Either a SwishAction
wrap Maybe String -> SwishStateIO ()
swishCompare
    String
"-d"    -> (Maybe String -> SwishStateIO ())
-> Either (String, SwishStatus) SwishAction
forall {a}.
(Maybe String -> SwishStateIO ()) -> Either a SwishAction
wrap Maybe String -> SwishStateIO ()
swishGraphDiff
    String
"-o"    -> (Maybe String -> SwishStateIO ())
-> Either (String, SwishStatus) SwishAction
forall {a}.
(Maybe String -> SwishStateIO ()) -> Either a SwishAction
wrap Maybe String -> SwishStateIO ()
swishOutput
    String
"-b"    -> String -> Maybe String -> Either (String, SwishStatus) SwishAction
validateBase String
cmd Maybe String
marg
    String
"-s"    -> (Maybe String -> SwishStateIO ())
-> Either (String, SwishStatus) SwishAction
forall {a}.
(Maybe String -> SwishStateIO ()) -> Either a SwishAction
wrap Maybe String -> SwishStateIO ()
swishScript
    String
_       -> (String, SwishStatus) -> Either (String, SwishStatus) SwishAction
forall a b. a -> Either a b
Left (String
"Invalid command line argument: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cmd, SwishStatus
SwishArgumentError)

-- | Execute the given set of actions.
swishCommands :: [SwishAction] -> SwishStateIO ()
swishCommands :: [SwishAction] -> SwishStateIO ()
swishCommands = (SwishAction -> SwishStateIO ())
-> [SwishAction] -> SwishStateIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SwishAction -> SwishStateIO ()
swishCommand

-- | Execute an action.
swishCommand :: SwishAction -> SwishStateIO ()
swishCommand :: SwishAction -> SwishStateIO ()
swishCommand (SA (String
_,SwishStateIO ()
act)) = SwishStateIO ()
act

validateBase :: String -> Maybe String -> Either (String, SwishStatus) SwishAction
validateBase :: String -> Maybe String -> Either (String, SwishStatus) SwishAction
validateBase String
arg Maybe String
Nothing  = SwishAction -> Either (String, SwishStatus) SwishAction
forall a b. b -> Either a b
Right (SwishAction -> Either (String, SwishStatus) SwishAction)
-> SwishAction -> Either (String, SwishStatus) SwishAction
forall a b. (a -> b) -> a -> b
$ (String, SwishStateIO ()) -> SwishAction
SA (String
arg, Maybe QName -> SwishStateIO ()
swishBase Maybe QName
forall a. Maybe a
Nothing)
validateBase String
arg (Just String
b) =
  case String -> Maybe URI
parseURI String
b Maybe URI -> (URI -> Maybe QName) -> Maybe QName
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= URI -> Maybe QName
qnameFromURI of
    j :: Maybe QName
j@(Just QName
_) -> SwishAction -> Either (String, SwishStatus) SwishAction
forall a b. b -> Either a b
Right (SwishAction -> Either (String, SwishStatus) SwishAction)
-> SwishAction -> Either (String, SwishStatus) SwishAction
forall a b. (a -> b) -> a -> b
$ (String, SwishStateIO ()) -> SwishAction
SA (String
arg, Maybe QName -> SwishStateIO ()
swishBase Maybe QName
j)
    Maybe QName
_      -> (String, SwishStatus) -> Either (String, SwishStatus) SwishAction
forall a b. a -> Either a b
Left (String
"Invalid base URI <" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">", SwishStatus
SwishArgumentError)
  
------------------------------------------------------------
--  Interactive test function (e.g. for use in ghci)
------------------------------------------------------------

-- this ignores the "flags" options, namely
--    -q / -h / -? / -v

-- | Parse and run the given string as if given at the command
-- line. The \"quiet\", \"version\" and \"help\" options are
-- ignored.
--
runSwish :: String -> IO ExitCode
runSwish :: String -> IO ExitCode
runSwish String
cmdline = do
  let args :: [String]
args = (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
breakAll Char -> Bool
isSpace String
cmdline
      ([String]
_, [String]
cmds) = [String] -> ([String], [String])
splitArguments [String]
args
      
  case [String] -> Either (String, SwishStatus) [SwishAction]
validateCommands [String]
cmds of
    Left (String
emsg, SwishStatus
ecode) -> do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Swish exit: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
emsg
      ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure (Int -> ExitCode) -> Int -> ExitCode
forall a b. (a -> b) -> a -> b
$ SwishStatus -> Int
forall a. Enum a => a -> Int
fromEnum SwishStatus
ecode
      
    Right [SwishAction]
acts -> do
      SwishStatus
ec <- [SwishAction] -> IO SwishStatus
runSwishActions [SwishAction]
acts
      case SwishStatus
ec of
        SwishStatus
SwishSuccess -> ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
        SwishStatus
_  -> do
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Swish exit: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SwishStatus -> String
forall a. Show a => a -> String
show SwishStatus
ec
          ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure (Int -> ExitCode) -> Int -> ExitCode
forall a b. (a -> b) -> a -> b
$ SwishStatus -> Int
forall a. Enum a => a -> Int
fromEnum SwishStatus
ec

-- |Break list into a list of sublists, separated by element
--  satisfying supplied condition.
breakAll :: (a -> Bool) -> [a] -> [[a]]
breakAll :: forall a. (a -> Bool) -> [a] -> [[a]]
breakAll a -> Bool
_ [] = []
breakAll a -> Bool
p [a]
s  = let ([a]
h,[a]
s') = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
s
                    in [a]
h [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
breakAll a -> Bool
p (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
s')

-- | Execute the given set of actions.
runSwishActions :: [SwishAction] -> IO SwishStatus
runSwishActions :: [SwishAction] -> IO SwishStatus
runSwishActions [SwishAction]
acts = SwishState -> SwishStatus
exitcode (SwishState -> SwishStatus) -> IO SwishState -> IO SwishStatus
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` SwishStateIO () -> SwishState -> IO SwishState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ([SwishAction] -> SwishStateIO ()
swishCommands [SwishAction]
acts) SwishState
emptyState

--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2020 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
--
--------------------------------------------------------------------------------