module Files (
      File(..)
    , absoluteLink
    , filePath
    , find
  ) where

import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
import System.FilePath ((</>))

data File = File FilePath | Dir FilePath

absoluteLink :: FilePath -> FilePath
absoluteLink :: FilePath -> FilePath
absoluteLink (Char
'.':FilePath
path) = FilePath
path
absoluteLink FilePath
path = FilePath
"/" FilePath -> FilePath -> FilePath
</> FilePath
path

filePath :: File -> IO (Either String FilePath)
filePath :: File -> IO (Either FilePath FilePath)
filePath = File -> IO (Either FilePath FilePath)
filePathAux
  where
    filePathAux :: File -> IO (Either FilePath FilePath)
filePathAux (File FilePath
path) = (FilePath -> IO Bool)
-> FilePath
-> (FilePath -> Either FilePath FilePath)
-> (FilePath -> Either FilePath FilePath)
-> IO (Either FilePath FilePath)
forall (m :: * -> *) t b.
Monad m =>
(t -> m Bool) -> t -> (t -> b) -> (t -> b) -> m b
ifIO FilePath -> IO Bool
doesFileExist FilePath
path FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right (File -> Either FilePath FilePath
forall b. File -> Either FilePath b
notExist (File -> Either FilePath FilePath)
-> (FilePath -> File) -> FilePath -> Either FilePath FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> File
File)
    filePathAux (Dir FilePath
path) = (FilePath -> IO Bool)
-> FilePath
-> (FilePath -> Either FilePath FilePath)
-> (FilePath -> Either FilePath FilePath)
-> IO (Either FilePath FilePath)
forall (m :: * -> *) t b.
Monad m =>
(t -> m Bool) -> t -> (t -> b) -> (t -> b) -> m b
ifIO FilePath -> IO Bool
doesDirectoryExist FilePath
path FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right (File -> Either FilePath FilePath
forall b. File -> Either FilePath b
notExist (File -> Either FilePath FilePath)
-> (FilePath -> File) -> FilePath -> Either FilePath FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> File
Dir)
    ifIO :: (t -> m Bool) -> t -> (t -> b) -> (t -> b) -> m b
ifIO t -> m Bool
predicate t
value t -> b
whenTrue t -> b
whenFalse = do
      Bool
result <- t -> m Bool
predicate t
value
      b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ if Bool
result then t -> b
whenTrue t
value else t -> b
whenFalse t
value
    notExist :: File -> Either FilePath b
notExist (File FilePath
path) = FilePath -> Either FilePath b
forall a b. a -> Either a b
Left (FilePath -> Either FilePath b) -> FilePath -> Either FilePath b
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": no such file"
    notExist (Dir FilePath
path) = FilePath -> Either FilePath b
forall a b. a -> Either a b
Left (FilePath -> Either FilePath b) -> FilePath -> Either FilePath b
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": no such directory"

find :: FilePath -> IO [FilePath]
find :: FilePath -> IO [FilePath]
find FilePath
path =
  File -> IO (Either FilePath FilePath)
filePath (FilePath -> File
Dir FilePath
path) IO (Either FilePath FilePath)
-> (Either FilePath FilePath -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO [FilePath])
-> Either FilePath FilePath -> IO [FilePath]
forall b a a. (b -> IO [a]) -> Either a b -> IO [a]
emptyIfMissing (([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath
path FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO [FilePath] -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
listDirectory)
  where
    emptyIfMissing :: (b -> IO [a]) -> Either a b -> IO [a]
emptyIfMissing = (a -> IO [a]) -> (b -> IO [a]) -> Either a b -> IO [a]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
_ -> [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [])