module CabalGild.Unstable.Action.AttachComments where

import qualified CabalGild.Unstable.Type.Comment as Comment
import qualified Control.Monad.Trans.State as StateT
import qualified Distribution.Fields as Fields

-- | High level wrapper around 'field' that makes this action easier to compose
-- with other actions.
run ::
  (Applicative m, Ord p) =>
  ([Fields.Field p], [Comment.Comment p]) ->
  m ([Fields.Field (p, [Comment.Comment p])], [Comment.Comment p])
run :: forall (m :: * -> *) p.
(Applicative m, Ord p) =>
([Field p], [Comment p])
-> m ([Field (p, [Comment p])], [Comment p])
run ([Field p]
fs, [Comment p]
cs) = ([Field (p, [Comment p])], [Comment p])
-> m ([Field (p, [Comment p])], [Comment p])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Field (p, [Comment p])], [Comment p])
 -> m ([Field (p, [Comment p])], [Comment p]))
-> ([Field (p, [Comment p])], [Comment p])
-> m ([Field (p, [Comment p])], [Comment p])
forall a b. (a -> b) -> a -> b
$ State [Comment p] [Field (p, [Comment p])]
-> [Comment p] -> ([Field (p, [Comment p])], [Comment p])
forall s a. State s a -> s -> (a, s)
StateT.runState ((Field p -> StateT [Comment p] Identity (Field (p, [Comment p])))
-> [Field p] -> State [Comment p] [Field (p, [Comment p])]
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 Field p -> StateT [Comment p] Identity (Field (p, [Comment p]))
forall p.
Ord p =>
Field p -> State [Comment p] (Field (p, [Comment p]))
field [Field p]
fs) [Comment p]
cs

-- | Attaches comments to a single field. It is assumed that both the fields
-- and comments are already sorted by their position @p@. This precondition is
-- not checked. Note that comments actually end up attached to the field's
-- name. That's because the 'Field.Field' type doesn't have any annotations
-- directly on it.
field ::
  (Ord p) =>
  Fields.Field p ->
  StateT.State [Comment.Comment p] (Fields.Field (p, [Comment.Comment p]))
field :: forall p.
Ord p =>
Field p -> State [Comment p] (Field (p, [Comment p]))
field Field p
f = case Field p
f of
  Fields.Field Name p
n [FieldLine p]
fls ->
    Name (p, [Comment p])
-> [FieldLine (p, [Comment p])] -> Field (p, [Comment p])
forall ann. Name ann -> [FieldLine ann] -> Field ann
Fields.Field
      (Name (p, [Comment p])
 -> [FieldLine (p, [Comment p])] -> Field (p, [Comment p]))
