content: {-# OPTIONS_GHC -cpp  #-}
  {-# OPTIONS -fglasgow-exts #-}
  {-# LANGUAGE MultiParamTypeClasses, OverlappingInstances, UndecidableInstances, FunctionalDependencies, NoMonomorphismRestriction #-}
  {-+
  This module defines a number of classes that captures various forms of IO.
  This allows code to specify IO operations without being tied directly to
  the standard #IO# monad.
  
  Instances for the standard #IO# type as well as for all monad transformers
  (for all classes except one) are provided. This allows the IO operations to
  be used without explicit lifting in monads that extend the IO monad by
  an arbitrary number of monad transformers.
  
  Note that we redefine some functions exported from the #Prelude#. To be able
  to use these, you need to refer to them by a qualified name, or exclude the
  Prelude functions from the unqualified name space by explicitly importing
  the #Prelude# and hiding them (as shown below, for example).
  
  By the way, it *is* annoying that #Functor# isn't a superclass of
   #Monad#, isn't it!
  -}
  module AbstractIO(module AbstractIO,
  		  IOError,ClockTime,S.ExitCode(..)) where
  import Prelude hiding (readFile,writeFile, appendFile,
  		       putStr,putStrLn,print,
  		       getLine,readLn,getContents,
  		       catch,ioError,userError)
  import qualified Prelude
  import qualified System.Directory as D
  -- import qualified System as S
  import qualified System.Exit as S
  import qualified System.Cmd as S
  import qualified System.Environment as S
  
  import qualified System.IO as IO
  import qualified System.IO.Error as IO
  
  import qualified System.Time as Time
  import System.Time(ClockTime,CalendarTime)
  import MT(MT(..))
  
  
  {-+
  Reading and writing files
  -------------------------
  -}
  class (Functor io,Monad io) => FileIO io where
    readFile :: FilePath -> io String
    writeFile :: FilePath -> String -> io ()
    appendFile :: FilePath -> String -> io ()
  
  instance FileIO IO where
    readFile = Prelude.readFile
    writeFile = Prelude.writeFile
    appendFile = Prelude.appendFile
  
  instance (MT t,Functor (t m),Monad (t m),FileIO m) => FileIO (t m) where
    readFile             = lift . readFile
    writeFile path       = lift . writeFile path
    appendFile path      = lift . appendFile path
  
  {-+
  Standard IO
  -----------
  (For messages in the terminal window and user input.)
  -}
  class (Functor io,Monad io) => StdIO io where
    putStr,putStrLn,ePutStr,ePutStrLn :: String -> io ()
    getLine :: io String -- blocking IO is considered bad by some... :-)
    getContents :: io String
  
    putStrLn s = putStr s >> putStr "\n"
    ePutStrLn s = ePutStr s >> ePutStr "\n"
  
  print x = putStrLn (show x)
  
  readIO s =  case [x | (x,t) <- reads s, ("","") <- lex t] of
                [x] -> return x
                []  -> ioError (userError "Prelude.readIO: no parse")
                _   -> ioError (userError "Prelude.readIO: ambiguous parse")
  
  instance StdIO IO where
    putStr    = Prelude.putStr
    putStrLn  = Prelude.putStrLn
    ePutStr   = IO.hPutStr IO.stderr
    ePutStrLn = IO.hPutStrLn IO.stderr
    getLine  = Prelude.getLine
    getContents = Prelude.getContents
  
  instance (MT t,Functor (t m),Monad (t m),StdIO m) => StdIO (t m) where
    putStr   = lift . putStr
    putStrLn = lift . putStrLn
    ePutStr   = lift . ePutStr
    ePutStrLn = lift . ePutStrLn
    getLine  = lift getLine
    getContents = lift getContents
  
  {-+
  System interaction
  ------------------
  Operations corresponding to the standard library module #System#.
  (Executing shell commands and other interaction with command line shells.)
  -}
  
  
  class (Functor io,Monad io) => SystemIO io where
    system :: String -> io S.ExitCode
    getEnv :: String -> io String
    getProgName :: io String
    getArgs :: io [String]
    -- ... exitWith
  
  instance SystemIO IO where
    system = S.system
    getEnv = S.getEnv
    getProgName = S.getProgName
    getArgs = S.getArgs
  
  instance (MT t,Functor (t m),Monad (t m),SystemIO m) => SystemIO (t m) where
    system = lift . system
    getEnv = lift . getEnv
    getProgName = lift getProgName
    getArgs = lift getArgs
  
  {-+
  Directory manipulation
  ----------------------
  Operations corresponding to the standard library module #Directory#.
  -}
  
  class (Functor io,Monad io) => DirectoryIO io where
    createDirectory,removeFile :: FilePath -> io ()
    getModificationTime :: FilePath -> io ClockTime
    doesFileExist, doesDirectoryExist :: FilePath -> io Bool
    getDirectoryContents :: FilePath -> io [FilePath]
  
  -- Base case:
  instance DirectoryIO IO where
    createDirectory = D.createDirectory
    getModificationTime = D.getModificationTime
    doesFileExist = D.doesFileExist
    doesDirectoryExist = D.doesDirectoryExist . dropFinalSlash
    getDirectoryContents = D.getDirectoryContents
    removeFile = D.removeFile
  
  -- Quick workaround for a Cygwin problem:
  dropFinalSlash = reverse . dropit . reverse
    where dropit ('/':s) = s
  	dropit s = s
  
  -- Inductive case:
  instance (MT t,Functor (t m),Monad (t m),DirectoryIO m)
        => DirectoryIO (t m) where
    createDirectory      = lift . createDirectory
    getModificationTime  = lift . getModificationTime
    doesFileExist        = lift . doesFileExist
    doesDirectoryExist   = lift . doesDirectoryExist
    getDirectoryContents = lift . getDirectoryContents
    removeFile           = lift . removeFile
  
  {-+
  Time functions
  ----------------------
  Operations corresponding to the standard library module #Time#.
  (Only the subset requiring IO.)
  -}
  
  class (Functor m,Monad m) => TimeIO m where
    getClockTime :: m ClockTime
    toCalendarTime :: ClockTime -> m CalendarTime
  
  instance TimeIO IO where
    getClockTime = Time.getClockTime
    toCalendarTime = Time.toCalendarTime
  
  instance (MT t,Functor (t m),Monad (t m),TimeIO m) => TimeIO (t m) where
    getClockTime = lift getClockTime
    toCalendarTime = lift . toCalendarTime
  
  
  {-+
  Catching errors
  ---------------
  
  This is the only class that lacks a general instance for monad transformers.
  (It is probably a good idea to try to survive without relying on error
  handlers...)
  -}
  
  class (Functor io,Monad io) => CatchIO ioerror io | io->ioerror where
    catch :: io a -> (ioerror -> io a) -> io a
    ioError :: ioerror -> io a
  
  try m = fmap Right m `catch` (return . Left)
  maybeM m = (Just `fmap` m) `catch` const (return Nothing)
  
  bracket before after m =
    do x <- before
       r <- try (m x)
       after x
       returnTry r
  
  bracket_ before after m =
    do x <- before
       r <- try m
       after x
       returnTry r
  
  tryThen m after =
    do r <- try m
       after
       returnTry r
  
  returnTry r = either ioError return r
  
  instance CatchIO IOError IO where
    catch = Prelude.catch
    ioError = Prelude.ioError
  
  --instance (MT t,Functor (t m),Monad (t m),CatchIO m) => CatchIO (t m) where
    -- !! How do you lift operations with negative occurences of m?
  
  class IOErr ioerror where
    userError :: String -> ioerror
    isDoesNotExistError,isUserError :: ioerror -> Bool
    ioeGetErrorString :: ioerror -> String
    -- ..., ioeGetFileName, ...
  
  instance IOErr IOError where
    userError = IO.userError
    isDoesNotExistError = IO.isDoesNotExistError
    isUserError = IO.isUserError
    ioeGetErrorString = IO.ioeGetErrorString
  