module Swish.RDF.SwishCommands
( swishFormat
, swishBase
, swishInput
, swishOutput
, swishMerge
, swishCompare
, swishGraphDiff
, swishScript
)
where
import Swish.RDF.SwishMonad
( SwishStateIO, SwishState(..), SwishStatus(..)
, setFormat, setBase, setGraph
, resetInfo, resetError, setStatus
, SwishFormat(..)
, swishError
, reportLine
)
import Swish.RDF.SwishScript (parseScriptFromText)
import Swish.RDF.GraphPartition
( GraphPartition(..)
, partitionGraph, comparePartitions
, partitionShowP
)
import Swish.RDF.RDFGraph
( RDFGraph, merge )
import qualified Swish.RDF.TurtleFormatter as TTLF
import qualified Swish.RDF.N3Formatter as N3F
import qualified Swish.RDF.NTFormatter as NTF
import Swish.RDF.TurtleParser (parseTurtle)
import Swish.RDF.N3Parser (parseN3)
import Swish.RDF.NTParser (parseNT)
import Swish.RDF.RDFParser (appendURIs)
import Swish.RDF.GraphClass
( LDGraph(..)
, Label(..)
)
import Swish.Utils.QName (QName, qnameFromURI, qnameFromFilePath, getQNameURI)
import System.IO
( Handle, openFile, IOMode(..)
, hPutStr, hPutStrLn, hClose
, hIsReadable, hIsWritable
, stdin, stdout
)
import Network.URI (parseURIReference)
import Control.Monad.Trans (MonadTrans(..))
import Control.Monad.State (modify, gets)
import Control.Monad (liftM, when)
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as IO
import System.IO.Error
import Data.Maybe (isJust, fromMaybe)
swishFormat :: SwishFormat -> Maybe String -> SwishStateIO ()
swishFormat fmt _ = modify (setFormat fmt)
swishBase :: Maybe QName -> Maybe String -> SwishStateIO ()
swishBase mb _ = modify (setBase mb)
swishInput :: Maybe String -> SwishStateIO ()
swishInput fnam =
swishReadGraph fnam >>= maybe (return ()) (modify . setGraph)
swishMerge :: Maybe String -> SwishStateIO ()
swishMerge fnam =
swishReadGraph fnam >>= maybe (return ()) (modify . mergeGraph)
mergeGraph :: RDFGraph -> SwishState -> SwishState
mergeGraph gr state = state { graph = newgr }
where
newgr = merge gr (graph state)
swishCompare :: Maybe String -> SwishStateIO ()
swishCompare fnam =
swishReadGraph fnam >>= maybe (return ()) compareGraph
compareGraph :: RDFGraph -> SwishStateIO ()
compareGraph gr = do
oldGr <- gets graph
let exitCode = if gr == oldGr then SwishSuccess else SwishGraphCompareError
modify $ setStatus exitCode
swishGraphDiff :: Maybe String -> SwishStateIO ()
swishGraphDiff fnam =
swishReadGraph fnam >>= maybe (return ()) diffGraph
diffGraph :: RDFGraph -> SwishStateIO ()
diffGraph gr = do
oldGr <- gets graph
let p1 = partitionGraph (getArcs oldGr)
p2 = partitionGraph (getArcs gr)
diffs = comparePartitions p1 p2
swishWriteFile (swishOutputDiffs diffs) Nothing
swishOutputDiffs :: (Label lb) =>
[(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
-> Maybe String
-> Handle
-> SwishStateIO ()
swishOutputDiffs diffs fnam hnd = do
lift $ hPutStrLn hnd ("Graph differences: "++show (length diffs))
mapM_ (swishOutputDiff fnam hnd) (zip [1..] diffs)
swishOutputDiff :: (Label lb) =>
Maybe String
-> Handle
-> (Int,(Maybe (GraphPartition lb),Maybe (GraphPartition lb)))
-> SwishStateIO ()
swishOutputDiff fnam hnd (diffnum,(part1,part2)) = do
lift $ hPutStrLn hnd ("---- Difference "++show diffnum++" ----")
lift $ hPutStr hnd "Graph 1:"
swishOutputPart fnam hnd part1
lift $ hPutStr hnd "Graph 2:"
swishOutputPart fnam hnd part2
swishOutputPart :: (Label lb) =>
Maybe String
-> Handle
-> Maybe (GraphPartition lb)
-> SwishStateIO ()
swishOutputPart _ hnd part =
let out = maybe "\n(No arcs)" (partitionShowP "\n") part
in lift $ hPutStrLn hnd out
swishScript :: Maybe String -> SwishStateIO ()
swishScript fnam = swishReadScript fnam >>= mapM_ swishCheckResult
swishReadScript :: Maybe String -> SwishStateIO [SwishStateIO ()]
swishReadScript = swishReadFile swishParseScript []
defURI :: QName
defURI = "http://id.ninebynine.org/2003/Swish/"
calculateBaseURI ::
Maybe FilePath
-> SwishStateIO QName
calculateBaseURI Nothing = fromMaybe defURI `liftM` gets base
calculateBaseURI (Just fnam) =
case parseURIReference fnam of
Just furi -> do
mbase <- gets base
case mbase of
Just buri -> case appendURIs (getQNameURI buri) furi of
Left emsg -> fail emsg
Right res -> return $ qnameFromURI res
Nothing -> lift $ qnameFromFilePath fnam
Nothing -> fail $ "Unable to convert to URI: filepath=" ++ fnam
swishParseScript ::
Maybe String
-> T.Text
-> SwishStateIO [SwishStateIO ()]
swishParseScript mfpath inp = do
buri <- calculateBaseURI mfpath
case parseScriptFromText (Just buri) inp of
Left err -> do
let inName = maybe "standard input" ("file " ++) mfpath
swishError ("Script syntax error in " ++ inName ++ ": "++err) SwishDataInputError
return []
Right scs -> return scs
swishCheckResult :: SwishStateIO () -> SwishStateIO ()
swishCheckResult swishcommand = do
swishcommand
er <- gets errormsg
case er of
Just x -> swishError x SwishExecutionError >> modify resetError
_ -> return ()
ms <- gets infomsg
case ms of
Just x -> reportLine x >> modify resetInfo
_ -> return ()
swishOutput :: Maybe String -> SwishStateIO ()
swishOutput = swishWriteFile swishOutputGraph
swishOutputGraph :: Maybe String -> Handle -> SwishStateIO ()
swishOutputGraph _ hnd = do
fmt <- gets format
let writeOut formatter = do
out <- gets $ formatter . graph
lift $ IO.hPutStrLn hnd out
case fmt of
N3 -> writeOut N3F.formatGraphAsLazyText
NT -> writeOut NTF.formatGraphAsLazyText
Turtle -> writeOut TTLF.formatGraphAsLazyText
swishReadGraph :: Maybe String -> SwishStateIO (Maybe RDFGraph)
swishReadGraph = swishReadFile swishParse Nothing
swishReadFile ::
(Maybe String -> T.Text -> SwishStateIO a)
-> a
-> Maybe String
-> SwishStateIO a
swishReadFile conv errVal fnam =
let reader (h,f,i) = do
res <- conv fnam i
when f $ lift $ hClose h
return res
in swishOpenFile fnam >>= maybe (return errVal) reader
swishOpenFile :: Maybe String -> SwishStateIO (Maybe (Handle, Bool, T.Text))
swishOpenFile Nothing = readFromHandle stdin Nothing
swishOpenFile (Just fnam) = do
o <- lift $ try $ openFile fnam ReadMode
case o of
Left _ -> do
swishError ("Cannot open file: "++fnam) SwishDataAccessError
return Nothing
Right hnd -> readFromHandle hnd $ Just ("file: " ++ fnam)
readFromHandle :: Handle -> Maybe String -> SwishStateIO (Maybe (Handle, Bool, T.Text))
readFromHandle hdl mlbl = do
hrd <- lift $ hIsReadable hdl
if hrd
then do
fc <- lift $ IO.hGetContents hdl
return $ Just (hdl, isJust mlbl, fc)
else do
lbl <- case mlbl of
Just l -> lift (hClose hdl) >> return l
Nothing -> return "standard input"
swishError ("Cannot read from " ++ lbl) SwishDataAccessError
return Nothing
swishParse ::
Maybe String
-> T.Text
-> SwishStateIO (Maybe RDFGraph)
swishParse mfpath inp = do
fmt <- gets format
buri <- calculateBaseURI mfpath
let toError eMsg =
swishError (show fmt ++ " syntax error in " ++ inName ++ ": " ++ eMsg) SwishDataInputError
>> return Nothing
inName = maybe "standard input" ("file " ++) mfpath
readIn reader = case reader inp of
Left eMsg -> toError eMsg
Right res -> return $ Just res
case fmt of
Turtle -> readIn (`parseTurtle` Just (getQNameURI buri))
N3 -> readIn (`parseN3` Just buri)
NT -> readIn parseNT
swishWriteFile ::
(Maybe String -> Handle -> SwishStateIO ())
-> Maybe String
-> SwishStateIO ()
swishWriteFile conv fnam =
let hdlr (h, c) = conv fnam h >> when c (lift $ hClose h)
in swishCreateWriteableFile fnam >>= maybe (return ()) hdlr
swishCreateWriteableFile :: Maybe String -> SwishStateIO (Maybe (Handle,Bool))
swishCreateWriteableFile Nothing = do
hwt <- lift $ hIsWritable stdout
if hwt
then return $ Just (stdout, False)
else do
swishError "Cannot write to standard output" SwishDataAccessError
return Nothing
swishCreateWriteableFile (Just fnam) = do
o <- lift $ try $ openFile fnam WriteMode
case o of
Left _ -> do
swishError ("Cannot open file for writing: " ++ fnam) SwishDataAccessError
return Nothing
Right hnd -> do
hwt <- lift $ hIsWritable hnd
if hwt
then return $ Just (hnd, True)
else do
lift $ hClose hnd
swishError ("Cannot write to file: "++fnam) SwishDataAccessError
return Nothing