-- |
-- License: GPL-3.0-or-later
-- Copyright: Oleg Grenrus
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
module CabalFmt.Refactoring.GlobFiles (
    refactoringGlobFiles,
) where

import qualified Distribution.Fields   as C
import qualified System.FilePath       as Native
import qualified System.FilePath.Posix as Posix

import CabalFmt.Glob
import CabalFmt.Monad
import CabalFmt.Pragma
import CabalFmt.Prelude
import CabalFmt.Refactoring.Type

refactoringGlobFiles :: FieldRefactoring
refactoringGlobFiles :: FieldRefactoring
refactoringGlobFiles C.Section {} = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
refactoringGlobFiles (C.Field name :: Name CommentsPragmas
name@(C.Name (Comments
_, [FieldPragma]
pragmas) FieldName
_n) [FieldLine CommentsPragmas]
fls) = do
    [Glob]
globs <- forall r (m :: * -> *).
MonadCabalFmt r m =>
[FieldPragma] -> m [Glob]
parse [FieldPragma]
pragmas
    [FilePath]
files <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall r (m :: * -> *). MonadCabalFmt r m => Glob -> m [FilePath]
match' [Glob]
globs)

    let newFiles :: [C.FieldLine CommentsPragmas]
        newFiles :: [FieldLine CommentsPragmas]
newFiles = forall a. [Maybe a] -> [a]
catMaybes
            [ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall ann. ann -> FieldName -> FieldLine ann
C.FieldLine forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ FilePath -> FieldName
toUTF8BS FilePath
file
            | FilePath
file <- [FilePath]
files
            ]

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case [FilePath]
files of
        [] -> forall a. Maybe a
Nothing
        [FilePath]
_  -> forall a. a -> Maybe a
Just (forall ann. Name ann -> [FieldLine ann] -> Field ann
C.Field Name CommentsPragmas
name ([FieldLine CommentsPragmas]
newFiles forall a. [a] -> [a] -> [a]
++ [FieldLine CommentsPragmas]
fls))

  where
    parse :: MonadCabalFmt r m => [FieldPragma] -> m [Glob]
    parse :: forall r (m :: * -> *).
MonadCabalFmt r m =>
[FieldPragma] -> m [Glob]
parse = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *} {r}.
MonadCabalFmt r m =>
FieldPragma -> m [Glob]
go where
        go :: FieldPragma -> m [Glob]
go (PragmaGlobFiles Glob
g) = forall (m :: * -> *) a. Monad m => a -> m a
return [ Glob
g ]
        go FieldPragma
p = do
            forall r (m :: * -> *). MonadCabalFmt r m => FilePath -> m ()
displayWarning forall a b. (a -> b) -> a -> b
$ FilePath
"Skipped pragma " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FieldPragma
p
            forall (m :: * -> *) a. Monad m => a -> m a
return []

    match' :: MonadCabalFmt r m => Glob -> m [FilePath]
    match' :: forall r (m :: * -> *). MonadCabalFmt r m => Glob -> m [FilePath]
match' g :: Glob
g@(Glob FilePath
dir [GlobPiece]
_) = do
        [FilePath]
files <- forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
fp -> FilePath
dir FilePath -> FilePath -> FilePath
Native.</> FilePath
fp) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *).
MonadCabalFmt r m =>
FilePath -> m [FilePath]
getFiles FilePath
dir
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
toPosix forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Glob -> FilePath -> Bool
match Glob
g) [FilePath]
files

    toPosix :: FilePath -> FilePath
    toPosix :: FilePath -> FilePath
toPosix = [FilePath] -> FilePath
Posix.joinPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
Native.splitDirectories