-- |
-- 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 {} = Maybe (Field CommentsPragmas) -> m (Maybe (Field CommentsPragmas))
forall a. a -> m a
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 (Position
_, 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 a b. (a -> b) -> m a -> m b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a. a -> Maybe a
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
emptyCommentsPragmas (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 a. a -> m a
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 :: forall r (m :: * -> *).
MonadCabalFmt r m =>
[FieldPragma] -> m [Glob]
parse = ([[Glob]] -> [Glob]) -> m [[Glob]] -> m [Glob]
forall a b. (a -> b) -> m a -> m b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a. a -> m a
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 a. a -> m a
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 <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
fp -> FilePath
dir FilePath -> FilePath -> FilePath
Native.</> 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> m [FilePath]) -> [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
toPosix ([FilePath] -> [FilePath]) -> [FilePath] -> [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

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