{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  Commands
--  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2014, 2020 Douglas Burke
--  License     :  GPL V2
--
--  Maintainer  :  Douglas Burke
--  Stability   :  experimental
--  Portability :  FlexibleContexts, OverloadedStrings
--
--  Functions to deal with indivudual Swish command options.
--
--------------------------------------------------------------------------------

module Swish.Commands
    ( swishFormat
    , swishBase
    -- , swishVerbose
    , 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

-- | Set the file format.
--
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

-- | Set (or clear) the base URI.
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

-- | Read in a graph and make it the current graph.
swishInput :: 
    Maybe String       -- ^ A filename or, if 'Nothing', then use standard input.
    -> 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 a b.
StateT SwishState IO a
-> (a -> StateT SwishState IO b) -> StateT SwishState IO b
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 a. a -> StateT SwishState IO a
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)
  
-- | Read in a graph and merge it with the current graph.
swishMerge :: 
    Maybe String       -- ^ A filename or, if 'Nothing', then use standard input.
    -> 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 a b.
StateT SwishState IO a
-> (a -> StateT SwishState IO b) -> StateT SwishState IO b
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 a. a -> StateT SwishState IO a
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 = 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)

-- | Read in a graph and compare it with the current graph.
swishCompare ::
    Maybe String       -- ^ A filename or, if 'Nothing', then use standard input.
    -> 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 a b.
StateT SwishState IO a
-> (a -> StateT SwishState IO b) -> StateT SwishState IO b
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 a. a -> StateT SwishState IO a
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
  
------------------------------------------------------------
--  Display graph differences from named file
------------------------------------------------------------

-- | Read in a graph and display the differences to the current
-- graph to standard output.
swishGraphDiff ::
    Maybe String       -- ^ A filename or, if 'Nothing', then use standard input.
    -> 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 a b.
StateT SwishState IO a
-> (a -> StateT SwishState IO b) -> StateT SwishState IO b
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 a. a -> StateT SwishState IO a
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 :: forall lb.
Label lb =>
[(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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 a. [a] -> 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 :: forall lb.
Label lb =>
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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
diffnum String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ----")
  IO () -> SwishStateIO ()
forall (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 :: forall lb.
Label lb =>
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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

------------------------------------------------------------
--  Execute script from named file
------------------------------------------------------------

-- | Read in a script and execute it.
swishScript ::
    Maybe String       -- ^ A filename or, if 'Nothing', then use standard input.
    -> SwishStateIO ()
swishScript :: Maybe String -> SwishStateIO ()
swishScript Maybe String
fnam = Maybe String -> SwishStateIO [SwishStateIO ()]
swishReadScript Maybe String
fnam SwishStateIO [SwishStateIO ()]
-> ([SwishStateIO ()] -> SwishStateIO ()) -> SwishStateIO ()
forall a b.
StateT SwishState IO a
-> (a -> StateT SwishState IO b) -> StateT SwishState IO b
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 []

{-|
Calculate the base URI to use; it combines the file name
with any user-supplied base.

If both the file name and user-supplied base are Nothing
then the value 

   http://id.ninebynine.org/2003/Swish/

is used.

Needs some work.
-}

defURI :: QName
defURI :: QName
defURI = QName
"http://id.ninebynine.org/2003/Swish/"

calculateBaseURI ::
  Maybe FilePath -- ^ file name
  -> SwishStateIO QName -- ^ base URI
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 a. String -> StateT SwishState IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
emsg -- TODO: think about this ...
          Right URI
res -> QName -> SwishStateIO QName
forall a. a -> StateT SwishState IO a
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 a. String -> StateT SwishState IO a
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 -- file name (or "stdin" if Nothing)
  -> T.Text    -- script contents
  -> 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 a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
              
    Right [SwishStateIO ()]
scs -> [SwishStateIO ()] -> SwishStateIO [SwishStateIO ()]
forall a. a -> StateT SwishState IO a
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 a b.
StateT SwishState IO a
-> StateT SwishState IO b -> StateT SwishState IO b
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 a. a -> StateT SwishState IO a
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 a b.
StateT SwishState IO a
-> StateT SwishState IO b -> StateT SwishState IO b
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 a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Write out the current graph.
swishOutput :: 
    Maybe String       -- ^ A filename or, if 'Nothing', then use standard output.
    -> 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 (m :: * -> *) a. Monad m => m a -> t m a
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
    -- _  -> swishError ("Unsupported file format: "++show fmt) SwishArgumentError

------------------------------------------------------------
--  Common input functions
------------------------------------------------------------
--
--  Keep the logic separate for reading file data and
--  parsing it to an RDF graph value.

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

-- | Open a file (or stdin), read its contents, and process them.
--
swishReadFile :: 
  (Maybe String -> T.Text -> SwishStateIO a) -- ^ Convert filename and contents into desired value
  -> a -- ^ the value to use if the file can not be read in
  -> Maybe String -- ^ the file name or @stdin@ if @Nothing@
  -> SwishStateIO a
swishReadFile :: forall a.
(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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 -- given that we use IO.hGetContents not sure the close is needed
        a -> SwishStateIO a
forall a. a -> StateT SwishState IO 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 a b.
StateT SwishState IO a
-> (a -> StateT SwishState IO b) -> StateT SwishState IO b
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 a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
errVal) (Handle, Bool, Text) -> SwishStateIO a
reader

-- open a file in the SwishStateIO monad, catching
-- any errors
--
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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

-- | Open and read file, returning its handle and content, or Nothing
-- WARNING:  the handle must not be closed until input is fully evaluated
--
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 a. a -> StateT SwishState IO a
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 a. a -> StateT SwishState IO a
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 a b.
StateT SwishState IO a
-> StateT SwishState IO b -> StateT SwishState IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> StateT SwishState IO String
forall a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
l
        Maybe String
Nothing -> String -> StateT SwishState IO String
forall a. a -> StateT SwishState IO a
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 a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Handle, Bool, Text)
forall a. Maybe a
Nothing

swishParse :: 
  Maybe String -- ^ filename (if not stdin)
  -> T.Text    -- ^ contents of file
  -> 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 a b.
StateT SwishState IO a
-> StateT SwishState IO b -> StateT SwishState IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> StateT SwishState IO (Maybe a)
forall a. a -> StateT SwishState IO 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 a. a -> StateT SwishState IO 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
    {-
    _  -> swishError ("Unsupported file format: "++show fmt) SwishArgumentError >>
          return Nothing
    -}
    
swishWriteFile :: 
  (Maybe String -> Handle -> SwishStateIO ()) -- ^ given a file name and a handle, write to it
  -> 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 a b.
StateT SwishState IO a
-> StateT SwishState IO b -> StateT SwishState IO b
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 a b.
StateT SwishState IO a
-> (a -> StateT SwishState IO b) -> StateT SwishState IO b
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 a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Handle, Bool) -> SwishStateIO ()
hdlr
   
-- | Open file for writing, returning its handle, or Nothing
--  Also returned is a flag indicating whether or not the
--  handled should be closed when writing is done (if writing
--  to standard output, the handle should not be closed as the
--  run-time system should deal with that).
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 a. a -> StateT SwishState IO a
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 a. a -> StateT SwishState IO a
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 a. a -> StateT SwishState IO a
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 a. a -> StateT SwishState IO a
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 (m :: * -> *) a. Monad m => m a -> StateT SwishState m a
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 a. a -> StateT SwishState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Handle, Bool)
forall a. Maybe a
Nothing
  
--------------------------------------------------------------------------------
--
--  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
--    2011, 2012, 2014, 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
--
--------------------------------------------------------------------------------