GlobFiles.hs

{-# 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