haskell-awk-1.2: src/System/Directory/PathFinder.hs

-- | Tiny DSL for finding a path from the current path.
{-# LANGUAGE LambdaCase, PackageImports #-}
module System.Directory.PathFinder where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.State
import Data.List
import "list-t" ListT (ListT)
import System.Directory
import System.FilePath
import qualified "list-t" ListT


type PathFinder = StateT FilePath (MaybeT IO) ()
type MultiPathFinder = StateT FilePath (ListT IO) ()

runPathFinder :: PathFinder -> FilePath -> IO (Maybe FilePath)
runPathFinder p pwd = runMaybeT (execStateT p pwd)

runMultiPathFinder :: MultiPathFinder -> FilePath -> IO [FilePath]
runMultiPathFinder p pwd = ListT.toList (execStateT p pwd)


filenameIs :: MonadPlus m => String -> StateT FilePath m ()
filenameIs s = do
    pwd <- get
    guard (takeFileName pwd == s)

filenameMatches :: MonadPlus m => String -> String -> StateT FilePath m ()
filenameMatches prefix suffix = do
    pwd <- get
    guard (prefix `isPrefixOf` pwd && suffix `isSuffixOf` pwd)

hasAncestor :: MonadPlus m => String -> StateT FilePath m ()
hasAncestor s = do
    pwd <- get
    guard (s `elem` splitDirectories pwd)

relativePath :: (MonadIO m, MonadPlus m) => FilePath -> StateT FilePath m ()
relativePath rel = do
    pwd <- get
    let pwd' = pwd </> rel
    exists <- liftIO $ doesDirectoryExist pwd'
    guard exists
    pwd'' <- liftIO $ canonicalizePath pwd'
    put pwd''

someChild :: MultiPathFinder
someChild = do
    pwd <- get
    childs <- liftIO $ getDirectoryContents pwd
    child <- lift $ ListT.fromFoldable childs
    put (pwd </> child)