{-# 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify 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 = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) RDFGraph -> SwishStateIO ()
compareGraph
    
compareGraph :: RDFGraph -> SwishStateIO ()
compareGraph :: RDFGraph -> SwishStateIO ()
compareGraph RDFGraph
gr = do
  RDFGraph
oldGr <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SwishState -> RDFGraph
graph
  let exitCode :: SwishStatus
exitCode = if RDFGraph
gr forall a. Eq a => a -> a -> Bool
== RDFGraph
oldGr then SwishStatus
SwishSuccess else SwishStatus
SwishGraphCompareError
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) RDFGraph -> SwishStateIO ()
diffGraph

diffGraph :: RDFGraph -> SwishStateIO ()
diffGraph :: RDFGraph -> SwishStateIO ()
diffGraph RDFGraph
gr = do
  RDFGraph
oldGr <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SwishState -> RDFGraph
graph
  let p1 :: PartitionedGraph RDFLabel
p1 = forall lb. Label lb => [Arc lb] -> PartitionedGraph lb
partitionGraph (forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs RDFGraph
oldGr)
      p2 :: PartitionedGraph RDFLabel
p2 = forall lb. Label lb => [Arc lb] -> PartitionedGraph lb
partitionGraph (forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ forall (lg :: * -> *) lb. LDGraph lg lb => lg lb -> ArcSet lb
getArcs RDFGraph
gr)
      diffs :: [(Maybe (GraphPartition RDFLabel),
  Maybe (GraphPartition RDFLabel))]
diffs = 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 (forall lb.
Label lb =>
[(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
-> Maybe String -> Handle -> SwishStateIO ()
swishOutputDiffs [(Maybe (GraphPartition RDFLabel),
  Maybe (GraphPartition RDFLabel))]
diffs) 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
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
hnd (String
"Graph differences: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Maybe (GraphPartition lb), Maybe (GraphPartition lb))]
diffs))
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall lb.
Label lb =>
Maybe String
-> Handle
-> (Int, (Maybe (GraphPartition lb), Maybe (GraphPartition lb)))
-> SwishStateIO ()
swishOutputDiff Maybe String
fnam Handle
hnd) (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
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
hnd (String
"---- Difference " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
diffnum forall a. [a] -> [a] -> [a]
++ String
" ----")
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
hnd String
"Graph 1:"
  forall lb.
Label lb =>
Maybe String
-> Handle -> Maybe (GraphPartition lb) -> SwishStateIO ()
swishOutputPart Maybe String
fnam Handle
hnd Maybe (GraphPartition lb)
part1
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
hnd String
"Graph 2:"
  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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"\n(No arcs)" (forall lb. Label lb => String -> GraphPartition lb -> String
partitionShowP String
"\n") Maybe (GraphPartition lb)
part
  in forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = 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 = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. a -> Maybe a -> a
fromMaybe QName
defURI 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 <- 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 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
emsg -- TODO: think about this ...
          Right URI
res -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe QName
defURI (URI -> Maybe QName
qnameFromURI URI
res)
        Maybe QName
Nothing -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ String -> IO QName
qnameFromFilePath String
fnam
        
    Maybe URI
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unable to convert to URI: filepath=" 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 (forall a. a -> Maybe a
Just QName
buri) Text
inp of
    Left String
err -> do
      let inName :: String
inName = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"standard input" (String
"file " forall a. [a] -> [a] -> [a]
++) Maybe String
mfpath
      String -> SwishStatus -> SwishStateIO ()
swishError (String
"Script syntax error in " forall a. [a] -> [a] -> [a]
++ String
inName forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
err) SwishStatus
SwishDataInputError
      forall (m :: * -> *) a. Monad m => a -> m a
return []
              
    Right [SwishStateIO ()]
scs -> 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 <- 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify SwishState -> SwishState
resetError
    Maybe String
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    
  Maybe String
ms <- 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify SwishState -> SwishState
resetInfo
    Maybe String
_      -> 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 <- 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ RDFGraph -> Text
formatter forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwishState -> RDFGraph
graph
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
IO.hPutStrLn Handle
hnd Text
out
        
  case SwishFormat
fmt of
    SwishFormat
