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

import qualified Distribution.Fields     as C
import qualified Distribution.ModuleName as C

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

refactoringExpandExposedModules :: FieldRefactoring
refactoringExpandExposedModules :: Field CommentsPragmas -> m (Maybe (Field CommentsPragmas))
refactoringExpandExposedModules 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
refactoringExpandExposedModules (C.Field name :: Name CommentsPragmas
name@(C.Name (Comments
_, [FieldPragma]
pragmas) FieldName
_n) [FieldLine CommentsPragmas]
fls) = do
    [(FilePath, [ModuleName])]
dirs <- [FieldPragma] -> m [(FilePath, [ModuleName])]
forall r (m :: * -> *).
MonadCabalFmt r m =>
[FieldPragma] -> m [(FilePath, [ModuleName])]
parse [FieldPragma]
pragmas
    [([FilePath], [ModuleName])]
files <- ((FilePath -> m [FilePath])
 -> [(FilePath, [ModuleName])] -> m [([FilePath], [ModuleName])])
-> (FilePath -> m [FilePath])
-> [(FilePath, [ModuleName])]
-> m [([FilePath], [ModuleName])]
forall (f :: * -> *) a b s t.
Applicative f =>
((a -> f b) -> s -> f t) -> (a -> f b) -> s -> f t
traverseOf (((FilePath, [ModuleName]) -> m ([FilePath], [ModuleName]))
-> [(FilePath, [ModuleName])] -> m [([FilePath], [ModuleName])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((FilePath, [ModuleName]) -> m ([FilePath], [ModuleName]))
 -> [(FilePath, [ModuleName])] -> m [([FilePath], [ModuleName])])
-> ((FilePath -> m [FilePath])
    -> (FilePath, [ModuleName]) -> m ([FilePath], [ModuleName]))
-> (FilePath -> m [FilePath])
-> [(FilePath, [ModuleName])]
-> m [([FilePath], [ModuleName])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> m [FilePath])
-> (FilePath, [ModuleName]) -> m ([FilePath], [ModuleName])
forall (f :: * -> *) a b c.
Functor f =>
(a -> f b) -> (a, c) -> f (b, c)
_1) FilePath -> m [FilePath]
forall r (m :: * -> *).
MonadCabalFmt r m =>
FilePath -> m [FilePath]
getFiles [(FilePath, [ModuleName])]
dirs

    let newModules :: [C.FieldLine CommentsPragmas]
        newModules :: [FieldLine CommentsPragmas]
newModules = [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 -> FieldName) -> FilePath -> FieldName
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"." [FilePath]
parts
            | ([FilePath]
files', [ModuleName]
mns) <- [([FilePath], [ModuleName])]
files
            , FilePath
file <- [FilePath]
files'
            , let parts :: [FilePath]
parts = FilePath -> [FilePath]
splitDirectories (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
dropExtension FilePath
file
            , (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all FilePath -> Bool
C.validModuleComponent [FilePath]
parts
            , let mn :: ModuleName
mn = [FilePath] -> ModuleName
C.fromComponents [FilePath]
parts
            , ModuleName
mn ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ModuleName]
mns
            ]

    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 [FieldLine CommentsPragmas]
newModules of
        [] -> Maybe (Field CommentsPragmas)
forall a. Maybe a
Nothing
        [FieldLine CommentsPragmas]
_  -> 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]
newModules [FieldLine CommentsPragmas]
-> [FieldLine CommentsPragmas] -> [FieldLine CommentsPragmas]
forall a. [a] -> [a] -> [a]
++ [FieldLine CommentsPragmas]
fls))

  where
    parse :: MonadCabalFmt r m => [FieldPragma] -> m [(FilePath, [C.ModuleName])]
    parse :: [FieldPragma] -> m [(FilePath, [ModuleName])]
parse = ([[(FilePath, [ModuleName])]] -> [(FilePath, [ModuleName])])
-> m [[(FilePath, [ModuleName])]] -> m [(FilePath, [ModuleName])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(FilePath, [ModuleName])]] -> [(FilePath, [ModuleName])]
forall a. Monoid a => [a] -> a
mconcat (m [[(FilePath, [ModuleName])]] -> m [(FilePath, [ModuleName])])
-> ([FieldPragma] -> m [[(FilePath, [ModuleName])]])
-> [FieldPragma]
-> m [(FilePath, [ModuleName])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldPragma -> m [(FilePath, [ModuleName])])
-> [FieldPragma] -> m [[(FilePath, [ModuleName])]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FieldPragma -> m [(FilePath, [ModuleName])]
forall (m :: * -> *) r.
MonadCabalFmt r m =>
FieldPragma -> m [(FilePath, [ModuleName])]
go where
        go :: FieldPragma -> m [(FilePath, [ModuleName])]
go (PragmaExpandModules FilePath
fp [ModuleName]
mns) = [(FilePath, [ModuleName])] -> m [(FilePath, [ModuleName])]
forall (m :: * -> *) a. Monad m => a -> m a
return [ (FilePath
fp, [ModuleName]
mns) ]
        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
            [(FilePath, [ModuleName])] -> m [(FilePath, [ModuleName])]
forall (m :: * -> *) a. Monad m => a -> m a
return []