module Swish.RDF.SwishMain (
SwishStatus(..), SwishAction,
runSwish,
runSwishActions,
displaySwishHelp,
splitArguments,
validateCommands
) where
import Swish.RDF.SwishCommands
( swishFormat
, swishBase
, swishInput
, swishOutput
, swishMerge
, swishCompare
, swishGraphDiff
, swishScript
)
import Swish.RDF.SwishMonad
( SwishStateIO, SwishState(..), SwishStatus(..)
, emptyState
, SwishFormat(..)
)
import Swish.Utils.QName (qnameFromURI)
import Swish.Utils.ListHelpers (breakAll)
import Control.Monad.State (execStateT)
import Control.Monad (liftM)
import Network.URI (parseURI)
import Data.Char (isSpace)
import Data.Either (partitionEithers)
import System.Exit (ExitCode(ExitSuccess, ExitFailure))
usageText :: [String]
usageText =
[ "Swish: Read, merge, write, compare and process RDF graphs."
, ""
, "Usage: swish option option ..."
, ""
, "where the options are processed from left to right, and may be"
, "any of the following:"
, "-h display this message."
, "-? display this message."
, "-v display Swish version and quit."
, "-q do not display Swish version on start up."
, "-nt use Ntriples format for subsequent input and output."
, "-n3 use Notation3 format for subsequent input and output (default)"
, "-i[=file] read file in selected format into the graph workspace,"
, " replacing any existing graph."
, "-m[=file] merge file in selected format with the graph workspace."
, "-c[=file] compare file in selected format with the graph workspace."
, "-d[=file] show graph differences between the file in selected"
, " format and the graph workspace. Differences are displayed"
, " to the standard output stream."
, "-o[=file] write the graph workspace to a file in the selected format."
, "-s[=file] read and execute Swish script commands from the named file."
, "-b[=base] set or clear the base URI. The semantics of this are not"
, " fully defined yet."
, ""
, " If an optional filename value is omitted, the standard input"
, " or output stream is used, as appropriate."
, ""
, "Exit status codes:"
, "Success - operation completed successfully/graphs compare equal"
, "1 - graphs compare different"
, "2 - input data format error"
, "3 - file access problem"
, "4 - command line error"
, "5 - script file execution error"
, ""
, "Examples:"
, ""
, "swish -i=file"
, " read file as Notation3, and report any syntax errors."
, "swish -i=file1 -o=file2"
, " read file1 as Notation3, report any syntax errors, and output the"
, " resulting graph as reformatted Notation3 (the output format"
, " is not perfect but may be improved)."
, "swish -nt -i=file -n3 -o"
, " read file as NTriples and output as Notation3 to the screen."
, "swich -i=file1 -c=file2"
, " read file1 and file2 as notation3, report any syntax errors, and"
, " if both are OK, compare the resulting graphs to indicate whether"
, " or not they are equivalent."
]
displaySwishHelp :: IO ()
displaySwishHelp = mapM_ putStrLn usageText
splitArguments :: [String] -> ([String], [String])
splitArguments = partitionEithers . map splitArgument
splitArgument :: String -> Either String String
splitArgument "-?" = Left "-h"
splitArgument "-h" = Left "-h"
splitArgument "-v" = Left "-v"
splitArgument "-q" = Left "-q"
splitArgument x = Right x
newtype SwishAction = SA (SwishStateIO ())
validateCommands :: [String] -> Either (String, SwishStatus) [SwishAction]
validateCommands args =
let (ls, rs) = partitionEithers (map validateCommand args)
in case ls of
(e:_) -> Left e
[] -> Right rs
validateCommand :: String -> Either (String, SwishStatus) SwishAction
validateCommand cmd =
let (nam,more) = break (=='=') cmd
arg = drop 1 more
marg = if null arg then Nothing else Just arg
wrap f = Right $ SA $ f marg
in case nam of
"-nt" -> wrap $ swishFormat NT
"-n3" -> wrap $ swishFormat N3
"-i" -> wrap swishInput
"-m" -> wrap swishMerge
"-c" -> wrap swishCompare
"-d" -> wrap swishGraphDiff
"-o" -> wrap swishOutput
"-b" -> validateBase marg
"-s" -> wrap swishScript
_ -> Left ("Invalid command line argument: "++cmd, SwishArgumentError)
swishCommands :: [SwishAction] -> SwishStateIO ()
swishCommands = mapM_ swishCommand
swishCommand :: SwishAction -> SwishStateIO ()
swishCommand (SA act) = act
validateBase :: Maybe String -> Either (String, SwishStatus) SwishAction
validateBase Nothing = Right $ SA $ swishBase Nothing Nothing
validateBase (Just b) =
case fmap qnameFromURI (parseURI b) of
j@(Just _) -> Right $ SA $ swishBase j Nothing
_ -> Left ("Invalid base URI <" ++ b ++ ">", SwishArgumentError)
runSwish :: String -> IO ExitCode
runSwish cmdline = do
let args = breakAll isSpace cmdline
(_, cmds) = splitArguments args
case validateCommands cmds of
Left (emsg, ecode) -> do
putStrLn $ "Swish exit: " ++ emsg
return $ ExitFailure $ fromEnum ecode
Right acts -> do
ec <- runSwishActions acts
case ec of
SwishSuccess -> return ExitSuccess
_ -> do
putStrLn $ "Swish exit: " ++ show ec
return $ ExitFailure $ fromEnum ec
runSwishActions :: [SwishAction] -> IO SwishStatus
runSwishActions acts = exitcode `liftM` execStateT (swishCommands acts) emptyState