git.iko.soy/effectful
on b42e0dc help sign in
effectful/bench/FileSizes.hs
392 lines 12 kB history raw
1{-# LANGUAGE BlockArguments #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE UndecidableInstances #-}
4module FileSizes where
6import Control.Exception
7import Control.Monad.IO.Class
8import Data.IORef
9import Data.Tuple
10import System.Posix
12-- effectful
13import qualified Effectful.Interpreter as E
14import qualified Effectful.Monad as E
15import qualified Effectful.Reader as E
16import qualified Effectful.State as E
18-- eff
19#ifdef VERSION_eff
20import qualified Control.Effect as L
21#endif
23-- freer-simple
24#ifdef VERSION_freer_simple
25import qualified Control.Monad.Freer as FS
26import qualified Control.Monad.Freer.Reader as FS
27import qualified Control.Monad.Freer.State as FS
28#endif
30-- mtl
31import qualified Control.Monad.State as M
32import qualified Control.Monad.Reader as M
34-- polysemy
35#ifdef VERSION_polysemy
36import qualified Polysemy as P
37import qualified Polysemy.Reader as P
38import qualified Polysemy.State as P
39import qualified Polysemy.Internal as P
40#endif
42tryGetFileSize :: FilePath -> IO (Maybe Int)
43tryGetFileSize path = try @IOException (getFileStatus path) >>= \case
44 Left _ -> pure Nothing
45 Right stat -> pure . Just . fromIntegral $ fileSize stat
47----------------------------------------
48-- reference
50ref_calculateFileSize :: IORef [String] -> FilePath -> IO Int
51ref_calculateFileSize logs path = do
52 logToIORef logs $ "Calculating the size of " ++ path
53 tryGetFileSize path >>= \case
54 Nothing -> 0 <$ logToIORef logs ("Could not calculate the size of " ++ path)
55 Just size -> size <$ logToIORef logs (path ++ " is " ++ show size ++ " bytes")
56 where
57 logToIORef :: IORef [String] -> String -> IO ()
58 logToIORef r msg = modifyIORef' r (msg :)
59{-# NOINLINE ref_calculateFileSize #-}
61ref_program :: IORef [String] -> [FilePath] -> IO Int
62ref_program logs files = do
63 sizes <- traverse (ref_calculateFileSize logs) files
64 pure $ sum sizes
65{-# NOINLINE ref_program #-}
67ref_calculateFileSizes :: [FilePath] -> IO (Int, [String])
68ref_calculateFileSizes files = do
69 logs <- newIORef []
70 size <- ref_program logs files
71 finalLogs <- readIORef logs
72 pure (size, finalLogs)
74----------------------------------------
75-- effectful
77data Effectful_File :: E.Effect where
78 Effectful_tryFileSize :: FilePath -> Effectful_File m (Maybe Int)
80effectful_tryFileSize :: Effectful_File E.:> es => FilePath -> E.Eff es (Maybe Int)
81effectful_tryFileSize = E.send . Effectful_tryFileSize
83effectful_runFile :: E.IOE E.:> es => E.Eff (Effectful_File : es) a -> E.Eff es a
84effectful_runFile = E.interpret \case
85 Effectful_tryFileSize path -> liftIO $ tryGetFileSize path
87data Effectful_Logging :: E.Effect where
88 Effectful_logMsg :: String -> Effectful_Logging m ()
90effectful_logMsg :: Effectful_Logging E.:> es => String -> E.Eff es ()
91effectful_logMsg = E.send . Effectful_logMsg
93effectful_runLogging
94 :: E.Eff (Effectful_Logging : es) a
95 -> E.Eff es (a, [String])
96effectful_runLogging = E.reinterpret (E.runState []) \case
97 Effectful_logMsg msg -> E.modify (msg :)
99----------
101effectful_calculateFileSize
102 :: (Effectful_File E.:> es, Effectful_Logging E.:> es)
103 => FilePath
104 -> E.Eff es Int
105effectful_calculateFileSize path = do
106 effectful_logMsg $ "Calculating the size of " ++ path
107 effectful_tryFileSize path >>= \case
108 Nothing -> 0 <$ effectful_logMsg ("Could not calculate the size of " ++ path)
109 Just size -> size <$ effectful_logMsg (path ++ " is " ++ show size ++ " bytes")
110{-# NOINLINE effectful_calculateFileSize #-}
112effectful_program
113 :: (Effectful_File E.:> es, Effectful_Logging E.:> es)
114 => [FilePath]
115 -> E.Eff es Int
116effectful_program files = do
117 sizes <- traverse effectful_calculateFileSize files
118 pure $ sum sizes
119{-# NOINLINE effectful_program #-}
121effectful_calculateFileSizes :: [FilePath] -> IO (Int, [String])
122effectful_calculateFileSizes =
123 E.runIOE . effectful_runFile . effectful_runLogging . effectful_program
125effectful_calculateFileSizesDeep :: [FilePath] -> IO (Int, [String])
126effectful_calculateFileSizesDeep = E.runIOE
127 . runR . runR . runR . runR . runR
128 . effectful_runFile . effectful_runLogging
129 . runR . runR . runR . runR . runR
130 . effectful_program
131 where
132 runR = E.runReader ()
134----------------------------------------
135-- eff
137#ifdef VERSION_eff
139data Eff_File :: L.Effect where
140 Eff_tryFileSize :: FilePath -> Eff_File m (Maybe Int)
142eff_tryFileSize :: Eff_File L.:< es => FilePath -> L.Eff es (Maybe Int)
143eff_tryFileSize = L.send . Eff_tryFileSize
145eff_runFile :: L.IOE L.:< es => L.Eff (Eff_File : es) a -> L.Eff es a
146eff_runFile = L.interpret \case
147 Eff_tryFileSize path -> liftIO $ tryGetFileSize path
149data Eff_Logging :: L.Effect where
150 Eff_logMsg :: String -> Eff_Logging m ()
152eff_logMsg :: Eff_Logging L.:< es => String -> L.Eff es ()
153eff_logMsg = L.send . Eff_logMsg
155eff_runLogging
156 :: L.Eff (Eff_Logging : es) a
157 -> L.Eff es (a, [String])
158eff_runLogging
159 = fmap swap . L.runState [] . L.interpret \case
160 Eff_logMsg msg -> L.modify (msg :)
161 . L.lift
163----------
165eff_calculateFileSize
166 :: (Eff_File L.:< es, Eff_Logging L.:< es)
167 => FilePath
168 -> L.Eff es Int
169eff_calculateFileSize path = do
170 eff_logMsg $ "Calculating the size of " ++ path
171 eff_tryFileSize path >>= \case
172 Nothing -> 0 <$ eff_logMsg ("Could not calculate the size of " ++ path)
173 Just size -> size <$ eff_logMsg (path ++ " is " ++ show size ++ " bytes")
174{-# NOINLINE eff_calculateFileSize #-}
176eff_program
177 :: (Eff_File L.:< es, Eff_Logging L.:< es)
178 => [FilePath]
179 -> L.Eff es Int
180eff_program files = do
181 sizes <- traverse eff_calculateFileSize files
182 pure $ sum sizes
183{-# NOINLINE eff_program #-}
185eff_calculateFileSizes :: [FilePath] -> IO (Int, [String])
186eff_calculateFileSizes =
187 L.runIO . eff_runFile . eff_runLogging . eff_program
189eff_calculateFileSizesDeep :: [FilePath] -> IO (Int, [String])
190eff_calculateFileSizesDeep = L.runIO
191 . runR . runR . runR . runR . runR
192 . eff_runFile . eff_runLogging
193 . runR . runR . runR . runR . runR
194 . eff_program
195 where
196 runR = L.runReader ()
198#endif
200----------------------------------------
201-- freer-simple
203#ifdef VERSION_freer_simple
205data FS_File r where
206 FS_tryFileSize :: FilePath -> FS_File (Maybe Int)
208fs_tryFileSize :: FS.Member FS_File es => FilePath -> FS.Eff es (Maybe Int)
209fs_tryFileSize = FS.send . FS_tryFileSize
211fs_runFile :: FS.LastMember IO es => FS.Eff (FS_File : es) a -> FS.Eff es a
212fs_runFile = FS.interpret \case
213 FS_tryFileSize path -> liftIO $ tryGetFileSize path
215data FS_Logging r where
216 FS_logMsg :: String -> FS_Logging ()
218fs_logMsg :: FS.Member FS_Logging es => String -> FS.Eff es ()
219fs_logMsg = FS.send . FS_logMsg
221fs_runLogging
222 :: FS.Eff (FS_Logging : es) a
223 -> FS.Eff es (a, [String])
224fs_runLogging = FS.runState [] . FS.reinterpret \case
225 FS_logMsg msg -> FS.modify (msg :)
227----------
229fs_calculateFileSize
230 :: (FS.Member FS_File es, FS.Member FS_Logging es)
231 => FilePath
232 -> FS.Eff es Int
233fs_calculateFileSize path = do
234 fs_logMsg $ "Calculating the size of " ++ path
235 fs_tryFileSize path >>= \case
236 Nothing -> 0 <$ fs_logMsg ("Could not calculate the size of " ++ path)
237 Just size -> size <$ fs_logMsg (path ++ " is " ++ show size ++ " bytes")
238{-# NOINLINE fs_calculateFileSize #-}
240fs_program
241 :: (FS.Member FS_File es, FS.Member FS_Logging es)
242 => [FilePath]
243 -> FS.Eff es Int
244fs_program files = do
245 sizes <- traverse fs_calculateFileSize files
246 pure $ sum sizes
247{-# NOINLINE fs_program #-}
249fs_calculateFileSizes :: [FilePath] -> IO (Int, [String])
250fs_calculateFileSizes =
251 FS.runM . fs_runFile . fs_runLogging . fs_program
253fs_calculateFileSizesDeep :: [FilePath] -> IO (Int, [String])
254fs_calculateFileSizesDeep = FS.runM
255 . runR . runR . runR . runR . runR
256 . fs_runFile . fs_runLogging
257 . runR . runR . runR . runR . runR
258 . fs_program
259 where
260 runR = FS.runReader ()
262#endif
264----------------------------------------
265-- mtl
267class Monad m => MonadFile m where
268 mtl_tryFileSize :: FilePath -> m (Maybe Int)
270newtype FileT m a = FileT { runFileT :: m a }
271 deriving (Functor, Applicative, Monad, MonadIO)
273instance M.MonadTrans FileT where
274 lift = FileT
276instance {-# OVERLAPPABLE #-}
277 ( MonadFile m
278 , Monad (t m)
279 , M.MonadTrans t
280 ) => MonadFile (t m) where
281 mtl_tryFileSize = M.lift . mtl_tryFileSize
283instance MonadIO m => MonadFile (FileT m) where
284 mtl_tryFileSize path = liftIO $ tryGetFileSize path
286class Monad m => MonadLog m where
287 mtl_logMsg :: String -> m ()
289newtype LoggingT m a = LoggingT (M.StateT [String] m a)
290 deriving (Functor, Applicative, Monad, MonadIO, M.MonadTrans)
292instance {-# OVERLAPPABLE #-}
293 ( MonadLog m
294 , Monad (t m)
295 , M.MonadTrans t
296 ) => MonadLog (t m) where
297 mtl_logMsg = M.lift . mtl_logMsg
299instance MonadIO m => MonadLog (LoggingT m) where
300 mtl_logMsg msg = LoggingT $ M.modify (msg :)
302runLoggingT :: LoggingT m a -> m (a, [String])
303runLoggingT (LoggingT m) = M.runStateT m []
305----------
307mtl_calculateFileSize :: (MonadLog m, MonadFile m) => FilePath -> m Int
308mtl_calculateFileSize path = do
309 mtl_logMsg $ "Calculating the size of " ++ path
310 mtl_tryFileSize path >>= \case
311 Nothing -> 0 <$ mtl_logMsg ("Could not calculate the size of " ++ path)
312 Just size -> size <$ mtl_logMsg (path ++ " is " ++ show size ++ " bytes")
313{-# NOINLINE mtl_calculateFileSize #-}
315mtl_program :: (MonadLog m, MonadFile m) => [FilePath] -> m Int
316mtl_program files = do
317 sizes <- traverse mtl_calculateFileSize files
318 pure $ sum sizes
319{-# NOINLINE mtl_program #-}
321mtl_calculateFileSizes :: [FilePath] -> IO (Int, [String])
322mtl_calculateFileSizes = runFileT . runLoggingT . mtl_program
324mtl_calculateFileSizesDeep :: [FilePath] -> IO (Int, [String])
325mtl_calculateFileSizesDeep
326 = runR . runR . runR . runR . runR
327 . runFileT . runLoggingT
328 . runR . runR . runR . runR . runR
329 . mtl_program
330 where
331 runR = flip M.runReaderT ()
333----------------------------------------
334-- polysemy
336#ifdef VERSION_polysemy
338data Poly_File (m :: * -> *) a where
339 Poly_tryFileSize :: FilePath -> Poly_File m (Maybe Int)
341poly_tryFileSize :: P.Member Poly_File es => FilePath -> P.Sem es (Maybe Int)
342poly_tryFileSize = P.send . Poly_tryFileSize
344poly_runFile :: P.Member (P.Embed IO) es => P.Sem (Poly_File : es) a -> P.Sem es a
345poly_runFile = P.interpret \case
346 Poly_tryFileSize path -> P.embed $ tryGetFileSize path
348data Poly_Logging (m :: * -> *) a where
349 Poly_logMsg :: String -> Poly_Logging m ()
351poly_logMsg :: P.Member Poly_Logging es => String -> P.Sem es ()
352poly_logMsg = P.send . Poly_logMsg
354poly_runLogging :: P.Sem (Poly_Logging : es) a -> P.Sem es (a, [String])
355poly_runLogging = fmap swap . P.runState [] . P.reinterpret \case
356 Poly_logMsg msg -> P.modify (msg :)
358----------
360poly_calculateFileSize
361 :: (P.Member Poly_File es, P.Member Poly_Logging es)
362 => FilePath
363 -> P.Sem es Int
364poly_calculateFileSize path = do
365 poly_logMsg $ "Calculating the size of " ++ path
366 poly_tryFileSize path >>= \case
367 Nothing -> 0 <$ poly_logMsg ("Could not calculate the size of " ++ path)
368 Just size -> size <$ poly_logMsg (path ++ " is " ++ show size ++ " bytes")
369{-# NOINLINE poly_calculateFileSize #-}
371poly_program
372 :: (P.Member Poly_File es, P.Member Poly_Logging es)
373 => [FilePath]
374 -> P.Sem es Int
375poly_program files = do
376 sizes <- traverse poly_calculateFileSize files
377 pure $ sum sizes
378{-# NOINLINE poly_program #-}
380poly_calculateFileSizes :: [FilePath] -> IO (Int, [String])
381poly_calculateFileSizes =
382 P.runM . poly_runFile . poly_runLogging . poly_program
384poly_calculateFileSizesDeep :: [FilePath] -> IO (Int, [String])
385poly_calculateFileSizesDeep = P.runM
386 . runR . runR . runR . runR . runR
387 . poly_runFile . poly_runLogging
388 . runR . runR . runR . runR . runR
389 . poly_program
390 where
391 runR = P.runReader ()
392#endif