-- | Directory functions.
module Music.Theory.Directory where

import Control.Monad {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import qualified System.Environment {- base -}

import qualified Data.List.Split {- split -}
import System.Directory {- directory -}
import System.FilePath {- filepath -}

import qualified Music.Theory.Monad {- hmt-base -}

{- | 'takeDirectory' gives different answers depending on whether there is a trailing separator.

> x = ["x/y","x/y/","x","/"]
> map parent_dir x == ["x","x",".","/"]
> map takeDirectory x == ["x","x/y",".","/"]
-}
parent_dir :: FilePath -> FilePath
parent_dir :: FilePath -> FilePath
parent_dir = FilePath -> FilePath
takeDirectory forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropTrailingPathSeparator

-- | Colon separated path list.
path_split :: String -> [FilePath]
path_split :: FilePath -> [FilePath]
path_split = forall a. Eq a => [a] -> [a] -> [[a]]
Data.List.Split.splitOn FilePath
":"

{- | Read environment variable and split path.
     Error if enviroment variable not set.

> path_from_env "PATH"
> path_from_env "NONPATH" -- error
-}
path_from_env :: String -> IO [FilePath]
path_from_env :: FilePath -> IO [FilePath]
path_from_env FilePath
k = do
  Maybe FilePath
p <- FilePath -> IO (Maybe FilePath)
System.Environment.lookupEnv FilePath
k
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => FilePath -> a
error (FilePath
"Environment variable not set: " forall a. [a] -> [a] -> [a]
++ FilePath
k)) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
path_split) Maybe FilePath
p

{- | Expand a path to include all subdirectories recursively.

> p = ["/home/rohan/sw/hmt-base/Music", "/home/rohan/sw/hmt/Music"]
> r <- path_recursive p
> length r == 44
-}
path_recursive :: [FilePath] -> IO [FilePath]
path_recursive :: [FilePath] -> IO [FilePath]
path_recursive [FilePath]
p = do
  [[FilePath]]
p' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
dir_subdirs_recursively [FilePath]
p
  forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
p forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
p')

{- | Scan a list of directories until a file is located, or not.
Stop once a file is located, do not traverse any sub-directory structure.

> mapM (path_scan ["/sbin","/usr/bin"]) ["fsck","ghc"]
-}
path_scan :: [FilePath] -> FilePath -> IO (Maybe FilePath)
path_scan :: [FilePath] -> FilePath -> IO (Maybe FilePath)
path_scan [FilePath]
p FilePath
fn =
    case [FilePath]
p of
      [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      FilePath
dir:[FilePath]
p' -> let nm :: FilePath
nm = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
fn
                    f :: Bool -> IO (Maybe FilePath)
f Bool
x = if Bool
x then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FilePath
nm) else [FilePath] -> FilePath -> IO (Maybe FilePath)
path_scan [FilePath]
p' FilePath
fn
                in FilePath -> IO Bool
doesFileExist FilePath
nm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> IO (Maybe FilePath)
f

-- | Erroring variant.
path_scan_err :: [FilePath] -> FilePath -> IO FilePath
path_scan_err :: [FilePath] -> FilePath -> IO FilePath
path_scan_err [FilePath]
p FilePath
x =
    let err :: a
err = forall a. HasCallStack => FilePath -> a
error (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath
"path_scan: ",forall a. Show a => a -> FilePath
show [FilePath]
p,FilePath
": ",FilePath
x])
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err) ([FilePath] -> FilePath -> IO (Maybe FilePath)
path_scan [FilePath]
p FilePath
x)

{- | Scan a list of directories and return all located files.
Do not traverse any sub-directory structure.
Since 1.2.1.0 there is also findFiles.

> let path = ["/home/rohan/sw/hmt-base","/home/rohan/sw/hmt"]
> path_search path "README.md"
> findFiles path "README.md"
-}
path_search :: [FilePath] -> FilePath -> IO [FilePath]
path_search :: [FilePath] -> FilePath -> IO [FilePath]
path_search [FilePath]
p FilePath
fn = do
  let fq :: [FilePath]
fq = forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
dir -> FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
fn) [FilePath]
p
      chk :: FilePath -> IO (Maybe FilePath)
chk FilePath
q = FilePath -> IO Bool
doesFileExist FilePath
q forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
x then forall a. a -> Maybe a
Just FilePath
q else forall a. Maybe a
Nothing)
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (Maybe FilePath)
chk [FilePath]
fq)

