git.iko.soy/elk
on master help sign in
Rename File.IO to just File and add a serializable Time type
8eeeddaEvan Czaplicki
builder/src/File/IO.hs → builder/src/File.hsrenamed+61−114
compare with master
unifiedsplit
@@ -1,16 +1,15 @@
1−module File.IO
1+module File
2+ ( Time
3+ , getTime
4+ , withLock
2− ( writeBinary, readBinary
5+ , writeBinary
6+ , readBinary
3− , writeUtf8, readUtf8
7+ , writeUtf8
8+ , readUtf8
4 , writeBuilder
9 , writeBuilder
5− , Writer
6− , put
7− , putByteString
8− , putBuilder
9− , putFile
10 , exists
10 , exists
11+ , remove
11− , remove, removeDir
12+ , removeDir
12− , find
13− , andM
14 )
13 )
15 where
14 where
16
15
@@ -20,17 +19,48 @@ import qualified Data.Binary as Binary
20import qualified Data.ByteString as BS
19import qualified Data.ByteString as BS
21import qualified Data.ByteString.Internal as BS
20import qualified Data.ByteString.Internal as BS
22import qualified Data.ByteString.Builder as B
21import qualified Data.ByteString.Builder as B
23−import qualified Data.ByteString.Builder.Extra as B (defaultChunkSize)
22+import qualified Data.Fixed as Fixed
23+import qualified Data.Time.Clock.POSIX as Time
24import qualified Foreign.ForeignPtr as FPtr
24import qualified Foreign.ForeignPtr as FPtr
25import GHC.IO.Exception (IOException, IOErrorType(InvalidArgument))
25import GHC.IO.Exception (IOException, IOErrorType(InvalidArgument))
26import qualified System.Directory as Dir
26import qualified System.Directory as Dir
27−import System.FilePath ((</>))
27+import qualified System.FileLock as Lock
28import qualified System.FilePath as FP
28import qualified System.FilePath as FP
29import qualified System.IO as IO
29import qualified System.IO as IO
30import System.IO.Error (ioeGetErrorType, annotateIOError, modifyIOError)
30import System.IO.Error (ioeGetErrorType, annotateIOError, modifyIOError)
31
31
32
32
33
33
34+-- TIME
35+
36+
37+newtype Time = Time Fixed.Pico
38+ deriving (Eq, Ord)
39+
40+
41+getTime :: FilePath -> IO Time
42+getTime path =
43+ fmap
44+ (Time . realToFrac . Time.utcTimeToPOSIXSeconds)
45+-- TODO (Time . Time.nominalDiffTimeToSeconds . Time.utcTimeToPOSIXSeconds)
46+ (Dir.getModificationTime path)
47+
48+
49+instance Binary.Binary Time where
50+ put (Time time) = Binary.put time
51+ get = Time <$> Binary.get
52+
53+
54+
55+-- LOCK
56+
57+
58+withLock :: FilePath -> IO a -> IO a
59+withLock path work =
60+ Lock.withFileLock path Lock.Exclusive (\_ -> work)
61+
62+
63+
34-- BINARY
64-- BINARY
35
65
36
66
@@ -43,14 +73,10 @@ writeBinary path value =
43
73
44readBinary :: (Binary.Binary a) => FilePath -> IO (Maybe a)
74readBinary :: (Binary.Binary a) => FilePath -> IO (Maybe a)
45readBinary path =
75readBinary path =
46− do exists_ <- Dir.doesFileExist path
47− if not exists_
48− then return Nothing
49− else
50− do result <- Binary.decodeFileOrFail path
76+ do result <- Binary.decodeFileOrFail path
51− case result of
77+ case result of
52− Left _ -> return Nothing
53− Right a -> return (Just a)
78+ Right a -> return (Just a)
79+ Left _ -> return Nothing
54
80
55
81
56
82
@@ -58,14 +84,14 @@ readBinary path =
58
84
59
85
60writeUtf8 :: FilePath -> BS.ByteString -> IO ()
86writeUtf8 :: FilePath -> BS.ByteString -> IO ()
61−writeUtf8 filePath content =
87+writeUtf8 path content =
62− withUtf8 filePath IO.WriteMode $ \handle ->
88+ withUtf8 path IO.WriteMode $ \handle ->
63 BS.hPut handle content
89 BS.hPut handle content
64
90
65
91
66withUtf8 :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a
92withUtf8 :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a
67−withUtf8 filePath mode callback =
93+withUtf8 path mode callback =
68− IO.withFile filePath mode $ \handle ->
94+ IO.withFile path mode $ \handle ->
69 do IO.hSetEncoding handle IO.utf8
95 do IO.hSetEncoding handle IO.utf8
70 callback handle
96 callback handle
71
97
@@ -75,9 +101,9 @@ withUtf8 filePath mode callback =
75
101
76
102
77readUtf8 :: FilePath -> IO BS.ByteString
103readUtf8 :: FilePath -> IO BS.ByteString
78−readUtf8 filePath =
104+readUtf8 path =
79− withUtf8 filePath IO.ReadMode $ \handle ->
105+ withUtf8 path IO.ReadMode $ \handle ->
80− modifyIOError (encodingError filePath) $
106+ modifyIOError (encodingError path) $
81 do fileSize <- catch (IO.hFileSize handle) useZeroIfNotRegularFile
107 do fileSize <- catch (IO.hFileSize handle) useZeroIfNotRegularFile
82 let readSize = max 0 (fromIntegral fileSize) + 1
108 let readSize = max 0 (fromIntegral fileSize) + 1
83 hGetContentsSizeHint handle readSize (max 255 readSize)
109 hGetContentsSizeHint handle readSize (max 255 readSize)
@@ -102,14 +128,14 @@ hGetContentsSizeHint handle =
102
128
103
129
104encodingError :: FilePath -> IOError -> IOError
130encodingError :: FilePath -> IOError -> IOError
105−encodingError filePath ioErr =
131+encodingError path ioErr =
106 case ioeGetErrorType ioErr of
132 case ioeGetErrorType ioErr of
107 InvalidArgument ->
133 InvalidArgument ->
108 annotateIOError
134 annotateIOError
109 (userError "Bad encoding; the file must be valid UTF-8")
135 (userError "Bad encoding; the file must be valid UTF-8")
110 ""
136 ""
111 Nothing
137 Nothing
112− (Just filePath)
138+ (Just path)
113
139
114 _ ->
140 _ ->
115 ioErr
141 ioErr
@@ -127,54 +153,12 @@ writeBuilder path builder =
127
153
128
154
129
155
130−-- WRITER
131−
132−
133−newtype Writer =
134− Writer (IO.Handle -> IO ())
135−
136−
137−put :: FilePath -> Writer -> IO ()
138−put path (Writer callback) =
139− IO.withBinaryFile path IO.WriteMode callback
140−
141−
142−putByteString :: BS.ByteString -> Writer
143−putByteString chunk =
144− Writer $ \handle ->
145− BS.hPut handle chunk
146−
147−
148−putBuilder :: B.Builder -> Writer
149−putBuilder builder =
150− Writer $ \handle ->
151− B.hPutBuilder handle builder
152−
153−
154−putFile :: FilePath -> Writer
155−putFile path =
156− Writer $ \sink ->
157− IO.withBinaryFile path IO.ReadMode $ \source ->
158− putHelp source sink
159−
160−
161−putHelp :: IO.Handle -> IO.Handle -> IO ()
162−putHelp source sink =
163− do chunk <- BS.hGet source B.defaultChunkSize
164− if BS.null chunk
165− then return ()
166− else
167− do BS.hPut sink chunk
168− putHelp source sink
169−
170−
171−
172-- EXISTS
156-- EXISTS
173
157
174
158
175exists :: FilePath -> IO Bool
159exists :: FilePath -> IO Bool
176−exists =
160+exists path =
177− Dir.doesFileExist
161+ Dir.doesFileExist path
178
162
179
163
180
164
@@ -182,10 +166,10 @@ exists =
182
166
183
167
184remove :: FilePath -> IO ()
168remove :: FilePath -> IO ()
185−remove filePath =
169+remove path =
186− do exists_ <- Dir.doesFileExist filePath
170+ do exists_ <- Dir.doesFileExist path
187 if exists_
171 if exists_
188− then Dir.removeFile filePath
172+ then Dir.removeFile path
189 else return ()
173 else return ()
190
174
191
175
@@ -195,40 +179,3 @@ removeDir path =
195 if exists_
179 if exists_
196 then Dir.removeDirectoryRecursive path
180 then Dir.removeDirectoryRecursive path
197 else return ()
181 else return ()
198−
199−
200−
201−-- FIND FILES
202−
203−
204−find :: FilePath -> IO (Maybe FilePath)
205−find name =
206− do subDir <- Dir.getCurrentDirectory
207− findHelp name (FP.splitDirectories subDir)
208−
209−
210−findHelp :: FilePath -> [String] -> IO (Maybe FilePath)
211−findHelp name dirs =
212− if null dirs then
213− return Nothing
214−
215− else
216− do exists_ <- Dir.doesFileExist (FP.joinPath dirs </> name)
217− if exists_
218− then return (Just (FP.joinPath dirs))
219− else findHelp name (init dirs)
220−
221−
222−
223−-- HELPER
224−
225−
226−andM :: (Monad m) => [m Bool] -> m Bool
227−andM checks =
228− case checks of
229− [] ->
230− return True
231−
232− check : otherChecks ->
233− do bool <- check
234− if bool then andM otherChecks else return False