    {-# 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 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 (liftM, 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 = modify . setFormat

    -- | Set (or clear) the base URI.
    swishBase :: Maybe QName -> SwishStateIO ()
    swishBase = modify . 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 fnam =
      swishReadGraph fnam >>= maybe (return ()) (modify . 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 fnam =
      swishReadGraph fnam >>= maybe (return ()) (modify . mergeGraph)

    mergeGraph :: RDFGraph -> SwishState -> SwishState
    mergeGraph gr state = state { graph = newgr }
        where
            newgr = merge gr (graph 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 fnam =
      swishReadGraph fnam >>= maybe (return ()) compareGraph

    compareGraph :: RDFGraph -> SwishStateIO ()
    compareGraph gr = do
      oldGr <- gets graph
      let exitCode = if gr == oldGr then SwishSuccess else SwishGraphCompareError
      modify $ setStatus exitCode

    ------------------------------------------------------------
    --  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 fnam =
      swishReadGraph fnam >>= maybe (return ()) diffGraph

    diffGraph :: RDFGraph -> SwishStateIO ()
    diffGraph gr = do
      oldGr <- gets graph
      let p1 = partitionGraph (S.toList $ getArcs oldGr)
          p2 = partitionGraph (S.toList $ getArcs gr)
          diffs = comparePartitions p1 p2

      swishWriteFile (swishOutputDiffs diffs) Nothing

    swishOutputDiffs :: (Label lb) =>
        [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
        -> Maybe String
        -> Handle
        -> SwishStateIO ()
    swishOutputDiffs diffs fnam hnd = do
      lift $ hPutStrLn hnd ("Graph differences: "++show (length diffs))
      mapM_ (swishOutputDiff fnam hnd) (zip [1..] diffs)

    swishOutputDiff :: (Label lb) =>
        Maybe String
        -> Handle
        -> (Int,(Maybe (GraphPartition lb),Maybe (GraphPartition lb)))
        -> SwishStateIO ()
    swishOutputDiff fnam hnd (diffnum,(part1,part2)) = do
      lift $ hPutStrLn hnd ("---- Difference "++show diffnum++" ----")
      lift $ hPutStr hnd "Graph 1:"
      swishOutputPart fnam hnd part1
      lift $ hPutStr hnd "Graph 2:"
      swishOutputPart fnam hnd part2

    swishOutputPart :: (Label lb) =>
        Maybe String
        -> Handle
        -> Maybe (GraphPartition lb)
        -> SwishStateIO ()
    swishOutputPart _ hnd part =
      let out = maybe "\n(No arcs)" (partitionShowP "\n") part
      in lift $ hPutStrLn hnd out

    ------------------------------------------------------------
    --  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 fnam = swishReadScript fnam >>= mapM_ swishCheckResult

    swishReadScript :: Maybe String -> SwishStateIO [SwishStateIO ()]
    swishReadScript = swishReadFile 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 = "http://id.ninebynine.org/2003/Swish/"

    calculateBaseURI ::
      Maybe FilePath -- ^ file name
      -> SwishStateIO QName -- ^ base URI
    calculateBaseURI Nothing = fromMaybe defURI `liftM` gets base
    calculateBaseURI (Just fnam) =
      case parseURIReference fnam of
        Just furi -> do
          mbase <- gets base
          case mbase of
            Just buri -> case appendURIs (getQNameURI buri) furi of
              Left emsg -> fail emsg -- TODO: think about this ...
              Right res -> return $ fromMaybe defURI (qnameFromURI res)
            Nothing -> lift $ qnameFromFilePath fnam

        Nothing -> fail $ "Unable to convert to URI: filepath=" ++ fnam

    swishParseScript ::
      Maybe String -- file name (or "stdin" if Nothing)
      -> T.Text    -- script contents
      -> SwishStateIO [SwishStateIO ()]
    swishParseScript mfpath inp = do
      buri <- calculateBaseURI mfpath
      case parseScriptFromText (Just buri) inp of
        Left err -> do
          let inName = maybe "standard input" ("file " ++) mfpath
          swishError ("Script syntax error in " ++ inName ++ ": "++err) SwishDataInputError
          return []

        Right scs -> return scs

    swishCheckResult :: SwishStateIO () -> SwishStateIO ()
    swishCheckResult swishcommand = do
      swishcommand
      er <- gets errormsg
      case er of
        Just x -> swishError x SwishExecutionError >> modify resetError
        _      -> return ()

      ms <- gets infomsg
      case ms of
        Just x -> reportLine x >> modify resetInfo
        _      -> return ()

    -- | Write out the current graph.
    swishOutput ::
        Maybe String       -- ^ A filename or, if 'Nothing', then use standard output.
        -> SwishStateIO ()
    swishOutput = swishWriteFile swishOutputGraph

    swishOutputGraph :: Maybe String -> Handle -> SwishStateIO ()
    swishOutputGraph _ hnd = do
      fmt <- gets format

      let writeOut formatter = do
            out <- gets $ formatter . graph
            lift $ IO.hPutStrLn hnd out

      case fmt of
        N3 -> writeOut N3F.formatGraphAsLazyText
        NT -> writeOut NTF.formatGraphAsLazyText
        Turtle -> writeOut TTLF.formatGraphAsLazyText
        -- _  -> 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 = swishReadFile swishParse 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 conv errVal fnam =
      let reader (h,f,i) = do
            res <- conv fnam i
            when f $ lift $ hClose h -- given that we use IO.hGetContents not sure the close is needed
            return res

      in swishOpenFile fnam >>= maybe (return errVal) reader

    -- open a file in the SwishStateIO monad, catching
    -- any errors
    --
    sOpen :: FilePath -> IOMode -> SwishStateIO (Either IOError Handle)
    sOpen fp fm = lift . CE.try $ openFile fp 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 Nothing     = readFromHandle stdin Nothing
    swishOpenFile (Just fnam) = do
      o <- sOpen fnam ReadMode
      case o of
        Left _    -> do
          swishError ("Cannot open file: "++fnam) SwishDataAccessError
          return Nothing

        Right hnd -> readFromHandle hnd $ Just ("file: " ++ fnam)

    readFromHandle :: Handle -> Maybe String -> SwishStateIO (Maybe (Handle, Bool, T.Text))
    readFromHandle hdl mlbl = do
      hrd <- lift $ hIsReadable hdl
      if hrd
        then do
          fc <- lift $ IO.hGetContents hdl
          return $ Just (hdl, isJust mlbl, fc)

        else do
          lbl <- case mlbl of
            Just l  -> lift (hClose hdl) >> return l
            Nothing -> return "standard input"
          swishError ("Cannot read from " ++ lbl) SwishDataAccessError
          return Nothing

    swishParse ::
      Maybe String -- ^ filename (if not stdin)
      -> T.Text    -- ^ contents of file
      -> SwishStateIO (Maybe RDFGraph)
    swishParse mfpath inp = do
      fmt <- gets format
      buri <- calculateBaseURI mfpath

      let toError eMsg =
            swishError (show fmt ++ " syntax error in " ++ inName ++ ": " ++ eMsg) SwishDataInputError
            >> return Nothing

          inName = maybe "standard input" ("file " ++) mfpath

          readIn reader = case reader inp of
            Left eMsg -> toError eMsg
            Right res -> return $ Just res

      case fmt of
        Turtle -> readIn (`parseTurtle` Just (getQNameURI buri))
        N3 -> readIn (`parseN3` Just buri)
        NT -> readIn parseNT
        {-
        _  -> 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 conv fnam =
      let hdlr (h, c) = conv fnam h >> when c (lift $ hClose h)
      in swishCreateWriteableFile fnam >>= maybe (return ()) 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 Nothing = do
      hwt <- lift $ hIsWritable stdout
      if hwt
        then return $ Just (stdout, False)
        else do
          swishError "Cannot write to standard output" SwishDataAccessError
          return Nothing

    swishCreateWriteableFile (Just fnam) = do
      o <- sOpen fnam WriteMode
      case o of
        Left _ -> do
          swishError ("Cannot open file for writing: " ++ fnam) SwishDataAccessError
          return Nothing

        Right hnd -> do
          hwt <- lift $ hIsWritable hnd
          if hwt
            then return $ Just (hnd, True)
            else do
              lift $ hClose hnd
              swishError ("Cannot write to file: "++fnam) SwishDataAccessError
              return Nothing

    --------------------------------------------------------------------------------
    --
    --  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
    --    2011, 2012 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
    --
    --------------------------------------------------------------------------------