module CabalGild.Action.RemovePositions where

import qualified CabalGild.Type.Comment as Comment
import qualified Distribution.Fields as Fields

-- | A wrapper around 'fields' to allow this to be composed with other actions.
run ::
  (Applicative m) =>
  ([Fields.Field (p, [Comment.Comment p])], [Comment.Comment p]) ->
  m ([Fields.Field [Comment.Comment ()]], [Comment.Comment ()])
run :: forall (m :: * -> *) p.
Applicative m =>
([Field (p, [Comment p])], [Comment p])
-> m ([Field [Comment ()]], [Comment ()])
run ([Field (p, [Comment p])]
fs, [Comment p]
cs) = ([Field [Comment ()]], [Comment ()])
-> m ([Field [Comment ()]], [Comment ()])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Field (p, [Comment p])] -> [Field [Comment ()]]
forall p. [Field (p, [Comment p])] -> [Field [Comment ()]]
fields [Field (p, [Comment p])]
fs, [Comment p] -> [Comment ()]
forall p. [Comment p] -> [Comment ()]
comments [Comment p]
cs)

-- | Removes the positions from some fields and their comments. This is useful
-- for two reasons: the annotations become simpler, and it's clear that the
-- positions won't be used for anything else.
fields ::
  [Fields.Field (p, [Comment.Comment p])] ->
  [Fields.Field [Comment.Comment ()]]
