module FRP.Peakachu.Backend.File
( FileToProgram(..), ProgramToFile(..), fileB
, gFileData, gFileError
) where
import Data.ADT.Getters (mkADTGetters)
import FRP.Peakachu.Backend (Backend(..))
import FRP.Peakachu.Backend.Internal (Sink(..))
import Control.Monad (join)
import Data.Function (fix)
import Data.Monoid (Monoid(..))
import System.IO (IOMode(ReadMode), openFile, hClose, hGetChar)
import System.IO.Error (try, isEOFError)
data FileToProgram a
= FileData String a
| FileError a
$(mkADTGetters ''FileToProgram)
data ProgramToFile a
= ReadFile FilePath a
| WriteFile FilePath String a
maybeIO :: (IOError -> Bool) -> IO a -> IO (Maybe a)
maybeIO isExpected =
join . fmap f . try
where
f (Right x) = return $ Just x
f (Left err)
| isExpected err = return Nothing
| otherwise = ioError err
strictReadFile :: FilePath -> IO String
strictReadFile filename = do
file <- openFile filename ReadMode
contents <- fix $ \rest -> do
mc <- maybeIO isEOFError $ hGetChar file
case mc of
Nothing -> return ""
Just c -> fmap (c :) rest
hClose file
return contents
fileB :: Backend (ProgramToFile a) (FileToProgram a)
fileB =
Backend f
where
f handler =
return mempty { sinkConsume = consume }
where
consume (ReadFile filename tag) =
strictReadFile filename >>=
handler . (`FileData` tag)
consume (WriteFile filename contents _) =
writeFile filename contents