-- |
-- License: GPL-3.0-or-later
-- Copyright: Oleg Grenrus
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
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 :: FieldRefactoring
refactoringExpandExposedModules 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
refactoringExpandExposedModules (C.Field name :: Name CommentsPragmas
name@(C.Name (Position
_, Comments
_, [FieldPragma]
pragmas) FieldName
_n) [FieldLine CommentsPragmas]
fls) = do
    [([Char], [ModuleName])]
dirs <- [FieldPragma] -> m [([Char], [ModuleName])]
forall r (m :: * -> *).
MonadCabalFmt r m =>
[FieldPragma] -> m [([Char], [ModuleName])]
parse [FieldPragma]
pragmas
    [([[Char]], [ModuleName])]
files <- (([Char] -> m [[Char]])
 -> [([Char], [ModuleName])] -> m [([[Char]], [ModuleName])])
-> ([Char] -> m [[Char]])
-> [([Char], [ModuleName])]
-> m [([[Char]], [ModuleName])]
forall (f :: * -> *) a b s t.
Applicative f =>
((a -> f b) -> s -> f t) -> (a -> f b) -> s -> f t
traverseOf ((([Char], [ModuleName]) -> m ([[Char]], [ModuleName]))
-> [([Char], [ModuleName])] -> m [([[Char]], [ModuleName])]
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 ((([Char], [ModuleName]) -> m ([[Char]], [ModuleName]))
 -> [([Char], [ModuleName])] -> m [([[Char]], [ModuleName])])
-> (([Char] -> m [[Char]])
    -> ([Char], [ModuleName]) -> m ([[Char]], [ModuleName]))
-> ([Char] -> m [[Char]])
-> [([Char], [ModuleName])]
-> m [([[Char]], [ModuleName])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> m [[Char]])
-> ([Char], [ModuleName]) -> m ([[Char]], [ModuleName])
forall (f :: * -> *) a b c.
Functor f =>
(a -> f b) -> (a, c) -> f (b, c)
_1) [Char] -> m [[Char]]
forall r (m :: * -> *). MonadCabalFmt r m => [Char] -> m [[Char]]
getFiles [([Char], [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 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
$ [Char] -> FieldName
toUTF8BS ([Char] -> FieldName) -> [Char] -> FieldName
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." [[Char]]
parts
            | ([[Char]]
files', [ModuleName]
mns) <- [([[Char]], [ModuleName])]
files
            , [Char]
file <- [[Char]]
files'
            , let parts :: [[Char]]
parts = [Char] -> [[Char]]
splitDirectories ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
dropExtension [Char]
file
            , ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Char] -> Bool
C.validModuleComponent [[Char]]
parts
            , let mn :: ModuleName
mn = [[Char]] -> ModuleName
C.fromComponents [[Char]]
parts -- TODO: don't use fromComponents
            , 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 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 [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 :: forall r (m :: * -> *).
MonadCabalFmt r m =>
[FieldPragma] -> m [([Char], [ModuleName])]
parse = ([[([Char], [ModuleName])]] -> [([Char], [ModuleName])])
-> m [[([Char], [ModuleName])]] -> m [([Char], [ModuleName])]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[([Char], [ModuleName])]] -> [([Char], [ModuleName])]
forall a. Monoid a => [a] -> a
mconcat (m [[([Char], [ModuleName])]] -> m [([Char], [ModuleName])])
-> ([FieldPragma] -> m [[([Char], [ModuleName])]])
-> [FieldPragma]
-> m [([Char], [ModuleName])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldPragma -> m [([Char], [ModuleName])])
-> [FieldPragma] -> m [[([Char], [ModuleName])]]
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 [([Char], [ModuleName])]
forall {m :: * -> *} {r}.
MonadCabalFmt r m =>
FieldPragma -> m [([Char], [ModuleName])]
go where
        go :: FieldPragma -> m [([Char], [ModuleName])]
go (PragmaExpandModules [Char]
fp [ModuleName]
mns) = [([Char], [ModuleName])] -> m [([Char], [ModuleName])]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ ([Char]
fp, [ModuleName]
mns) ]
        go FieldPragma
p = do
            [Char] -> m ()
forall r (m :: * -> *). MonadCabalFmt r m => [Char] -> m ()
displayWarning ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Skipped pragma " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FieldPragma -> [Char]
forall a. Show a => a -> [Char]
show FieldPragma
p
            [([Char], [ModuleName])] -> m [([Char], [ModuleName])]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []