0 | module Control.App.FileIO
 1 |
 2 | import Control.App
 3 |
 4 | import System.File
 5 |
 6 | %default covering
 7 |
 8 | toFileEx : FileError -> FileEx
 9 | toFileEx (GenericFileError i) = GenericFileEx i
10 | toFileEx FileReadError = FileReadError
11 | toFileEx FileWriteError = FileWriteError
12 | toFileEx FileNotFound = FileNotFound
13 | toFileEx PermissionDenied = PermissionDenied
14 | toFileEx FileExists = FileExists
15 |
16 | public export
17 | interface Has [Exception IOError] e => FileIO e where
18 |   withFile : String -> Mode ->
19 |              (onError : IOError -> App e a) ->
20 |              (onOpen : File -> App e a) ->
21 |              App e a
22 |   fGetStr : File -> App e String
23 |   fGetChars : File -> Int -> App e String
24 |   fGetChar : File -> App e Char
25 |   fPutStr : File -> String -> App e ()
26 |   fPutStrLn : File -> String -> App e ()
27 |   fflush : File -> App e ()
28 |   fEOF : File -> App e Bool
29 |
30 | -- TODO : Add Binary File IO with buffers
31 |
32 | export
33 | readFile : FileIO e => String -> App e String
34 | readFile f
35 |     = withFile f Read throw $ \h =>
36 |         do content <- read [] h
37 |            pure (fastConcat content)
38 |   where
39 |     read : List String -> File -> App e (List String)
40 |     read acc h
41 |         = do eof <- FileIO.fEOF h
42 |              if eof
43 |                 then pure (reverse acc)
44 |                 else do str <- fGetStr h
45 |                         read (str :: acc) h
46 |
47 | fileOp : IO (Either FileError a) -> Has [PrimIO, Exception IOError] e => App e a
48 | fileOp fileRes
49 |       = do Right res <- primIO $ fileRes
50 |              | Left err => throw (FileErr (toFileEx err))
51 |            pure res
52 |
53 | export
54 | Has [PrimIO, Exception IOError] e => FileIO e where
55 |   withFile fname m onError proc
56 |       = do Right h <- primIO $ openFile fname m
57 |               | Left err => onError (FileErr (toFileEx err))
58 |            res <- catch (proc h) onError
59 |            primIO $ closeFile h
60 |            pure res
61 |
62 |   fGetStr f = fileOp (fGetLine f)
63 |
64 |   fGetChars f n = fileOp (fGetChars f n)
65 |
66 |   fGetChar f = fileOp (fGetChar f)
67 |
68 |   fPutStr f str = fileOp (fPutStr f str)
69 |
70 |   fPutStrLn f str = fileOp (File.ReadWrite.fPutStrLn f str)
71 |
72 |   fflush f = primIO $ fflush f
73 |
74 |   fEOF f = primIO $ fEOF f
75 |
76 | export
77 | withFileIO : Has [PrimIO] e =>
78 |              App (IOError :: e) a ->
79 |              (ok : a -> App e b) ->
80 |              (err : IOError -> App e b) -> App e b
81 | withFileIO prog ok err = handle prog ok err
82 |