{-# LANGUAGE RecordWildCards #-}

{- |
Module      :  $Header$
Description :  Main module of io-manager library
Copyright   :  (c) Mihai Maruseac
License     :  BSD3

Maintainer  :  mihai.maruseac@gmail.com
Stability   :  stable
Portability :  portable

A skeleton library to help learners of Haskell concentrate on the
pure-functional aspect and let the IO be handled by the library.
-}
module Training.MM.IOManager
  (
    -- * The @Filename@ type
    Filename

    -- * The @Input@ type
  , Input

    -- * The @Output@ type
  , Output

    -- * Exported for use in main pipeline
  , wrapIO

    -- * Exported to be usable by students
  , getStdIn
  , getInputFile
  , writeStdOut
  , writeStdErr
  , writeOutputFile
  ) where

import qualified Data.Map as Map
import Control.Monad (liftM)
import System.Environment (getArgs)
import qualified System.IO as System

-- | Type of filenames.
type Filename = String

-- | Type of values holding inputs to the program, grouped by input source.
data Input = Input
  { Input -> Filename
stdin :: String
  , Input -> Map Filename Filename
fileInput :: Map.Map Filename String
  }

-- | Type of values holding outputs of the program, grouped by output source.
data Output = Output
  { Output -> Filename
stdout :: String
  , Output -> Filename
stderr :: String
  , Output -> Map Filename Filename
fileOutput :: Map.Map Filename String
  }

-- | Obtains the contents of the standard input as given to the program.
-- Returns a String containing the input without any modification.
getStdIn :: Input -> String
getStdIn :: Input -> Filename
getStdIn = Input -> Filename
stdin

-- | Obtains the contents of an input file. Returns a String containing the
-- input without any modification.
getInputFile :: Input -> Filename -> String
getInputFile :: Input -> Filename -> Filename
getInputFile Input
i Filename
f = Input -> Map Filename Filename
fileInput Input
i forall k a. Ord k => Map k a -> k -> a
Map.! Filename
f

-- | Appends text to the standard output. No newline is printed at the end,
-- the caller must handle it. Returns a new @Output@ value, containing the
-- appended text.
writeStdOut :: Output -> String -> Output
writeStdOut :: Output -> Filename -> Output
writeStdOut o :: Output
o@Output{Filename
Map Filename Filename
fileOutput :: Map Filename Filename
stderr :: Filename
stdout :: Filename
fileOutput :: Output -> Map Filename Filename
stderr :: Output -> Filename
stdout :: Output -> Filename
..} Filename
s = Output
o { stdout :: Filename
stdout = Filename
stdout forall a. [a] -> [a] -> [a]
++ Filename
s }

-- | Appends text to the standard error. No newline is printed at the end, the
-- caller must handle it. Returns a new @Output@ value, containing the
-- appended text.
--
-- Note: When running the program, the standard error text is displayed
-- after the entire text from the standard input is displayed.
writeStdErr :: Output -> String -> Output
writeStdErr :: Output -> Filename -> Output
writeStdErr o :: Output
o@Output{Filename
Map Filename Filename
fileOutput :: Map Filename Filename
stderr :: Filename
stdout :: Filename
fileOutput :: Output -> Map Filename Filename
stderr :: Output -> Filename
stdout :: Output -> Filename
..} Filename
s = Output
o { stderr :: Filename
stderr = Filename
stderr forall a. [a] -> [a] -> [a]
++ Filename
s }

-- | Appends to an output file. If the file does not exist in the @Output@
-- value (this program didn't yet write in it), it is created as a new one.
-- Returns a new @Output@ value, containing the appended text.
writeOutputFile :: Output -> Filename -> String -> Output
writeOutputFile :: Output -> Filename -> Filename -> Output
writeOutputFile o :: Output
o@Output{Filename
Map Filename Filename
fileOutput :: Map Filename Filename
stderr :: Filename
stdout :: Filename
fileOutput :: Output -> Map Filename Filename
stderr :: Output -> Filename
stdout :: Output -> Filename
..} Filename
f Filename
s
  = Output
o { fileOutput :: Map Filename Filename
fileOutput = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. [a] -> [a] -> [a]
(++) Filename
f Filename
s Map Filename Filename
fileOutput }

-- | Reads the input from all the files given as command line arguments and
-- constructs an @Input@ value.
readInput :: IO (Input, Output)
readInput :: IO (Input, Output)
readInput = do
  [Filename]
args <- IO [Filename]
getArgs
  Map Filename Filename
imap <- [Filename] -> Map Filename Filename -> IO (Map Filename Filename)
readInputFiles [Filename]
args forall k a. Map k a
Map.empty
  Filename
input <- IO Filename
getContents
  forall (m :: * -> *) a. Monad m => a -> m a
return (Filename -> Map Filename Filename -> Input
Input Filename
input Map Filename Filename
imap, Filename -> Filename -> Map Filename Filename -> Output
Output Filename
"" Filename
"" forall k a. Map k a
Map.empty)

-- | Writes the contents of an @Output@ value to the needed files.
writeOutput :: Output -> IO ()
writeOutput :: Output -> IO ()
writeOutput Output
o = do
  Filename -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ Output -> Filename
stdout Output
o
  Handle -> Filename -> IO ()
System.hPutStrLn Handle
System.stderr forall a b. (a -> b) -> a -> b
$ Output -> Filename
stderr Output
o
  [(Filename, Filename)] -> IO ()
writeOutputFiles forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ Output -> Map Filename Filename
fileOutput Output
o

-- | Wraps a simple function @Input@ -> @Output@ -> @Output@ in
-- order to simplify student's usage.
wrapIO :: (Input -> Output -> Output) -> IO ()
wrapIO :: (Input -> Output -> Output) -> IO ()
wrapIO Input -> Output -> Output
f = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Input -> Output -> Output
f) IO (Input, Output)
readInput forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Output -> IO ()
writeOutput

-- | Reads all of the input files into the map of the Input value.
readInputFiles :: [Filename]
               -> Map.Map Filename String
               -> IO (Map.Map Filename String)
readInputFiles :: [Filename] -> Map Filename Filename -> IO (Map Filename Filename)
readInputFiles [] Map Filename Filename
m = forall (m :: * -> *) a. Monad m => a -> m a
return Map Filename Filename
m
readInputFiles (Filename
f:[Filename]
fs) Map Filename Filename
m = do
  Filename
content <- Filename -> IO Filename
readFile Filename
f
  [Filename] -> Map Filename Filename -> IO (Map Filename Filename)
readInputFiles [Filename]
fs forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Filename
f Filename
content Map Filename Filename
m

-- | Writes the content of all the output files.
writeOutputFiles :: [(Filename, String)] -> IO ()
writeOutputFiles :: [(Filename, Filename)] -> IO ()
writeOutputFiles [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeOutputFiles ((Filename
f,Filename
s):[(Filename, Filename)]
fs) = Filename -> Filename -> IO ()
writeFile Filename
f Filename
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Filename, Filename)] -> IO ()
writeOutputFiles [(Filename, Filename)]
fs