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

    let newModules :: [C.FieldLine CommentsPragmas]
        newModules :: [FieldLine CommentsPragmas]
newModules = 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
$ [Char] -> FieldName
toUTF8BS forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
dropExtension [Char]
file
            , 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ModuleName]
mns
            ]

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case [FieldLine CommentsPragmas]
newModules of
        [] -> forall a. Maybe a
Nothing
        [FieldLine CommentsPragmas]
_  -> forall a. a -> Maybe a
Just (forall ann. Name ann -> [FieldLine ann] -> Field ann
C.Field Name CommentsPragmas
name ([FieldLine CommentsPragmas]
newModules 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 = 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 [([Char], [ModuleName])]
go where
        go :: FieldPragma -> m [([Char], [ModuleName])]
go (PragmaExpandModules [Char]
fp [ModuleName]
mns) = forall (m :: * -> *) a. Monad m => a -> m a
return [ ([Char]
fp, [ModuleName]
mns) ]
        go FieldPragma
p = do
            forall r (m :: * -> *). MonadCabalFmt r m => [Char] -> m ()
displayWarning forall a b. (a -> b) -> a -> b
$ [Char]
"Skipped pragma " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FieldPragma
p
            forall (m :: * -> *) a. Monad m => a -> m a
return []