@@ -0,0 +1,388 @@
1+{-# LANGUAGE BlockArguments #-}
2+{-# LANGUAGE CPP #-}
3+{-# LANGUAGE UndecidableInstances #-}
4+module FileSizes where
5+
6+import Control.Exception
7+import Control.Monad.IO.Class
8+import Data.IORef
9+import Data.Tuple
10+import System.Posix
11+
12+-- effectful
13+import qualified Effectful.Interpreter as E
14+import qualified Effectful.Monad as E
15+import qualified Effectful.Reader as E
16+import qualified Effectful.State as E
17+
18+-- eff
19+#ifdef VERSION_eff
20+import qualified Control.Effect as L
21+#endif
22+
23+-- freer-simple
24+#ifdef VERSION_freer_simple
25+import qualified Control.Monad.Freer as FS
26+import qualified Control.Monad.Freer.Reader as FS
27+import qualified Control.Monad.Freer.State as FS
28+#endif
29+
30+-- mtl
31+import qualified Control.Monad.State as M
32+import qualified Control.Monad.Reader as M
33+
34+-- polysemy
35+#ifdef VERSION_polysemy
36+import qualified Polysemy as P
37+import qualified Polysemy.Reader as P
38+import qualified Polysemy.State as P
39+import qualified Polysemy.Internal as P
40+#endif
41+
42+tryGetFileSize :: FilePath -> IO (Maybe Int)
43+tryGetFileSize path = try @IOException (getFileStatus path) >>= \case
44+ Left _ -> pure Nothing
45+ Right stat -> pure . Just . fromIntegral $ fileSize stat
46+
47+----------------------------------------
48+-- reference
49+
50+ref_calculateFileSize :: IORef [String] -> FilePath -> IO Int
51+ref_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 #-}
60+
61+ref_program :: IORef [String] -> [FilePath] -> IO Int
62+ref_program logs files = do
63+ sizes <- traverse (ref_calculateFileSize logs) files
64+ pure $ sum sizes
65+{-# NOINLINE ref_program #-}
66+
67+ref_calculateFileSizes :: [FilePath] -> IO (Int, [String])
68+ref_calculateFileSizes files = do
69+ logs <- newIORef []
70+ size <- ref_program logs files
71+ finalLogs <- readIORef logs
72+ pure (size, finalLogs)
73+
74+----------------------------------------
75+-- effectful
76+
77+data Effectful_File :: E.Effect where
78+ Effectful_tryFileSize :: FilePath -> Effectful_File m (Maybe Int)
79+
80+effectful_tryFileSize :: Effectful_File E.:> es => FilePath -> E.Eff es (Maybe Int)
81+effectful_tryFileSize = E.send . Effectful_tryFileSize
82+
83+effectful_runFile :: E.IOE E.:> es => E.Eff (Effectful_File : es) a -> E.Eff es a
84+effectful_runFile = E.interpret \case
85+ Effectful_tryFileSize path -> liftIO $ tryGetFileSize path
86+
87+data Effectful_Logging :: E.Effect where
88+ Effectful_logMsg :: String -> Effectful_Logging m ()
89+
90+effectful_logMsg :: Effectful_Logging E.:> es => String -> E.Eff es ()
91+effectful_logMsg = E.send . Effectful_logMsg
92+
93+effectful_runLogging
94+ :: E.Eff (Effectful_Logging : es) a
95+ -> E.Eff es (a, [String])
96+effectful_runLogging = E.reinterpret (E.runState []) \case
97+ Effectful_logMsg msg -> E.modify (msg :)
98+
99+----------
100+
101+effectful_calculateFileSize
102+ :: (Effectful_File E.:> es, Effectful_Logging E.:> es)
103+ => FilePath
104+ -> E.Eff es Int
105+effectful_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 #-}
111+
112+effectful_program
113+ :: (Effectful_File E.:> es, Effectful_Logging E.:> es)
114+ => [FilePath]
115+ -> E.Eff es Int
116+effectful_program files = do
117+ sizes <- traverse effectful_calculateFileSize files
118+ pure $ sum sizes
119+{-# NOINLINE effectful_program #-}
120+
121+effectful_calculateFileSizes :: [FilePath] -> IO (Int, [String])
122+effectful_calculateFileSizes =
123+ E.runEff . E.runIOE . effectful_runFile . effectful_runLogging . effectful_program
124+
125+effectful_calculateFileSizesDeep :: [FilePath] -> IO (Int, [String])
126+effectful_calculateFileSizesDeep = E.runEff . E.runIOE
127+ . runR . runR . runR . runR . runR . runR . runR . runR . runR . runR
128+ . effectful_runFile . effectful_runLogging
129+ . runR . runR . runR . runR . runR . runR . runR . runR . runR . runR
130+ . effectful_program
131+ where
132+ runR = E.runReader ()
133+
134+----------------------------------------
135+-- eff
136+
137+#ifdef VERSION_eff
138+
139+data Eff_File :: L.Effect where
140+ Eff_tryFileSize :: FilePath -> Eff_File m (Maybe Int)
141+
142+eff_tryFileSize :: Eff_File L.:< es => FilePath -> L.Eff es (Maybe Int)
143+eff_tryFileSize = L.send . Eff_tryFileSize
144+
145+eff_runFile :: L.IOE L.:< es => L.Eff (Eff_File : es) a -> L.Eff es a
146+eff_runFile = L.interpret \case
147+ Eff_tryFileSize path -> liftIO $ tryGetFileSize path
148+
149+data Eff_Logging :: L.Effect where
150+ Eff_logMsg :: String -> Eff_Logging m ()
151+
152+eff_logMsg :: Eff_Logging L.:< es => String -> L.Eff es ()
153+eff_logMsg = L.send . Eff_logMsg
154+
155+eff_runLogging
156+ :: L.Eff (Eff_Logging : es) a
157+ -> L.Eff es (a, [String])
158+eff_runLogging
159+ = fmap swap . L.runState [] . L.interpret \case
160+ Eff_logMsg msg -> L.modify (msg :)
161+ . L.lift
162+
163+----------
164+
165+eff_calculateFileSize
166+ :: (Eff_File L.:< es, Eff_Logging L.:< es)
167+ => FilePath
168+ -> L.Eff es Int
169+eff_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 #-}
175+
176+eff_program
177+ :: (Eff_File L.:< es, Eff_Logging L.:< es)
178+ => [FilePath]
179+ -> L.Eff es Int
180+eff_program files = do
181+ sizes <- traverse eff_calculateFileSize files
182+ pure $ sum sizes
183+{-# NOINLINE eff_program #-}
184+
185+eff_calculateFileSizes :: [FilePath] -> IO (Int, [String])
186+eff_calculateFileSizes =
187+ L.runIO . eff_runFile . eff_runLogging . eff_program
188+
189+eff_calculateFileSizesDeep :: [FilePath] -> IO (Int, [String])
190+eff_calculateFileSizesDeep = L.runIO
191+ . runR . runR . runR . runR . runR . runR . runR . runR . runR . runR
192+ . eff_runFile . eff_runLogging
193+ . runR . runR . runR . runR . runR . runR . runR . runR . runR . runR
194+ . eff_program
195+ where
196+ runR = L.runReader ()
197+
198+#endif
199+
200+----------------------------------------
201+-- freer-simple
202+
203+data FS_File r where
204+ FS_tryFileSize :: FilePath -> FS_File (Maybe Int)
205+
206+fs_tryFileSize :: FS.Member FS_File es => FilePath -> FS.Eff es (Maybe Int)
207+fs_tryFileSize = FS.send . FS_tryFileSize
208+
209+fs_runFile :: FS.LastMember IO es => FS.Eff (FS_File : es) a -> FS.Eff es a
210+fs_runFile = FS.interpret \case
211+ FS_tryFileSize path -> liftIO $ tryGetFileSize path
212+
213+data FS_Logging r where
214+ FS_logMsg :: String -> FS_Logging ()
215+
216+fs_logMsg :: FS.Member FS_Logging es => String -> FS.Eff es ()
217+fs_logMsg = FS.send . FS_logMsg
218+
219+fs_runLogging
220+ :: FS.Eff (FS_Logging : es) a
221+ -> FS.Eff es (a, [String])
222+fs_runLogging = FS.runState [] . FS.reinterpret \case
223+ FS_logMsg msg -> FS.modify (msg :)
224+
225+----------
226+
227+fs_calculateFileSize
228+ :: (FS.Member FS_File es, FS.Member FS_Logging es)
229+ => FilePath
230+ -> FS.Eff es Int
231+fs_calculateFileSize path = do
232+ fs_logMsg $ "Calculating the size of " ++ path
233+ fs_tryFileSize path >>= \case
234+ Nothing -> 0 <$ fs_logMsg ("Could not calculate the size of " ++ path)
235+ Just size -> size <$ fs_logMsg (path ++ " is " ++ show size ++ " bytes")
236+{-# NOINLINE fs_calculateFileSize #-}
237+
238+fs_program
239+ :: (FS.Member FS_File es, FS.Member FS_Logging es)
240+ => [FilePath]
241+ -> FS.Eff es Int
242+fs_program files = do
243+ sizes <- traverse fs_calculateFileSize files
244+ pure $ sum sizes
245+{-# NOINLINE fs_program #-}
246+
247+fs_calculateFileSizes :: [FilePath] -> IO (Int, [String])
248+fs_calculateFileSizes =
249+ FS.runM . fs_runFile . fs_runLogging . fs_program
250+
251+fs_calculateFileSizesDeep :: [FilePath] -> IO (Int, [String])
252+fs_calculateFileSizesDeep = FS.runM
253+ . runR . runR . runR . runR . runR . runR . runR . runR . runR . runR
254+ . fs_runFile . fs_runLogging
255+ . runR . runR . runR . runR . runR . runR . runR . runR . runR . runR
256+ . fs_program
257+ where
258+ runR = FS.runReader ()
259+
260+----------------------------------------
261+-- mtl
262+
263+class Monad m => MonadFile m where
264+ mtl_tryFileSize :: FilePath -> m (Maybe Int)
265+
266+newtype FileT m a = FileT { runFileT :: m a }
267+ deriving (Functor, Applicative, Monad, MonadIO)
268+
269+instance M.MonadTrans FileT where
270+ lift = FileT
271+
272+instance {-# OVERLAPPABLE #-}
273+ ( MonadFile m
274+ , Monad (t m)
275+ , M.MonadTrans t
276+ ) => MonadFile (t m) where
277+ mtl_tryFileSize = M.lift . mtl_tryFileSize
278+
279+instance MonadIO m => MonadFile (FileT m) where
280+ mtl_tryFileSize path = liftIO $ tryGetFileSize path
281+
282+class Monad m => MonadLog m where
283+ mtl_logMsg :: String -> m ()
284+
285+newtype LoggingT m a = LoggingT (M.StateT [String] m a)
286+ deriving (Functor, Applicative, Monad, MonadIO, M.MonadTrans)
287+
288+instance {-# OVERLAPPABLE #-}
289+ ( MonadLog m
290+ , Monad (t m)
291+ , M.MonadTrans t
292+ ) => MonadLog (t m) where
293+ mtl_logMsg = M.lift . mtl_logMsg
294+
295+instance MonadIO m => MonadLog (LoggingT m) where
296+ mtl_logMsg msg = LoggingT $ M.modify (msg :)
297+
298+runLoggingT :: LoggingT m a -> m (a, [String])
299+runLoggingT (LoggingT m) = M.runStateT m []
300+
301+----------
302+
303+mtl_calculateFileSize :: (MonadLog m, MonadFile m) => FilePath -> m Int
304+mtl_calculateFileSize path = do
305+ mtl_logMsg $ "Calculating the size of " ++ path
306+ mtl_tryFileSize path >>= \case
307+ Nothing -> 0 <$ mtl_logMsg ("Could not calculate the size of " ++ path)
308+ Just size -> size <$ mtl_logMsg (path ++ " is " ++ show size ++ " bytes")
309+{-# NOINLINE mtl_calculateFileSize #-}
310+
311+mtl_program :: (MonadLog m, MonadFile m) => [FilePath] -> m Int
312+mtl_program files = do
313+ sizes <- traverse mtl_calculateFileSize files
314+ pure $ sum sizes
315+{-# NOINLINE mtl_program #-}
316+
317+mtl_calculateFileSizes :: [FilePath] -> IO (Int, [String])
318+mtl_calculateFileSizes = runFileT . runLoggingT . mtl_program
319+
320+mtl_calculateFileSizesDeep :: [FilePath] -> IO (Int, [String])
321+mtl_calculateFileSizesDeep
322+ = runR . runR . runR . runR . runR . runR . runR . runR . runR . runR
323+ . runFileT . runLoggingT
324+ . runR . runR . runR . runR . runR . runR . runR . runR . runR . runR
325+ . mtl_program
326+ where
327+ runR = flip M.runReaderT ()
328+
329+----------------------------------------
330+-- polysemy
331+
332+#ifdef VERSION_polysemy
333+
334+data Poly_File (m :: * -> *) a where
335+ Poly_tryFileSize :: FilePath -> Poly_File m (Maybe Int)
336+
337+poly_tryFileSize :: P.Member Poly_File es => FilePath -> P.Sem es (Maybe Int)
338+poly_tryFileSize = P.send . Poly_tryFileSize
339+
340+poly_runFile :: P.Member (P.Embed IO) es => P.Sem (Poly_File : es) a -> P.Sem es a
341+poly_runFile = P.interpret \case
342+ Poly_tryFileSize path -> P.embed $ tryGetFileSize path
343+
344+data Poly_Logging (m :: * -> *) a where
345+ Poly_logMsg :: String -> Poly_Logging m ()
346+
347+poly_logMsg :: P.Member Poly_Logging es => String -> P.Sem es ()
348+poly_logMsg = P.send . Poly_logMsg
349+
350+poly_runLogging :: P.Sem (Poly_Logging : es) a -> P.Sem es (a, [String])
351+poly_runLogging = fmap swap . P.runState [] . P.reinterpret \case
352+ Poly_logMsg msg -> P.modify (msg :)
353+
354+----------
355+
356+poly_calculateFileSize
357+ :: (P.Member Poly_File es, P.Member Poly_Logging es)
358+ => FilePath
359+ -> P.Sem es Int
360+poly_calculateFileSize path = do
361+ poly_logMsg $ "Calculating the size of " ++ path
362+ poly_tryFileSize path >>= \case
363+ Nothing -> 0 <$ poly_logMsg ("Could not calculate the size of " ++ path)
364+ Just size -> size <$ poly_logMsg (path ++ " is " ++ show size ++ " bytes")
365+{-# NOINLINE poly_calculateFileSize #-}
366+
367+poly_program
368+ :: (P.Member Poly_File es, P.Member Poly_Logging es)
369+ => [FilePath]
370+ -> P.Sem es Int
371+poly_program files = do
372+ sizes <- traverse poly_calculateFileSize files
373+ pure $ sum sizes
374+{-# NOINLINE poly_program #-}
375+
376+poly_calculateFileSizes :: [FilePath] -> IO (Int, [String])
377+poly_calculateFileSizes =
378+ P.runM . poly_runFile . poly_runLogging . poly_program
379+
380+poly_calculateFileSizesDeep :: [FilePath] -> IO (Int, [String])
381+poly_calculateFileSizesDeep = P.runM
382+ . runR . runR . runR . runR . runR . runR . runR . runR . runR . runR
383+ . poly_runFile . poly_runLogging
384+ . runR . runR . runR . runR . runR . runR . runR . runR . runR . runR
385+ . poly_program
386+ where
387+ runR = P.runReader ()
388+#endif