-> StateT [Comment p] Identity (Name (p, [Comment p]))
-> StateT
     [Comment p]
     Identity
     ([FieldLine (p, [Comment p])] -> Field (p, [Comment p]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name p -> StateT [Comment p] Identity (Name (p, [Comment p]))
forall p.
Ord p =>
Name p -> State [Comment p] (Name (p, [Comment p]))
name Name p
n
      StateT
  [Comment p]
  Identity
  ([FieldLine (p, [Comment p])] -> Field (p, [Comment p]))
-> StateT [Comment p] Identity [FieldLine (p, [Comment p])]
-> State [Comment p] (Field (p, [Comment p]))
forall a b.
StateT [Comment p] Identity (a -> b)
-> StateT [Comment p] Identity a -> StateT [Comment p] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FieldLine p
 -> StateT [Comment p] Identity (FieldLine (p, [Comment p])))
-> [FieldLine p]
-> StateT [Comment p] Identity [FieldLine (p, [Comment p])]
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 FieldLine p
-> StateT [Comment p] Identity (FieldLine (p, [Comment p]))
forall p.
Ord p =>
FieldLine p -> State [Comment p] (FieldLine (p, [Comment p]))
fieldLine [FieldLine p]
fls
  Fields.Section Name p
n [SectionArg p]
sas [Field p]
fs ->
    Name (p, [Comment p])
-> [SectionArg (p, [Comment p])]
-> [Field (p, [Comment p])]
-> Field (p, [Comment p])
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Fields.Section
      (Name (p, [Comment p])
 -> [SectionArg (p, [Comment p])]
 -> [Field (p, [Comment p])]
 -> Field (p, [Comment p]))
-> StateT [Comment p] Identity (Name (p, [Comment p]))
-> StateT
     [Comment p]
     Identity
     ([SectionArg (p, [Comment p])]
      -> [Field (p, [Comment p])] -> Field (p, [Comment p]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name p -> StateT [Comment p] Identity (Name (p, [Comment p]))
forall p.
Ord p =>
Name p -> State [Comment p] (Name (p, [Comment p]))
name Name p
n
      StateT
  [Comment p]
  Identity
  ([SectionArg (p, [Comment p])]
   -> [Field (p, [Comment p])] -> Field (p, [Comment p]))
-> StateT [Comment p] Identity [SectionArg (p, [Comment p])]
-> StateT
     [Comment p]
     Identity
     ([Field (p, [Comment p])] -> Field (p, [Comment p]))
forall a b.
StateT [Comment p] Identity (a -> b)
-> StateT [Comment p] Identity a -> StateT [Comment p] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SectionArg p
 -> StateT [Comment p] Identity (SectionArg (p, [Comment p])))
-> [SectionArg p]
-> StateT [Comment p] Identity [SectionArg (p, [Comment p])]
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 SectionArg p
-> StateT [Comment p] Identity (SectionArg (p, [Comment p]))
forall p.
Ord p =>
SectionArg p -> State [Comment p] (SectionArg (p, [Comment p]))
sectionArg [SectionArg p]
sas
      StateT
  [Comment p]
  Identity
  ([Field (p, [Comment p])] -> Field (p, [Comment p]))
-> StateT [Comment p] Identity [Field (p, [Comment p])]
-> State [Comment p] (Field (p, [Comment p]))
forall a b.
StateT [Comment p] Identity (a -> b)
-> StateT [Comment p] Identity a -> StateT [Comment p] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Field p -> State [Comment p] (Field (p, [Comment p])))
-> [Field p]
-> StateT [Comment p] Identity [Field (p, [Comment p])]
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 Field p -> State [Comment p] (Field (p, [Comment p]))
forall p.
Ord p =>
Field p -> State [Comment p] (Field (p, [Comment p]))
field [Field p]
fs

-- | Attaches comments to a name. Note that this could be a field name or a
-- section name.
name ::
  (Ord p) =>
  Fields.Name p ->
  StateT.State [Comment.Comment p] (Fields.Name (p, [Comment.Comment p]))
name :: forall p.
Ord p =>
Name p -> State [Comment p] (Name (p, [Comment p]))
name (Fields.Name p
p FieldName
fn) =
  (p, [Comment p]) -> FieldName -> Name (p, [Comment p])
forall ann. ann -> FieldName -> Name ann
Fields.Name
    ((p, [Comment p]) -> FieldName -> Name (p, [Comment p]))
-> StateT [Comment p] Identity (p, [Comment p])
-> StateT [Comment p] Identity (FieldName -> Name (p, [Comment p]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> StateT [Comment p] Identity (p, [Comment p])
forall p. Ord p => p -> State [Comment p] (p, [Comment p])
toPosition p
p
    StateT [Comment p] Identity (FieldName -> Name (p, [Comment p]))
-> StateT [Comment p] Identity FieldName
-> StateT [Comment p] Identity (Name (p, [Comment p]))
forall a b.
StateT [Comment p] Identity (a -> b)
-> StateT [Comment p] Identity a -> StateT [Comment p] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> StateT [Comment p] Identity FieldName
forall a. a -> StateT [Comment p] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldName
fn

-- | Attach comments to a field line.
fieldLine ::
  (Ord p) =>
  Fields.FieldLine p ->
  StateT.State [Comment.Comment p] (Fields.FieldLine (p, [Comment.Comment p]))
fieldLine :: forall p.
Ord p =>
FieldLine p -> State [Comment p] (FieldLine (p, [Comment p]))
fieldLine (Fields.FieldLine p
p FieldName
bs) =
  (p, [Comment p]) -> FieldName -> FieldLine (p, [Comment p])
forall ann. ann -> FieldName -> FieldLine ann
Fields.FieldLine
    ((p, [Comment p]) -> FieldName -> FieldLine (p, [Comment p]))
-> StateT [Comment p] Identity (p, [Comment p])
-> StateT
     [Comment p] Identity (FieldName -> FieldLine (p, [Comment p]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> StateT [Comment p] Identity (p, [Comment p])
forall p. Ord p => p -> State [Comment p] (p, [Comment p])
toPosition p
p
    StateT
  [Comment p] Identity (FieldName -> FieldLine (p, [Comment p]))
-> StateT [Comment p] Identity FieldName
-> StateT [Comment p] Identity (FieldLine (p, [Comment p]))
forall a b.
StateT [Comment p] Identity (a -> b)
-> StateT [Comment p] Identity a -> StateT [Comment p] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> StateT [Comment p] Identity FieldName
forall a. a -> StateT [Comment p] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldName
bs

-- | Attaches comments to a section argument. Note that section arguments
-- cannot actually have comments attached. That's because section arguments
-- must be on -- the same line as the section name, so all comments will end up
-- attached to the name.
sectionArg ::
  (Ord p) =>
  Fields.SectionArg p ->
  StateT.State [Comment.Comment p] (Fields.SectionArg (p, [Comment.Comment p]))
sectionArg :: forall p.
Ord p =>
SectionArg p -> State [Comment p] (SectionArg (p, [Comment p]))
sectionArg SectionArg p
sa = case SectionArg p
sa of
  Fields.SecArgName p
p FieldName
bs ->
    (p, [Comment p]) -> FieldName -> SectionArg (p, [Comment p])
forall ann. ann -> FieldName -> SectionArg ann
Fields.SecArgName
      ((p, [Comment p]) -> FieldName -> SectionArg (p, [Comment p]))
-> StateT [Comment p] Identity (p, [Comment p])
-> StateT
     [Comment p] Identity (FieldName -> SectionArg (p, [Comment p]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> StateT [Comment p] Identity (p, [Comment p])
forall p. Ord p => p -> State [Comment p] (p, [Comment p])
toPosition p
p
      StateT
  [Comment p] Identity (FieldName -> SectionArg (p, [Comment p]))
-> StateT [Comment p] Identity FieldName
-> State [Comment p] (SectionArg (p, [Comment p]))
forall a b.
StateT [Comment p] Identity (a -> b)
-> StateT [Comment p] Identity a -> StateT [Comment p] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> StateT [Comment p] Identity FieldName
forall a. a -> StateT [Comment p] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldName
bs
  Fields.SecArgStr p
p FieldName
bs ->
    (p, [Comment p]) -> FieldName -> SectionArg (p, [Comment p])
forall ann. ann -> FieldName -> SectionArg ann
Fields.SecArgStr
      ((p, [Comment p]) -> FieldName -> SectionArg (p, [Comment p]))
-> StateT [Comment p] Identity (p, [Comment p])
-> StateT
     [Comment p] Identity (FieldName -> SectionArg (p, [Comment p]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> StateT [Comment p] Identity (p, [Comment p])
forall p. Ord p => p -> State [Comment p] (p, [Comment p])
toPosition p
p
      StateT
  [Comment p] Identity (FieldName -> SectionArg (p, [Comment p]))
-> StateT [Comment p] Identity FieldName
-> State [Comment p] (SectionArg (p, [Comment p]))
forall a b.
StateT [Comment p] Identity (a -> b)
-> StateT [Comment p] Identity a -> StateT [Comment p] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> StateT [Comment p] Identity FieldName
forall a. a -> StateT [Comment p] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldName
bs
  Fields.SecArgOther p
p FieldName
bs ->
    (p, [Comment p]) -> FieldName -> SectionArg (p, [Comment p])
forall ann. ann -> FieldName -> SectionArg ann
Fields.SecArgOther
      ((p, [Comment p]) -> FieldName -> SectionArg (p, [Comment p]))
-> StateT [Comment p] Identity (p, [Comment p])
-> StateT
     [Comment p] Identity (FieldName -> SectionArg (p, [Comment p]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> StateT [Comment p] Identity (p, [Comment p])
forall p. Ord p => p -> State [Comment p] (p, [Comment p])
toPosition p
p
      StateT
  [Comment p] Identity (FieldName -> SectionArg (p, [Comment p]))
-> StateT [Comment p] Identity FieldName
-> State [Comment p] (SectionArg (p, [Comment p]))
forall a b.
StateT [Comment p] Identity (a -> b)
-> StateT [Comment p] Identity a -> StateT [Comment p] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> StateT [Comment p] Identity FieldName
forall a. a -> StateT [Comment p] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldName
bs

-- | Attaches comments to a position. This is the workhorse of the module.
-- Comments are attached when their position is less than or equal to the given
-- position. The comments are removed from the state as they are attached.
toPosition ::
  (Ord p) =>
  p ->
  StateT.State [Comment.Comment p] (p, [Comment.Comment p])
toPosition :: forall p. Ord p => p -> State [Comment p] (p, [Comment p])
toPosition p
p = do
  [Comment p]
cs <- StateT [Comment p] Identity [Comment p]
forall (m :: * -> *) s. Monad m => StateT s m s
StateT.get
  let ([Comment p]
xs, [Comment p]
ys) = (Comment p -> Bool) -> [Comment p] -> ([Comment p], [Comment p])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
p) (p -> Bool) -> (Comment p -> p) -> Comment p -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comment p -> p
forall a. Comment a -> a
Comment.annotation) [Comment p]
cs
  [Comment p] -> StateT [Comment p] Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateT.put [Comment p]
ys
  (p, [Comment p]) -> State [Comment p] (p, [Comment p])
forall a. a -> StateT [Comment p] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (p
p, [Comment p]
xs)