{-# 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
, 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 []