import Data.IORef
import IO
import System.IO.Unsafe
import Control.Monad.State.Lazy
import System.Random

main = putChar 'x'

echo :: IO ()
echo = getChar >>= putChar

echoDup :: IO ()
echoDup = getChar   >>= \c -> 
          putChar c >>= \() -> 
          putChar c

echoDup' :: IO ()
echoDup' = getChar >>=  \c -> 
           putChar c >>
           putChar c

-- Recall that putChar :: Char -> IO ()
-- We want to return (c1,c2) inside of IO monad.
-- Haskell provides "return" function for this purpose:
-- return :: a -> IO a
getTwoChars :: IO(Char,Char)
getTwoChars = getChar >>= \c1 -> 
              getChar >>= \c2 -> 
              return (c1,c2)

-- getLine is defined in Standard Prelude, so rename to getLine'
getLine' :: IO [Char]
getLine' = getChar >>= \c ->
          if c == '\n' then 
             return []
          else 
             getLine' >>= \cs ->
             return (c:cs)

-- Exercise
putLine :: [Char] -> IO ()
putLine [] = putChar '\n'
putLine (x:xs) = putChar x >>
                 putLine xs
-- End exercise

echoRLine :: IO ()
echoRLine = getLine >>= \cs ->
           putLine (reverse cs)

getTwoChars' :: IO(Char,Char)
getTwoChars' = do { c1 <- getChar;
                    c2 <- getChar;
                    return (c1,c2)}


-- Note that the following code shows that:
-- 1) Each c on the left of <- is distinct
-- 2) Scope of x in x <- e does not include e
getCharAndReturn :: IO()
getCharAndReturn = do {c <- getChar;   -- c :: Char
                       c <- putChar c; -- c :: ()
                       return c}

-- Note the nested do notation.
getLine'' :: IO [Char]
getLine'' = do { c <- getChar;
                 if c == '\n' then
                    return []
                 else do { cs <- getLine'';
                           return (c:cs)}}


-- Web server intentionally goes into an infinite loop 
-- awaiting service requests.  We can express this action
-- using the function forever.
forever' :: IO () -> IO ()
forever' a = a >> forever' a
            
repeatN :: Int -> IO () -> IO ()
repeatN 0 a = return ()
repeatN n a = a >> repeatN (n-1) a

-- Example invocations
-- repeatN 2 echoRLine
-- repeatN 10 (putChar 'x')

-- Idea: (for ns fbody) will apply the function fbody to each element of
-- ns in turn, in each case giving an action; these actions are combined
-- in sequence using the >> combinator.
-- fbody is like the body of a for loop, except it is written as a function
-- from the index of the for loop to the actual body.
for :: [a] -> (a -> IO b) -> IO ()
for [] fa = return ()
for (n:ns) fa = fa n >> for ns fa

--Example invocation
-- printNums = for [1..10] print
-- LI: printChars = for ['a'..'d'] print

-- (map fa ns) yields a list of actions
-- sequence_ performs the actions in sequence, throwing away the intermediate results
for' ns fa = sequence_ (map fa ns)

-- BTW: the type of sequence is actually
-- sequence :: (Monad m) => [m a] -> m [a]
-- Monad m is an example of a type constructor class.
-- IO is a type constructor that belongs to the Monad type constructor class.
-- ie, we have (Monad IO)

sequence' :: [IO a] -> IO [a]
sequence' [] = return []
sequence' (a:as) = do {r <- a;
                       rs <- sequence' as;
                       return (r:rs)}

-- Exercise: write a for loop where the body is executed only if the index
-- satisfies a predicate
forPred :: [a] -> (a -> Bool) -> (a -> IO a1) -> IO ()
forPred ns p fa =  sequence_ (map fa (filter p ns))
-- forPred [1..10] even print
-- forPred ['A'..'z'] Char.isUpper print

forStep [] step fa = return ()
forStep (n:ns) step fa = forPred (n:ns) (\i->i `mod` step == n `mod` step) fa


-- Exercise: How modify to be while loop
while' :: (Monad t) => t Bool -> t t1 -> t ()
while' b m = do x <- b
                if x then return () else 
                   do m
                      while' b m

while :: (a -> Bool) -> a -> (a -> IO a) -> IO ()
while p prev body = if p prev then return () 
                              else do {r <- body prev;
                                       while p r body}

mapM' :: (Monad m) => (t -> m a) -> [t] -> m [a]
mapM' f [] = return []
mapM' f (m:ms) = do 
  x <- f m
  xs <- mapM' f ms
  return (x: xs)



-- while (\x->x>10) 0 (\x->do {print x; return (x+1)})

count :: Int -> IO Int
count n = do { r <- newIORef 0;
               loop r 1}
           where 
              loop :: IORef Int -> Int -> IO Int
              loop r i | i>n = readIORef r
                       | otherwise = do {v <- readIORef r;
                                         writeIORef r (v+i);
                                         loop r (i+1)}

type HandleC = (Handle, IORef Int)
openFileC :: String -> IOMode -> IO HandleC
openFileC fn mode = do{ h <- openFile fn mode;
                        v <- newIORef 0;
                        return (h,v)}

hPutStrC :: HandleC -> String -> IO()
hPutStrC (h,r) cs = do {v <- readIORef r;
                        writeIORef r (v + length cs);
                        hPutStr h cs}

hGetLineC :: HandleC -> IO [Char]
hGetLineC (h,r) = do {v <- readIORef r;
                      result <- hGetLine h;
                      writeIORef r (v + length result);
                      return result}

hCloseC :: HandleC -> IO [Char]
hCloseC (h,r) = do {v <- readIORef r;
                    hClose h;
                    return ("Read/Wrote "++ (show v) ++" characters.")    }

doFileTest f = do { hc <- openFileC f WriteMode;
                    hPutStrC hc "four";
                    hPutStrC hc "five";
                    hCloseC hc}

-- unsafePerformIO lets us break the type system
cast :: a -> b
cast x = unsafePerformIO
           (do {writeIORef r x;
                readIORef r}  )
     where r :: IORef a
           r = unsafePerformIO
                    (newIORef (error "urk"))
-- or, alternatively
--                     (newIORef (hd []))

{- This attempt to write the same cast operator within the IO monad fails
   because the type of r is is instantiated when creating the reference 
mcast :: a -> IO b
mcast x = do
   r <- newIORef (error "urk")
   writeIORef r "hello"
   readIORef r
-}