Reindent.hs

module CabalGild.Action.Reindent where

import qualified CabalGild.Extra.Field as Field
import qualified CabalGild.Extra.FieldLine as FieldLine
import qualified CabalGild.Extra.List as List
import qualified CabalGild.Extra.Name as Name
import qualified CabalGild.Extra.String as String
import qualified CabalGild.Type.Comment as Comment
import qualified Data.ByteString as ByteString
import qualified Data.Set as Set
import qualified Distribution.CabalSpecVersion as CabalSpecVersion
import qualified Distribution.Fields as Fields
import qualified Distribution.Parsec.Position as Position

run ::
  (Applicative m) =>
  CabalSpecVersion.CabalSpecVersion ->
  ([Fields.Field (Position.Position, [Comment.Comment Position.Position])], cs) ->
  m ([Fields.Field (Position.Position, [Comment.Comment Position.Position])], cs)
run csv (fs, cs) = pure (fields csv fs, cs)

fields ::
  CabalSpecVersion.CabalSpecVersion ->
  [Fields.Field (Position.Position, [Comment.Comment Position.Position])] ->
  [Fields.Field (Position.Position, [Comment.Comment Position.Position])]
fields csv fs =
  -- Note that we want to do this after comments have been attached because we
  -- want comments to come as late as possible. In other words, we don't want a
  -- comment attached to a blank line.
  if csv >= CabalSpecVersion.CabalSpecV3_0
    then fmap field fs
    else fs

field ::
  Fields.Field (Position.Position, [Comment.Comment Position.Position]) ->
  Fields.Field (Position.Position, [Comment.Comment Position.Position])
field f = case f of
  Fields.Field n fls ->
    if Set.member (Name.value n) relevantFieldNames && List.compareLength fls 1 == GT
      then Fields.Field n $ fieldLines f fls
      else f
  Fields.Section n sas fs -> Fields.Section n sas $ fmap field fs

relevantFieldNames :: Set.Set Fields.FieldName
relevantFieldNames =
  Set.fromList $
    fmap
      String.toUtf8
      [ "description"
      ]

fieldLines ::
  Fields.Field (Position.Position, [Comment.Comment Position.Position]) ->
  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] ->
  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])]
fieldLines f = fixRows . fixCols f

fixRows ::
  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] ->
  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])]
fixRows fls = case fls of
  x : y : zs ->
    x
      : fmap rowToFieldLine [fieldLineToLastRow x + 1 .. fieldLineToFirstRow y - 1]
        <> fixRows (y : zs)
  _ -> fls

fixCols ::
  Fields.Field (Position.Position, [Comment.Comment Position.Position]) ->
  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] ->
  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])]
fixCols f fls = case fls of
  [] -> fls
  x : xs ->
    let col = foldr (min . fieldLineToCol) (fieldLineToCol x) xs
     in if fieldToRow f == fieldLineToFirstRow x
          then x : fmap (reindent col) xs
          else fmap (reindent col) fls

fieldLineToCol :: Fields.FieldLine (Position.Position, cs) -> Int
fieldLineToCol = Position.positionCol . fst . FieldLine.annotation

fieldLineToFirstRow ::
  Fields.FieldLine (Position.Position, [Comment.Comment Position.Position]) ->
  Int
fieldLineToFirstRow =
  -- A field line's first row might belong to one of its comments.
  Position.positionRow
    . uncurry (foldr (min . Comment.annotation))
    . FieldLine.annotation

fieldLineToLastRow :: Fields.FieldLine (Position.Position, cs) -> Int
fieldLineToLastRow = Position.positionRow . fst . FieldLine.annotation

fieldToRow :: Fields.Field (Position.Position, cs) -> Int
fieldToRow = Position.positionRow . fst . Name.annotation . Field.name

reindent ::
  Int ->
  Fields.FieldLine (Position.Position, cs) ->
  Fields.FieldLine (Position.Position, cs)
reindent col (Fields.FieldLine (p, cs) b) =
  Fields.FieldLine (p, cs) $ ByteString.replicate (Position.positionCol p - col) 0x20 <> b

rowToFieldLine ::
  Int ->
  Fields.FieldLine (Position.Position, [c])
rowToFieldLine r = Fields.FieldLine (Position.Position r 1, []) ByteString.empty