foo.hs

-- 継続モナドによるリソース管理 
-- http://qiita.com/tanakh/items/81fc1a0d9ae0af3865cb
-- 写経していて、継続渡しスタイルのところで脱落したやつ

module Main where

import System.IO
import Control.Exception
import Control.Monad
import Foreign.Marshal.Utils

main :: IO ()
main = do
  putStrLn "hello world"

copyFile :: FilePath -> FilePath -> IO ()
copyFile from to = do
  h1 <- openFile from ReadMode
  h2 <- openFile to WriteMode
  content <- hGetContents h1
  hPutStr h2 content
  hClose h1
  hClose h2

-- bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
-- 第一引数: リソースを確保する関数
-- 第二引数: リソースを解法する関数
-- 第三引数: 確保したリソースを用いて何か処理を行う関数
fileLength :: FilePath -> IO Int
fileLength path = 
  bracket (openFile path ReadMode) hClose $ \h -> do
    content <- hGetContents h
    return $! length content

-- ($!) :: (a -> b) -> a -> b
-- hGetContents は遅延IOを行ってしまうので、
-- length をとった値を返す際に $! を使っている。
-- ここを $ にするとエラーが発生した。
-- *** Exception: stack.yaml: hGetContents: illegal operation (delayed read on closed handle)
-- ($) :: (a -> b) -> a -> b
-- lenght をとった値を表示するまで実際に評価されない。表示しようとしたときにはすでに
-- ファイルのハンドルは解放されているので、読めないためエラーが発生している？

invalidAcess :: FilePath -> IO ()
invalidAcess path =
  bracket (openFile path ReadMode) (\h -> putStrLn "close" >> hClose h) $ \h ->
    hPutStrLn h "(´･_･`)"

-- (>>) :: Monad m => m a -> m b -> m b

-- withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
copyFile' :: FilePath -> FilePath -> IO ()
copyFile' from to = do
  withFile from ReadMode $ \h1 ->
    withFile to WriteMode $ \h2 -> do
      content <- hGetContents h1
      hPutStr h2 content

-- with系関数の問題点
--   * ネストが深くなってしまい、コードが書きにくい
--   * リファクタリングや部分を切り出しての抽象化がしづらい

catFiles :: FilePath -> FilePath -> FilePath -> IO ()
catFiles from1 from2 to = do
  withFile from1 ReadMode $ \h1 ->
    withFile from2 ReadMode $ \h2 ->
      withFile to WriteMode $ \h3 -> do
        hPutStr h3 =<< hGetContents h1
        hPutStr h3 =<< hGetContents h2

-- (=<<) :: Monad m => (a -> m b) -> m a -> m b
-- (>>=) :: Monad m => m a -> (a -> m b) -> m b

-- モナドは、自由に編集したり並べ替えができるらしい

-- hGetContents :: Handle -> IO String
-- hPutStr :: Handle -> String -> IO ()

-- (String -> IO ()) -> IO String -> IO ()

catFiles' :: [FilePath] -> FilePath -> IO ()
catFiles' froms to = do
  withFiles froms ReadMode $ \fromhs ->
    withFile to WriteMode $ \toh ->
      forM_ fromhs $ \fromh -> do
        content <- hGetContents fromh
        hPutStr toh content

withFiles :: [FilePath] -> IOMode -> ([Handle] -> IO a) -> IO a
withFiles [] _mode k = k []
withFiles (x:xs) mode k =
  withFile x mode $ \h ->
    withFiles xs mode (\hs -> k $ h:hs)

-- withMany :: (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res

withFiles' :: [FilePath] -> IOMode -> ([Handle] -> IO r) -> IO r
withFiles' fs mode = 
  withMany (`withFile` mode) fs

-- 継続渡しスタイル (CPS: Continuation Passing Style)
--   関数が値を返す代わりに返り値を受け取る別の関数を渡すというもの
--   with系関数は、CPSと見ることができる

-- ^o^ < ...