-- | Directory functions using 'find' system utility.
module Music.Theory.Directory.Find where

import Data.List {- base -}
import Data.Maybe {- base -}

import qualified System.Process {- process -}

{- | Find files having indicated filename.
This runs the system utility /find/, so is Unix only.

> dir_find "DX7-ROM1A.syx" "/home/rohan/sw/hsc3-data/data/yamaha/"
-}
dir_find :: FilePath -> FilePath -> IO [FilePath]
dir_find :: FilePath -> FilePath -> IO [FilePath]
dir_find FilePath
fn FilePath
dir = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> [FilePath]
lines (FilePath -> [FilePath] -> FilePath -> IO FilePath
System.Process.readProcess FilePath
"find" [FilePath
dir,FilePath
"-name",FilePath
fn] FilePath
"")

{- | Require that exactly one file is located, else error.

> dir_find_1 "DX7-ROM1A.syx" "/home/rohan/sw/hsc3-data/data/yamaha/"
-}
dir_find_1 :: FilePath -> FilePath -> IO FilePath
dir_find_1 :: FilePath -> FilePath -> IO FilePath
dir_find_1 FilePath
fn FilePath
dir = do
  [FilePath]
r <- FilePath -> FilePath -> IO [FilePath]
dir_find FilePath
fn FilePath
dir
  case [FilePath]
r of
    [FilePath
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
    [FilePath]
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"dir_find_1?"

{- | Recursively find files having case-insensitive filename extension.
This runs the system utility /find/, so is Unix only.

> dir_find_ext ".syx" "/home/rohan/sw/hsc3-data/data/yamaha/"
-}
dir_find_ext :: String -> FilePath -> IO [FilePath]
dir_find_ext :: FilePath -> FilePath -> IO [FilePath]
dir_find_ext FilePath
ext FilePath
dir = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> [FilePath]
lines (FilePath -> [FilePath] -> FilePath -> IO FilePath
System.Process.readProcess FilePath
"find" [FilePath
dir,FilePath
"-iname",Char
'*' forall a. a -> [a] -> [a]
: FilePath
ext] FilePath
"")

{- | Post-process 'dir_find_ext' to delete starting directory.

> dir_find_ext_rel ".syx" "/home/rohan/sw/hsc3-data/data/yamaha/"
-}
dir_find_ext_rel :: String -> FilePath -> IO [FilePath]
dir_find_ext_rel :: FilePath -> FilePath -> IO [FilePath]
dir_find_ext_rel FilePath
ext FilePath
dir =
  let f :: FilePath -> FilePath
f = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"dir_find_ext_rel?") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
dir
  in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
f) (FilePath -> FilePath -> IO [FilePath]
dir_find_ext FilePath
ext FilePath
dir)

{- | Scan each directory on path recursively for file.
Stop once a file is located.
Runs 'dir_find' so is Unix only.

> path_scan_recursively ["/home/rohan/sw/hmt-base"] "Directory.hs"
-}
path_scan_recursively :: [FilePath] -> FilePath -> IO (Maybe FilePath)
path_scan_recursively :: [FilePath] -> FilePath -> IO (Maybe FilePath)
path_scan_recursively [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' -> do
      [FilePath]
r <- FilePath -> FilePath -> IO [FilePath]
dir_find FilePath
fn FilePath
dir
      case [FilePath]
r of
        [] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
path_scan_recursively [FilePath]
p' FilePath
fn
        FilePath
x:[FilePath]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FilePath
x)

{- | Search each directory on path recursively for file.
Runs 'dir_find' so is Unix only.

> path_search_recursively ["/home/rohan/sw"] "README.md"
-}
path_search_recursively :: [FilePath] -> FilePath -> IO [FilePath]
path_search_recursively :: [FilePath] -> FilePath -> IO [FilePath]
path_search_recursively [FilePath]
p FilePath
fn =
  case [FilePath]
p of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    FilePath
dir:[FilePath]
p' -> do
      [FilePath]
r <- FilePath -> FilePath -> IO [FilePath]
dir_find FilePath
fn FilePath
dir
      [FilePath]
r' <- [FilePath] -> FilePath -> IO [FilePath]
path_search_recursively [FilePath]
p' FilePath
fn
      forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
r forall a. [a] -> [a] -> [a]
++ [FilePath]
r')