fields :: forall p. [Field (p, [Comment p])] -> [Field [Comment ()]]
fields = (Field (p, [Comment p]) -> Field [Comment ()])
-> [Field (p, [Comment p])] -> [Field [Comment ()]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field (p, [Comment p]) -> Field [Comment ()]
forall p. Field (p, [Comment p]) -> Field [Comment ()]
field

-- | Removes the positions from a field and its comments.
field ::
  Fields.Field (p, [Comment.Comment p]) ->
  Fields.Field [Comment.Comment ()]
field :: forall p. Field (p, [Comment p]) -> Field [Comment ()]
field Field (p, [Comment p])
f = case Field (p, [Comment p])
f of
  Fields.Field Name (p, [Comment p])
n [FieldLine (p, [Comment p])]
fls -> Name [Comment ()] -> [FieldLine [Comment ()]] -> Field [Comment ()]
forall ann. Name ann -> [FieldLine ann] -> Field ann
Fields.Field (Name (p, [Comment p]) -> Name [Comment ()]
forall p. Name (p, [Comment p]) -> Name [Comment ()]
name Name (p, [Comment p])
n) ([FieldLine [Comment ()]] -> Field [Comment ()])
-> [FieldLine [Comment ()]] -> Field [Comment ()]
forall a b. (a -> b) -> a -> b
$ [FieldLine (p, [Comment p])] -> [FieldLine [Comment ()]]
forall p. [FieldLine (p, [Comment p])] -> [FieldLine [Comment ()]]
fieldLines [FieldLine (p, [Comment p])]
fls
  Fields.Section Name (p, [Comment p])
n [SectionArg (p, [Comment p])]
sas [Field (p, [Comment p])]
fs -> Name [Comment ()]
-> [SectionArg [Comment ()]]
-> [Field [Comment ()]]
-> Field [Comment ()]
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Fields.Section (Name (p, [Comment p]) -> Name [Comment ()]
forall p. Name (p, [Comment p]) -> Name [Comment ()]
name Name (p, [Comment p])
n) ([SectionArg (p, [Comment p])] -> [SectionArg [Comment ()]]
forall p.
[SectionArg (p, [Comment p])] -> [SectionArg [Comment ()]]
sectionArgs [SectionArg (p, [Comment p])]
sas) ([Field [Comment ()]] -> Field [Comment ()])
-> [Field [Comment ()]] -> Field [Comment ()]
forall a b. (a -> b) -> a -> b
$ [Field (p, [Comment p])] -> [Field [Comment ()]]
forall p. [Field (p, [Comment p])] -> [Field [Comment ()]]
fields [Field (p, [Comment p])]
fs

-- | Removes the positions from a name and its comments.
name ::
  Fields.Name (p, [Comment.Comment p]) ->
  Fields.Name [Comment.Comment ()]
name :: forall p. Name (p, [Comment p]) -> Name [Comment ()]
name (Fields.Name (p
_, [Comment p]
cs) FieldName
x) = [Comment ()] -> FieldName -> Name [Comment ()]
forall ann. ann -> FieldName -> Name ann
Fields.Name ([Comment p] -> [Comment ()]
forall p. [Comment p] -> [Comment ()]
comments [Comment p]
cs) FieldName
x

-- | Removes the positions from field lines and their comments.
fieldLines ::
  [Fields.FieldLine (p, [Comment.Comment p])] ->
  [Fields.FieldLine [Comment.Comment ()]]
fieldLines :: forall p. [FieldLine (p, [Comment p])] -> [FieldLine [Comment ()]]
fieldLines = (FieldLine (p, [Comment p]) -> FieldLine [Comment ()])
-> [FieldLine (p, [Comment p])] -> [FieldLine [Comment ()]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldLine (p, [Comment p]) -> FieldLine [Comment ()]
forall p. FieldLine (p, [Comment p]) -> FieldLine [Comment ()]
fieldLine

-- | Removes the positions from a field line and its comments.
fieldLine ::
  Fields.FieldLine (p, [Comment.Comment p]) ->
  Fields.FieldLine [Comment.Comment ()]
fieldLine :: forall p. FieldLine (p, [Comment p]) -> FieldLine [Comment ()]
fieldLine (Fields.FieldLine (p
_, [Comment p]
cs) FieldName
x) = [Comment ()] -> FieldName -> FieldLine [Comment ()]
forall ann. ann -> FieldName -> FieldLine ann
Fields.FieldLine ([Comment p] -> [Comment ()]
forall p. [Comment p] -> [Comment ()]
comments [Comment p]
cs) FieldName
x

-- | Removes the positions from some section arguments and their comments.
sectionArgs ::
  [Fields.SectionArg (p, [Comment.Comment p])] ->
  [Fields.SectionArg [Comment.Comment ()]]
sectionArgs :: forall p.
[SectionArg (p, [Comment p])] -> [SectionArg [Comment ()]]
sectionArgs = (SectionArg (p, [Comment p]) -> SectionArg [Comment ()])
-> [SectionArg (p, [Comment p])] -> [SectionArg [Comment ()]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SectionArg (p, [Comment p]) -> SectionArg [Comment ()]
forall p. SectionArg (p, [Comment p]) -> SectionArg [Comment ()]
sectionArg

-- | Removes the positions from a section argument and its comments.
sectionArg ::
  Fields.SectionArg (p, [Comment.Comment p]) ->
  Fields.SectionArg [Comment.Comment ()]
sectionArg :: forall p. SectionArg (p, [Comment p]) -> SectionArg [Comment ()]
sectionArg SectionArg (p, [Comment p])
sa = case SectionArg (p, [Comment p])
sa of
  Fields.SecArgName (p
_, [Comment p]
cs) FieldName
x -> [Comment ()] -> FieldName -> SectionArg [Comment ()]
forall ann. ann -> FieldName -> SectionArg ann
Fields.SecArgName ([Comment p] -> [Comment ()]
forall p. [Comment p] -> [Comment ()]
comments [Comment p]
cs) FieldName
x
  Fields.SecArgStr (p
_, [Comment p]
cs) FieldName
x -> [Comment ()] -> FieldName -> SectionArg [Comment ()]
forall ann. ann -> FieldName -> SectionArg ann
Fields.SecArgStr ([Comment p] -> [Comment ()]
forall p. [Comment p] -> [Comment ()]
comments [Comment p]
cs) FieldName
x
  Fields.SecArgOther (p
_, [Comment p]
cs) FieldName
x -> [Comment ()] -> FieldName -> SectionArg [Comment ()]
forall ann. ann -> FieldName -> SectionArg ann
Fields.SecArgOther ([Comment p] -> [Comment ()]
forall p. [Comment p] -> [Comment ()]
comments [Comment p]
cs) FieldName
x

-- | Removes the positions from some comments.
comments ::
  [Comment.Comment p] ->
  [Comment.Comment ()]
comments :: forall p. [Comment p] -> [Comment ()]
comments = (Comment p -> Comment ()) -> [Comment p] -> [Comment ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Comment p -> Comment ()
forall p. Comment p -> Comment ()
comment

-- | Removes the position from a comment.
comment ::
  Comment.Comment p ->
  Comment.Comment ()
comment :: forall p. Comment p -> Comment ()
comment Comment p
c = Comment p
c {Comment.annotation = ()}