blob: ce9ab453916e5ccf027164b8c53ecc48997ff948 (
plain)
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
module Coolbal.FindSpec (findCabalSpec, FoundCabalSpec(..)) where
import Data.List (unfoldr)
import System.Directory
import System.Exit (exitFailure)
import System.FilePath ((</>))
import System.IO (hPutStrLn, stderr)
data FoundCabalSpec = FoundCabalSpec
{ foundcsRootDir :: FilePath
, foundcsCabal :: FilePath }
deriving (Show)
findCabalSpec :: IO FoundCabalSpec
findCabalSpec = do
cwd <- getCurrentDirectory >>= makeAbsolute
mfound <- findCabalSpecInDirs (ancestors cwd)
case mfound of
Just found -> do
putStrLn ("Found .cabal file: " ++ foundcsCabal found)
return found
Nothing -> do
hPutStrLn stderr (".cabal file not found in ancestors of PWD: " ++ cwd)
exitFailure
findCabalSpecInDirs :: [FilePath] -> IO (Maybe FoundCabalSpec)
findCabalSpecInDirs [] = return Nothing
findCabalSpecInDirs (p:ps) =
findCabalSpecInDir p >>= maybe (findCabalSpecInDirs ps) (return . Just)
findCabalSpecInDir :: FilePath -> IO (Maybe FoundCabalSpec)
findCabalSpecInDir dir = do
files <- filter (`endsWith` ".cabal") <$> listDirectory dir
case files of
[fname] -> do
exists <- doesFileExist (dir </> fname)
return (if exists then Just (FoundCabalSpec { foundcsRootDir = dir
, foundcsCabal = dir </> fname })
else Nothing)
[] -> return Nothing
_ -> do
hPutStrLn stderr "Ambiguous cabal file! Found files:"
mapM_ (\p -> hPutStrLn stderr ("- " ++ (dir </> p))) files
exitFailure
parentDir :: FilePath -> Maybe FilePath
parentDir s = case reverse s of
"/" -> Nothing
'/' : s' -> Just (reverse (dropWhile (/= '/') s'))
s' -> case dropWhile (/= '/') s' of
"/" -> Just "/"
_ : s'' -> Just (reverse s'')
"" -> Nothing
-- Includes the path itself as first element
ancestors :: FilePath -> [FilePath]
ancestors p = p : unfoldr (fmap (\x -> (x,x)) . parentDir) p
endsWith :: String -> String -> Bool
s `endsWith` s' = reverse (take (length s') (reverse s)) == s'
|