-- | Get sorted list of files at /dir/ with /ext/, ie. ls dir/*.ext
--
-- > dir_list_ext "/home/rohan/rd/j/" ".hs"
dir_list_ext :: FilePath -> String -> IO [FilePath]
dir_list_ext :: FilePath -> FilePath -> IO [FilePath]
dir_list_ext FilePath
dir FilePath
ext = do
  [FilePath]
l <- FilePath -> IO [FilePath]
listDirectory FilePath
dir
  let fn :: [FilePath]
fn = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(==) FilePath
ext forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
l
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => [a] -> [a]
sort [FilePath]
fn)

-- | Post-process 'dir_list_ext' to gives file-names with /dir/ prefix.
--
-- > dir_list_ext_path "/home/rohan/rd/j/" ".hs"
dir_list_ext_path :: FilePath -> String -> IO [FilePath]
dir_list_ext_path :: FilePath -> FilePath -> IO [FilePath]
dir_list_ext_path FilePath
dir FilePath
ext = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> FilePath -> FilePath
</>)) (FilePath -> FilePath -> IO [FilePath]
dir_list_ext FilePath
dir FilePath
ext)

-- | Subset of files in /dir/ with an extension in /ext/.
--   Extensions include the leading dot and are case-sensitive.
--   Results are relative to /dir/.
dir_subset_rel :: [String] -> FilePath -> IO [FilePath]
dir_subset_rel :: [FilePath] -> FilePath -> IO [FilePath]
dir_subset_rel [FilePath]
ext FilePath
dir = do
  let f :: FilePath -> Bool
f FilePath
nm = FilePath -> FilePath
takeExtension FilePath
nm forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
ext
  [FilePath]
c <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => [a] -> [a]
sort (forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
f [FilePath]
c))

-- | Variant of dir_subset_rel where results have dir/ prefix.
--
-- > dir_subset [".hs"] "/home/rohan/sw/hmt/cmd"
dir_subset :: [String] -> FilePath -> IO [FilePath]
dir_subset :: [FilePath] -> FilePath -> IO [FilePath]
dir_subset [FilePath]
ext FilePath
dir = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> FilePath -> FilePath
</>)) ([FilePath] -> FilePath -> IO [FilePath]
dir_subset_rel [FilePath]
ext FilePath
dir)

-- | Subdirectories (relative) of /dir/.
dir_subdirs_rel :: FilePath -> IO [FilePath]
dir_subdirs_rel :: FilePath -> IO [FilePath]
dir_subdirs_rel FilePath
dir =
  let sel :: FilePath -> IO Bool
sel FilePath
fn = FilePath -> IO Bool
doesDirectoryExist (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
fn)
  in FilePath -> IO [FilePath]
listDirectory FilePath
dir forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
sel

-- | Subdirectories of /dir/.
dir_subdirs :: FilePath -> IO [FilePath]
dir_subdirs :: FilePath -> IO [FilePath]
dir_subdirs FilePath
dir = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> FilePath -> FilePath
</>)) (FilePath -> IO [FilePath]
dir_subdirs_rel FilePath
dir)

{- | Recursive form of 'dir_subdirs'.

> dir_subdirs_recursively "/home/rohan/sw/hmt-base/Music"
-}
dir_subdirs_recursively :: FilePath -> IO [FilePath]
dir_subdirs_recursively :: FilePath -> IO [FilePath]
dir_subdirs_recursively FilePath
dir = do
  [FilePath]
subdirs <- FilePath -> IO [FilePath]
dir_subdirs FilePath
dir
  case [FilePath]
subdirs of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    [FilePath]
_ -> do
      [[FilePath]]
subdirs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
dir_subdirs_recursively [FilePath]
subdirs
      forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
subdirs forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
subdirs')

-- | If path is not absolute, prepend current working directory.
--
-- > to_absolute_cwd "x"
to_absolute_cwd :: FilePath -> IO FilePath
to_absolute_cwd :: FilePath -> IO FilePath
to_absolute_cwd FilePath
x =
    if FilePath -> Bool
isAbsolute FilePath
x
    then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
    else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
</> FilePath
x) IO FilePath
getCurrentDirectory

-- | If /i/ is an existing file then /j/ else /k/.
if_file_exists :: (FilePath,IO t,IO t) -> IO t
if_file_exists :: forall t. (FilePath, IO t, IO t) -> IO t
if_file_exists (FilePath
i,IO t
j,IO t
k) = forall (m :: * -> *) t. Monad m => (m Bool, m t, m t) -> m t
Music.Theory.Monad.m_if (FilePath -> IO Bool
doesFileExist FilePath
i,IO t
j,IO t
k)

-- | 'createDirectoryIfMissing' (including parents) and then 'writeFile'
writeFile_mkdir :: FilePath -> String -> IO ()
writeFile_mkdir :: FilePath -> FilePath -> IO ()
writeFile_mkdir FilePath
fn FilePath
s = do
  let dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
fn
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  FilePath -> FilePath -> IO ()
writeFile FilePath
fn FilePath
s

-- | 'writeFile_mkdir' only if file does not exist.
writeFile_mkdir_x :: FilePath -> String -> IO ()
writeFile_mkdir_x :: FilePath -> FilePath -> IO ()
writeFile_mkdir_x FilePath
fn FilePath
txt = forall t. (FilePath, IO t, IO t) -> IO t
if_file_exists (FilePath
fn,forall (m :: * -> *) a. Monad m => a -> m a
return (),FilePath -> FilePath -> IO ()
writeFile_mkdir FilePath
fn FilePath
txt)