--------------------------------------------------------------------
-- |
-- Module     : System.IO.Lazy.Input.Internals
-- Copyright  : (c) Nicolas Pouillard 2009
-- License    : BSD3
--
-- Maintainer : Nicolas Pouillard <nicolas.pouillard@gmail.com>
-- Stability  : provisional
-- Portability:
--
--------------------------------------------------------------------

module System.IO.Lazy.Input.Internals
(
  -- * Finalized values
  Finalized(..),
  finalize,

  -- * Lazy inputs internals
  LI(..),
  nonFinalized,
  finallyLI,

  -- * Misc
  mapFinalized,
  catchEOF,
  -- simpleUnsafeHGetContents,
  chanFromList,
  rnfList
)
where

import System.IO (Handle)
import qualified System.IO as IO
import qualified System.IO.Error as IO
import System.IO.Unsafe (unsafeInterleaveIO)
import Control.Exception (finally, throwIO)
import Control.Parallel.Strategies (NFData(..))
import Control.Concurrent.Chan (Chan)
import qualified Control.Concurrent.Chan as CH
import Control.Monad
import Control.Applicative

-- | Values with their finalizer.
data Finalized a = Finally { finalized :: a
                           , finalizer :: IO () -- NOTE this field must be lazy, look at 'append'
                           }

instance Functor Finalized where
   fmap f (a `Finally` finalizeA) = f a `Finally` finalizeA

instance Applicative Finalized where
   pure x = x `Finally` return ()
   (f `Finally` finalizeF) <*> (x `Finally` finalizeX) = f x `Finally` (finalizeF >> finalizeX)

-- | Run a /finalized/ computation.
finalize :: Finalized (IO a) -> IO a
finalize (f `Finally` finalizeF) = f `finally` finalizeF

-- | This the type lazy input data.
--
-- Note that the lazy input type ('LI') is a member of 'Functor',
-- this means that one can update the contents of the input with
-- any pure function.
--
-- 'LI' could be a strict monad and a strict applicative functor.
-- However it is not a lazy monad nor a lazy applicative functor as required Haskell.
-- Hopefully it is a lazy (pointed) functor at least.
newtype LI a = LI { startLI :: IO (Finalized a) }

instance Functor LI where
   fmap f = LI . fmap (fmap f) . startLI

-- | Update the underlying 'Finalized' value.
mapFinalized :: (Finalized a -> Finalized b) -> LI a -> LI b
mapFinalized f = LI . fmap f . startLI

-- | Build lazy input ('LI') from an 'IO' computation and a 'finalizer'.
finallyLI :: IO a -> IO () -> LI a
finallyLI x finalizeX = LI $ (`Finally` finalizeX) <$> x

-- | Build lazy input ('LI') from an 'IO' computation.
-- Use this function when the computation does not require a finalizer.
nonFinalized :: IO a -> LI a
nonFinalized = LI . fmap pure

{-
-- |
-- 'simpleUnsafeHGetContents' behave pretty much the same as
-- 'System.IO.hGetContents' but does not discard I\/O errors encountered
-- which a handle is semi-closed, this is mhy this function is unsafe.
--
-- Computation 'simpleUnsafeGetContents' @hdl@ returns the list of characters
-- corresponding to the unread portion of the channel or file managed
-- by @hdl@, which is put into an intermediate state, /semi-closed/.
-- In this state, @hdl@ is effectively closed,
-- but items are read from @hdl@ on demand and accumulated in a special
-- list returned by 'simpleUnsafeGetContents' @hdl@.
--
-- Any operation that fails because a handle is closed,
-- also fails if a handle is semi-closed.  The only exception is 'hClose'.
-- A semi-closed handle becomes closed:
--
--  * if 'hClose' is applied to it;
--
--  * if an I\/O error occurs when reading an item from the handle;
--
--  * or once the entire contents of the handle has been read.
--
-- Once a semi-closed handle becomes closed, the contents of the
-- associated list becomes fixed.  The contents of this final list is
-- only partially specified: it will contain at least all the items of
-- the stream that were evaluated prior to the handle becoming closed.
--
-- Any I\/O errors encountered while a handle is semi-closed are simply
-- discarded.
--
-- This operation may fail with:
--
--  * 'isEOFError' if the end of file has been reached.
simpleUnsafeHGetContents :: Handle -> IO String
simpleUnsafeHGetContents h = unsafeInterleaveIO $ (do
  x  <- IO.hGetChar h
  xs <- simpleUnsafeHGetContents h
  return (x : xs)
 ) `catchEOF` return []
-}

-- | @x \`catchEOF\` y@ performs @x@ and if it fails due to the EOF error then performs @y@.
catchEOF :: IO a -> IO a -> IO a
x `catchEOF` y = x `catch` (\e -> if IO.isEOFError e then y else throwIO e)

-- | Take a list and returns a new channel the list written in it.
chanFromList :: [a] -> IO (Chan a)
chanFromList xs = do
  ch <- CH.newChan
  CH.writeList2Chan ch xs
  return ch

-- | This function lazily returns an element strict list.
-- It is lazier than @rnf@ and stricter than @map (\\x-> rnf x `seq` x)@.
rnfList :: NFData sa => [sa] -> [sa]
rnfList []     = []
rnfList (x:xs) = rnf x `seq` (x:rnfList xs)