No title

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
{-# LANGUAGE OverloadedStrings #-}
import           Control.Monad
import           Control.Monad.IO.Class
import           Filesystem                (createTree, isDirectory, isFile,
                                            listDirectory)
import           Filesystem.Path.CurrentOS
import           Pipes
import qualified Pipes.Prelude             as P
import           Pipes.Safe
import           Pipes.Safe.Prelude
import           Prelude                   hiding (FilePath, readFile, writeFile, withFile)
import           System.IO (IOMode(..))

main :: IO ()
main = runSafeT $ runEffect $ for (traverse "input") $ \infile -> do
    Just suffix <- return $ stripPrefix "input/" infile
    let outfile = "output" </> suffix
    liftIO $ createTree $ directory outfile
    withFile (encodeString infile) ReadMode $ \input ->
      withFile (encodeString outfile) WriteMode $ \output ->
        P.fromHandle input >-> P.toHandle output

traverse :: MonadIO m => FilePath -> Producer FilePath m ()
traverse root =
    liftIO (listDirectory root) >>= pull
  where
    pull [] = return ()
    pull (p:ps) = do
        isFile' <- liftIO $ isFile p
        if isFile'
            then yield p >> pull ps
            else do
                follow' <- liftIO $ isDirectory p
                if follow'
                    then do
                        ps' <- liftIO $ listDirectory p
                        pull ps
                        pull ps'
                    else pull ps