N3 -> forall {t :: (* -> *) -> * -> *}.
(MonadState SwishState (t IO), MonadTrans t) =>
(RDFGraph -> Text) -> t IO ()
writeOut RDFGraph -> Text
N3F.formatGraphAsLazyText
    SwishFormat
NT -> forall {t :: (* -> *) -> * -> *}.
(MonadState SwishState (t IO), MonadTrans t) =>
(RDFGraph -> Text) -> t IO ()
writeOut RDFGraph -> Text
NTF.formatGraphAsLazyText
    SwishFormat
Turtle -> 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 = forall a.
(Maybe String -> Text -> SwishStateIO a)
-> a -> Maybe String -> SwishStateIO a
swishReadFile Maybe String -> Text -> SwishStateIO (Maybe RDFGraph)
swishParse 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
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
f forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h -- given that we use IO.hGetContents not sure the close is needed
        forall (m :: * -> *) a. Monad m => a -> m a
return a
res
  
  in Maybe String -> SwishStateIO (Maybe (Handle, Bool, Text))
swishOpenFile Maybe String
fnam forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
CE.try 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 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: " forall a. [a] -> [a] -> [a]
++ String
fnam) SwishStatus
SwishDataAccessError
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      
    Right Handle
hnd -> Handle -> Maybe String -> SwishStateIO (Maybe (Handle, Bool, Text))
readFromHandle Handle
hnd forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (String
"file: " 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
hIsReadable Handle
hdl
  if Bool
hrd
    then do
      Text
fc <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> IO Text
IO.hGetContents Handle
hdl
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Handle
hdl, forall a. Maybe a -> Bool
isJust Maybe String
mlbl, Text
fc)
  
    else do
      String
lbl <- case Maybe String
mlbl of
        Just String
l  -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handle -> IO ()
hClose Handle
hdl) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return String
l
        Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"standard input"
      String -> SwishStatus -> SwishStateIO ()
swishError (String
"Cannot read from " forall a. [a] -> [a] -> [a]
++ String
lbl) SwishStatus
SwishDataAccessError
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- 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 (forall a. Show a => a -> String
show SwishFormat
fmt forall a. [a] -> [a] -> [a]
++ String
" syntax error in " forall a. [a] -> [a] -> [a]
++ String
inName forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
eMsg) SwishStatus
SwishDataInputError 
        forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        
      inName :: String
inName = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"standard input" (String
"file " 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 -> forall {a}. String -> StateT SwishState IO (Maybe a)
toError String
eMsg
        Right a
res -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
res
             
  case SwishFormat
fmt of
    SwishFormat
Turtle -> forall {a}.
(Text -> Either String a) -> StateT SwishState IO (Maybe a)
readIn (Text -> Maybe URI -> ParseResult
`parseTurtle` forall a. a -> Maybe a
Just (QName -> URI
getQNameURI QName
buri))
    SwishFormat
N3 -> forall {a}.
(Text -> Either String a) -> StateT SwishState IO (Maybe a)
readIn (Text -> Maybe QName -> ParseResult
`parseN3` forall a. a -> Maybe a
Just QName
buri)
    SwishFormat
NT -> forall {a}.
(Text -> Either String a) -> StateT SwishState IO (Maybe a)
readIn Text -> ParseResult
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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
c (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
h)
  in Maybe String -> SwishStateIO (Maybe (Handle, Bool))
swishCreateWriteableFile Maybe String
fnam forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
hIsWritable Handle
stdout
  if Bool
hwt
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Handle
stdout, Bool
False)
    else do
      String -> SwishStatus -> SwishStateIO ()
swishError String
"Cannot write to standard output" SwishStatus
SwishDataAccessError
      forall (m :: * -> *) a. Monad m => a -> m a
return 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: " forall a. [a] -> [a] -> [a]
++ String
fnam) SwishStatus
SwishDataAccessError
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      
    Right Handle
hnd -> do
      Bool
hwt <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
hIsWritable Handle
hnd
      if Bool
hwt
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Handle
hnd, Bool
True)
        else do
          forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
hnd
          String -> SwishStatus -> SwishStateIO ()
swishError (String
"Cannot write to file: " forall a. [a] -> [a] -> [a]
++ String
fnam) SwishStatus
SwishDataAccessError
          forall (m :: * -> *) a. Monad m => a -> m a
return 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
--
--------------------------------------------------------------------------------