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