-
-
Save Gurkenglas/6421869a5278c73482ea5c2460daee39 to your computer and use it in GitHub Desktop.
Help on reddit for: https://www.reddit.com/r/haskell/comments/7imf2x/iostate_monad_code_sample_for_review/
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# Language LambdaCase #-} | |
{- | |
Functionality: | |
- Read all folders and sub-folders with structure like below | |
- store all folder and file info in State monad, | |
- at the end of the loop, print it. | |
├── aaa | |
│ ├── b | |
│ │ ├── b1 | |
│ │ │ ├── b1-1 | |
│ │ │ └── b1-2 | |
│ │ └── b2 | |
│ │ └── 2-1 | |
│ │ └── b2-1-1 | |
│ └── c | |
│ ├── c1 | |
│ └── c2 | |
Goal: to practice using State and IO monad together by leveraging liftIO and unsafePerformIO | |
Would appreciate any correction, better way to do it or generic advices | |
-} | |
module Main where | |
import System.Directory | |
import System.FilePath | |
import Data.Time | |
import Control.Applicative ((<$>), (<*>)) | |
import Control.Monad (mapM) | |
import Data.Monoid ((<>)) | |
import Data.Foldable (fold) | |
main :: IO ([Dir], [File]) | |
main = do | |
let root = "/tmp/poulet" | |
s@(d, f) <- list root | |
putStrLn $ "Root: " ++ root | |
pretty d reverse "DIR:" | |
pretty f reverse "FILE:" | |
return s | |
-- | Order is arbitrary | |
pretty :: Show a => [a] -> ([a] -> [a]) -> String -> IO () | |
pretty src order prefix = do | |
putStrLn $ "\n" ++ prefix ++ "\n" | |
mapM_ print $ order src | |
data File = File | |
{ name :: String | |
, date :: UTCTime | |
, size :: Integer | |
, content :: String | |
} deriving Show | |
data Dir = Dir | |
{ dirName :: String | |
, dirDate :: UTCTime | |
, dirContent :: [FilePath] | |
} deriving Show | |
list :: String -> IO ([Dir], [File]) | |
list path = doesDirectoryExist path >>= \case | |
True -> do | |
dir <- Dir path <$> getModificationTime path <*> listDirectory path | |
-- Recursivly walk subpaths after removing unwanted files and prepending directory name | |
sublist <- mapM (list . (path</>)) $ filter (/=".DS_Store") $ dirContent dir | |
return $ ([dir], []) <> fold sublist | |
False -> do | |
file <- File path <$> getModificationTime path <*> getFileSize path <*> readFile path | |
return ([], [file]) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment