-- |
-- 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 CabalFmt.Prelude
import CabalFmt.Monad
import CabalFmt.Glob
import CabalFmt.Pragma
import CabalFmt.Refactoring.Type

refactoringGlobFiles :: FieldRefactoring
refactoringGlobFiles :: Field CommentsPragmas -> m (Maybe (Field CommentsPragmas))
refactoringGlobFiles C.Section {} = Maybe (Field CommentsPragmas) -> m (Maybe (Field CommentsPragmas))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Field CommentsPragmas)
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 <- [FieldPragma] -> m [Glob]
forall r (m :: * -> *).
MonadCabalFmt r m =>
[FieldPragma] -> m [Glob]
parse [FieldPragma]
pragmas
    [FilePath]
files <- ([[FilePath]] -> [FilePath]) -> m [[FilePath]] -> m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Glob -> m [FilePath]) -> [Glob] -> m [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Glob -> m [FilePath]
forall r (m :: * -> *). MonadCabalFmt r m => Glob -> m [FilePath]
match' [Glob]
globs)

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

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

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

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