import Data.IORef
import IO
import System.IO.Unsafe

echo :: IO ()
echo = getChar >>= putChar
-- Run by loading into ghci:
-- Prelude>echo
-- s
-- s*Main> *Main>

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

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

echoTwice :: IO ()
echoTwice = echo >> echo

getTwoChars :: IO(Char,Char)
getTwoChars = getChar >>= \c1 ->
              getChar >>= \c2 ->
              return (c1,c2)

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

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

-- getLine defined using the "do" notation
getLineDo :: IO [Char]
getLineDo = do { c <- getChar ;
                 if c == '\n' then 
                    return []
                 else 
                    do { cs <- getLineDo;
                         return (c:cs)    } }

forever :: IO () -> IO ()
forever a = a >> forever a

repeatN :: Int -> IO () -> IO ()
repeatN 0 a = return ()
repeatN n a = a >> repeatN (n-1) a

print5hs = repeatN 5 (putChar 'h')

for :: [a] -> (a -> IO b) -> IO ()
for []     fa = return ()
for (x:xs) fa = fa x >>  for xs fa

printNums = for [1..10] (\x -> putStr (show x))

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

threechars = sequence [getChar, getChar, getChar] 

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}

configFileContents :: [String]
configFileContents = lines (unsafePerformIO (readFile "config"))

-- unsafePerformIO breaks the type system, allowing us to write a term
-- that converts from any type a to any type b.

-- r is a polymorphic reference :-( 
-- Having a value with this type is a bad thing because we can write
-- a value into it using one type and read that value out again at a different type.
--
-- The error function never returns if it is evaluated, printing an error message
-- instead.  Hence its return type can be anything:
-- error :: String -> a  

r :: IORef c    
r = unsafePerformIO (newIORef (error "urk"))  

cast :: a -> b
cast x = unsafePerformIO (do {writeIORef r x;
                              readIORef r     }  )


-- This version uses the empty list to create the polymorphic reference.
r1 :: IORef [a]
r1 = unsafePerformIO (newIORef [])

cast2 :: a -> b
cast2 x = unsafePerformIO (
            do { writeIORef r1 [x];
                 y <- readIORef r1;
                 return (head y) })

{-- The following code, which tries to do the same trick
    without the IO monad, fails to type check because
    the writeIORef needs r2 to be a value of type IORef c,
    not IO(IORef c).  Without the unsafePerformIO, we can't
    access the underlying reference.  The only operations
    we have available to access the value is readIORef, which
    returns the *value* in the reference cell, not the reference
    cell itself.
    
r2 :: IO (IORef c)
r2 = newIORef (error "urk")

cast3 x = do {writeIORef r2 [x];
              y <- readIORef r2;
              return (head y)}
--}                 

done :: IO ()
done = return ()
           
putStr' :: String -> IO ()
putStr' [] = done
putStr' (c:s) = putChar c >> putStr' s