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

import qualified Distribution.Fields       as C

import CabalFmt.Comments
import CabalFmt.Monad
import CabalFmt.Pragma

-------------------------------------------------------------------------------
-- Refactoring type
-------------------------------------------------------------------------------

type CommentsPragmas = (Comments, [FieldPragma])

type FieldRefactoring
    = forall r m. MonadCabalFmt r m
    => (C.Field CommentsPragmas -> m (Maybe (C.Field CommentsPragmas)))

-------------------------------------------------------------------------------
-- Traversing refactoring
-------------------------------------------------------------------------------

-- | A top-to-bottom rewrite of sections and fields
rewriteFields
    :: MonadCabalFmt r m
    => (C.Field CommentsPragmas -> m (Maybe (C.Field CommentsPragmas)))
    -> [C.Field CommentsPragmas] -> m [C.Field CommentsPragmas]
rewriteFields :: (Field CommentsPragmas -> m (Maybe (Field CommentsPragmas)))
-> [Field CommentsPragmas] -> m [Field CommentsPragmas]
rewriteFields Field CommentsPragmas -> m (Maybe (Field CommentsPragmas))
f = [Field CommentsPragmas] -> m [Field CommentsPragmas]
goMany where
    goMany :: [Field CommentsPragmas] -> m [Field CommentsPragmas]
goMany = (Field CommentsPragmas -> m (Field CommentsPragmas))
-> [Field CommentsPragmas] -> m [Field CommentsPragmas]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Field CommentsPragmas -> m (Field CommentsPragmas)
go

    go :: Field CommentsPragmas -> m (Field CommentsPragmas)
go Field CommentsPragmas
x = do
        Maybe (Field CommentsPragmas)
m <- Field CommentsPragmas -> m (Maybe (Field CommentsPragmas))
f Field CommentsPragmas
x
        case Maybe (Field CommentsPragmas)
m of
            Just Field CommentsPragmas
y -> Field CommentsPragmas -> m (Field CommentsPragmas)
forall (m :: * -> *) a. Monad m => a -> m a
return Field CommentsPragmas
y
            Maybe (Field CommentsPragmas)
Nothing -> case Field CommentsPragmas
x of
                C.Field {}             -> Field CommentsPragmas -> m (Field CommentsPragmas)
forall (m :: * -> *) a. Monad m => a -> m a
return Field CommentsPragmas
x
                C.Section Name CommentsPragmas
name [SectionArg CommentsPragmas]
args [Field CommentsPragmas]
fs -> Name CommentsPragmas
-> [SectionArg CommentsPragmas]
-> [Field CommentsPragmas]
-> Field CommentsPragmas
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
C.Section Name CommentsPragmas
name [SectionArg CommentsPragmas]
args ([Field CommentsPragmas] -> Field CommentsPragmas)
-> m [Field CommentsPragmas] -> m (Field CommentsPragmas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field CommentsPragmas] -> m [Field CommentsPragmas]
goMany [Field CommentsPragmas]
fs