    {-
    Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org>

    All rights reserved.

    For license and copyright information, see the file LICENSE
    -}

    {- |
       Module     : System.IO.Utils
       Copyright  : Copyright (C) 2004-2011 John Goerzen
       License    : BSD3

       Maintainer : John Goerzen <jgoerzen@complete.org>
       Stability  : provisional
       Portability: portable
    -}

    module System.IO.Utils(-- * Entire File Handle Utilities
                           -- ** Opened Handle Data Copying
                           hCopy, hCopyProgress, hLineCopy, lineCopy,
                           -- ** Disk File Data Copying
                           copyFileLinesToFile,
                           -- * Line Processing Utilities
                           hPutStrLns, hGetLines,
                           -- * Lazy Interaction
                           -- ** Character-based
                           hInteract,
                           -- ** Line-based
                           hLineInteract, lineInteract,
                           -- ** Misc. Lazy
                           lazyMapM,
                           -- * Optimizations
                           optimizeForBatch, optimizeForInteraction
                            ) where

    import System.IO.Unsafe (unsafeInterleaveIO)
    import System.IO
    import Data.List (genericLength)
    import System.IO.HVIO

    {- | Given a list of strings, output a line containing each item, adding
    newlines as appropriate.  The list is not expected to have newlines already.
    -}
    hPutStrLns :: HVIO a => a -> [String] -> IO ()
    hPutStrLns h = mapM_ $ vPutStrLn h

    {- | Given a handle, returns a list of all the lines in that handle.
    Thanks to lazy evaluation, this list does not have to be read all at once.

    Combined with 'hPutStrLns', this can make a powerful way to develop
    filters.  See the 'lineInteract' function for more on that concept.

    Example:

    > main = do
    >        l <- hGetLines stdin
    >        hPutStrLns stdout $ filter (startswith "1") l

    -}

    -- FIXME: does hGetContents h >>= return . lines not work?
    hGetLines :: HVIO a => a -> IO [String]
    hGetLines h = unsafeInterleaveIO (do
                                      ieof <- vIsEOF h
                                      if (ieof)
                                         then return []
                                         else do
                                              line <- vGetLine h
                                              remainder <- hGetLines h
                                              return (line : remainder))

    {- | This is similar to the built-in 'System.IO.interact', but works
    on any handle, not just stdin and stdout.

    In other words:

    > interact = hInteract stdin stdout
    -}
    hInteract :: (HVIO a, HVIO b) => a -> b -> (String -> String) -> IO ()
    hInteract finput foutput func = do
                                    content <- vGetContents finput
                                    vPutStr foutput (func content)

    {- | Line-based interaction.  This is similar to wrapping your
    interact functions with 'lines' and 'unlines'.  This equality holds:

    > lineInteract = hLineInteract stdin stdout

    Here's an example:

    > main = lineInteract (filter (startswith "1"))

    This will act as a simple version of grep -- all lines that start with 1
    will be displayed; all others will be ignored.
    -}
    lineInteract :: ([String] -> [String]) -> IO ()
    lineInteract = hLineInteract stdin stdout

    {- | Line-based interaction over arbitrary handles.  This is similar
    to wrapping hInteract with 'lines' and 'unlines'.

    One could view this function like this:

    > hLineInteract finput foutput func =
    >     let newf = unlines . func . lines in
    >         hInteract finput foutput newf

    Though the actual implementation is this for efficiency:

    > hLineInteract finput foutput func =
    >     do
    >     lines <- hGetLines finput
    >     hPutStrLns foutput (func lines)
    -}
    hLineInteract :: (HVIO a, HVIO b) => a -> b -> ([String] -> [String]) -> IO ()
    hLineInteract finput foutput func =
        do
        lines <- hGetLines finput
        hPutStrLns foutput (func lines)

    {- | Copies from one handle to another in raw mode (using
    hGetContents).
    -}
    hCopy :: (HVIO a, HVIO b) => a -> b -> IO ()
    hCopy hin hout = do
                     c <- vGetContents hin
                     vPutStr hout c

    {- | Copies from one handle to another in raw mode (using hGetContents).
    Takes a function to provide progress updates to the user.
    -}
    hCopyProgress :: (HVIO b, HVIO c, Integral a) =>
                        b        -- ^ Input handle
                     -> c              -- ^ Output handle
                     -> (Maybe a -> Integer -> Bool -> IO ()) -- ^ Progress function -- the bool is always False unless this is the final call
                     -> Int                 -- Block size
                     -> Maybe a             -- Estimated file size (passed to func)
                     -> IO Integer                -- Number of bytes copied
    hCopyProgress hin hout func bsize estsize =
        let copyFunc :: String -> Integer -> IO Integer
            copyFunc [] count = return count
            copyFunc indata count =
                let block = take bsize indata
                    remainder = drop bsize indata
                    newcount = count + (genericLength block)
                    in
                    do
                    vPutStr hout block
                    func estsize count False
                    copyFunc remainder newcount
            in
            do
            c <- vGetContents hin
            bytes <- copyFunc c 0
            func estsize bytes True
            return bytes

    {- | Copies from one handle to another in text mode (with lines).
    Like 'hBlockCopy', this implementation is nice:

    > hLineCopy hin hout = hLineInteract hin hout id
    -}
    hLineCopy :: (HVIO a, HVIO b) => a -> b -> IO()
    hLineCopy hin hout = hLineInteract hin hout id

    {- | Copies from 'stdin' to 'stdout' using lines.  An alias for 'hLineCopy'
    over 'stdin' and 'stdout'. -}
    lineCopy :: IO ()
    lineCopy = hLineCopy stdin stdout

    {- | Copies one filename to another in text mode.

    Please note that the Unix permission bits are set at a default; you may
    need to adjust them after the copy yourself.

    This function is implemented using 'hLineCopy' internally. -}
    copyFileLinesToFile :: FilePath -> FilePath -> IO ()
    copyFileLinesToFile infn outfn = do
                                     hin <- openFile infn ReadMode
                                     hout <- openFile outfn WriteMode
                                     hLineCopy hin hout
                                     hClose hin
                                     hClose hout
                                     return ()

    {- | Sets stdin and stdout to be block-buffered.  This can save a huge amount
    of system resources since far fewer syscalls are made, and can make programs
    run much faster. -}
    optimizeForBatch :: IO ()
    optimizeForBatch = do
                       hSetBuffering stdin (BlockBuffering (Just 4096))
                       hSetBuffering stdout (BlockBuffering (Just 4096))

    {- | Sets stdin and stdout to be line-buffered.  This saves resources
    on stdout, but not many on stdin, since it it still looking for newlines. -}
    optimizeForInteraction :: IO ()
    optimizeForInteraction = do
                             hSetBuffering stdin LineBuffering
                             hSetBuffering stdout LineBuffering

    {- | Applies a given function to every item in a list, and returns
    the new list.  Unlike the system\'s mapM, items are evaluated lazily. -}
    lazyMapM :: (a -> IO b) -> [a] -> IO [b]
    lazyMapM _ [] = return []
    lazyMapM conv (x:xs) =
        do this <- conv x
           next <- unsafeInterleaveIO $ lazyMapM conv xs
           return (this:next)