{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -- | -- License: GPL-3.0-or-later -- Copyright: Oleg Grenrus module CabalGild.Refactoring.GlobFiles ( refactoringGlobFiles, ) where import CabalGild.Glob import CabalGild.Monad import CabalGild.Pragma import CabalGild.Prelude import CabalGild.Refactoring.Type import qualified Distribution.Fields as C import qualified System.FilePath as Native import qualified System.FilePath.Posix as Posix refactoringGlobFiles :: FieldRefactoring refactoringGlobFiles C.Section {} = pure Nothing refactoringGlobFiles (C.Field name@(C.Name (_, _, pragmas) _n) fls) = do globs <- parse pragmas files <- fmap concat (traverse match' globs) let newFiles :: [C.FieldLine CommentsPragmas] newFiles = catMaybes [ return $ C.FieldLine emptyCommentsPragmas $ toUTF8BS file | file <- files ] pure $ case files of [] -> Nothing _ -> Just (C.Field name (newFiles ++ fls)) where parse :: (MonadCabalGild r m) => [FieldPragma] -> m [Glob] parse = fmap mconcat . traverse go where go :: (MonadCabalGild r m) => FieldPragma -> m [Glob] go (PragmaGlobFiles g) = return [g] go p = do displayWarning $ "Skipped pragma " ++ show p return [] match' :: (MonadCabalGild r m) => Glob -> m [FilePath] match' g@(Glob dir _) = do files <- map (dir Native.) <$> getFiles dir return $ map toPosix $ filter (match g) files toPosix :: FilePath -> FilePath toPosix = Posix.joinPath . Native.splitDirectories