47 lines
1.5 KiB
Haskell
47 lines
1.5 KiB
Haskell
module Files (
|
|
File(..)
|
|
, absoluteLink
|
|
, filePath
|
|
, find
|
|
, getXDGData
|
|
) where
|
|
|
|
import System.Directory (doesDirectoryExist, doesFileExist, doesPathExist, listDirectory)
|
|
import System.Environment.XDG.BaseDir (getAllDataDirs)
|
|
import System.Exit (die)
|
|
import System.FilePath ((</>))
|
|
|
|
data File = File FilePath | Dir FilePath
|
|
|
|
absoluteLink :: FilePath -> FilePath
|
|
absoluteLink ('.':path) = path
|
|
absoluteLink path = "/" </> path
|
|
|
|
filePath :: File -> IO (Either String FilePath)
|
|
filePath = filePathAux
|
|
where
|
|
filePathAux (File path) = ifIO doesFileExist path Right (notExist . File)
|
|
filePathAux (Dir path) = ifIO doesDirectoryExist path Right (notExist . Dir)
|
|
ifIO predicate value whenTrue whenFalse = do
|
|
result <- predicate value
|
|
return $ if result then whenTrue value else whenFalse value
|
|
notExist (File path) = Left $ path ++ ": no such file"
|
|
notExist (Dir path) = Left $ path ++ ": no such directory"
|
|
|
|
find :: FilePath -> IO [FilePath]
|
|
find path =
|
|
filePath (Dir path) >>= emptyIfMissing (fmap ((path </>) <$>) . listDirectory)
|
|
where
|
|
emptyIfMissing = either (\_ -> return [])
|
|
|
|
getXDGData :: FilePath -> IO FilePath
|
|
getXDGData resource = getAllDataDirs relativePath >>= findFirst
|
|
where
|
|
relativePath = "hablo" </> resource
|
|
findFirst [] = die ("Install is broken: "
|
|
<> relativePath
|
|
<> " directory wasn't found in any of $XDG_DATA_DIRS")
|
|
findFirst (path:paths) = do
|
|
fileExists <- doesPathExist path
|
|
if fileExists then pure path else findFirst paths
|