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 :: forall (m :: * -> *) cs.
Applicative m =>
CabalSpecVersion
-> ([Field (Position, [Comment Position])], cs)
-> m ([Field (Position, [Comment Position])], cs)
run CabalSpecVersion
csv ([Field (Position, [Comment Position])]
fs, cs
cs) = ([Field (Position, [Comment Position])], cs)
-> m ([Field (Position, [Comment Position])], cs)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CabalSpecVersion
-> [Field (Position, [Comment Position])]
-> [Field (Position, [Comment Position])]
fields CabalSpecVersion
csv [Field (Position, [Comment Position])]
fs, cs
cs)

fields ::
  CabalSpecVersion.CabalSpecVersion ->
  [Fields.Field (Position.Position, [Comment.Comment Position.Position])] ->
  [Fields.Field (Position.Position, [Comment.Comment Position.Position])]
fields :: CabalSpecVersion
-> [Field (Position, [Comment Position])]
-> [Field (Position, [Comment Position])]
fields CabalSpecVersion
csv [Field (Position, [Comment Position])]
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 CabalSpecVersion
csv CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecVersion.CabalSpecV3_0
    then (Field (Position, [Comment Position])
 -> Field (Position, [Comment Position]))
-> [Field (Position, [Comment Position])]
-> [Field (Position, [Comment Position])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field (Position, [Comment Position])
-> Field (Position, [Comment Position])
field [Field (Position, [Comment Position])]
fs
    else [Field (Position, [Comment Position])]
fs

field ::
  Fields.Field (Position.Position, [Comment.Comment Position.Position]) ->
  Fields.Field (Position.Position, [Comment.Comment Position.Position])
field :: Field (Position, [Comment Position])
-> Field (Position, [Comment Position])
field Field (Position, [Comment Position])
f = case Field (Position, [Comment Position])
f of
  Fields.Field Name (Position, [Comment Position])
n [FieldLine (Position, [Comment Position])]
fls ->
    if FieldName -> Set FieldName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Name (Position, [Comment Position]) -> FieldName
forall a. Name a -> FieldName
Name.value Name (Position, [Comment Position])
n) Set FieldName
relevantFieldNames Bool -> Bool -> Bool
&& [FieldLine (Position, [Comment Position])] -> Int -> Ordering
forall a. [a] -> Int -> Ordering
List.compareLength [FieldLine (Position, [Comment Position])]
fls Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
      then Name (Position, [Comment Position])
-> [FieldLine (Position, [Comment Position])]
-> Field (Position, [Comment Position])
forall ann. Name ann -> [FieldLine ann] -> Field ann
Fields.Field Name (Position, [Comment Position])
n ([FieldLine (Position, [Comment Position])]
 -> Field (Position, [Comment Position]))
-> [FieldLine (Position, [Comment Position])]
-> Field (Position, [Comment Position])
forall a b. (a -> b) -> a -> b
$ Field (Position, [Comment Position])
-> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
fieldLines Field (Position, [Comment Position])
f [FieldLine (Position, [Comment Position])]
fls
      else Field (Position, [Comment Position])
f
  Fields.Section Name (Position, [Comment Position])
n [SectionArg (Position, [Comment Position])]
sas [Field (Position, [Comment Position])]
fs -> Name (Position, [Comment Position])
-> [SectionArg (Position, [Comment Position])]
-> [Field (Position, [Comment Position])]
-> Field (Position, [Comment Position])
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Fields.Section Name (Position, [Comment Position])
n [SectionArg (Position, [Comment Position])]
sas ([Field (Position, [Comment Position])]
 -> Field (Position, [Comment Position]))
-> [Field (Position, [Comment Position])]
-> Field (Position, [Comment Position])
forall a b. (a -> b) -> a -> b
$ (Field (Position, [Comment Position])
 -> Field (Position, [Comment Position]))
-> [Field (Position, [Comment Position])]
-> [Field (Position, [Comment Position])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field (Position, [Comment Position])
-> Field (Position, [Comment Position])
field [Field (Position, [Comment Position])]
fs

relevantFieldNames :: Set.Set Fields.FieldName
relevantFieldNames :: Set FieldName
relevantFieldNames =
  [FieldName] -> Set FieldName
forall a. Ord a => [a] -> Set a
Set.fromList ([FieldName] -> Set FieldName) -> [FieldName] -> Set FieldName
forall a b. (a -> b) -> a -> b
$
    (String -> FieldName) -> [String] -> [FieldName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      String -> FieldName
String.toUtf8
      [ String
"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 :: Field (Position, [Comment Position])
-> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
fieldLines Field (Position, [Comment Position])
f = [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
fixRows ([FieldLine (Position, [Comment Position])]
 -> [FieldLine (Position, [Comment Position])])
-> ([FieldLine (Position, [Comment Position])]
    -> [FieldLine (Position, [Comment Position])])
-> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field (Position, [Comment Position])
-> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
fixCols Field (Position, [Comment Position])
f

fixRows ::
  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])] ->
  [Fields.FieldLine (Position.Position, [Comment.Comment Position.Position])]
fixRows :: [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
fixRows [FieldLine (Position, [Comment Position])]
fls = case [FieldLine (Position, [Comment Position])]
fls of
  FieldLine (Position, [Comment Position])
x : FieldLine (Position, [Comment Position])
y : [FieldLine (Position, [Comment Position])]
zs ->
    FieldLine (Position, [Comment Position])
x
      FieldLine (Position, [Comment Position])
-> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
forall a. a -> [a] -> [a]
: (Int -> FieldLine (Position, [Comment Position]))
-> [Int] -> [FieldLine (Position, [Comment Position])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> FieldLine (Position, [Comment Position])
forall c. Int -> FieldLine (Position, [c])
rowToFieldLine [FieldLine (Position, [Comment Position]) -> Int
forall cs. FieldLine (Position, cs) -> Int
fieldLineToLastRow FieldLine (Position, [Comment Position])
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. FieldLine (Position, [Comment Position]) -> Int
fieldLineToFirstRow FieldLine (Position, [Comment Position])
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
forall a. Semigroup a => a -> a -> a
<> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
fixRows (FieldLine (Position, [Comment Position])
y FieldLine (Position, [Comment Position])
-> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
forall a. a -> [a] -> [a]
: [FieldLine (Position, [Comment Position])]
zs)
  [FieldLine (Position, [Comment Position])]
_ -> [FieldLine (Position, [Comment Position])]
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 :: Field (Position, [Comment Position])
-> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
fixCols Field (Position, [Comment Position])
f [FieldLine (Position, [Comment Position])]
fls = case [FieldLine (Position, [Comment Position])]
fls of
  [] -> [FieldLine (Position, [Comment Position])]
fls
  FieldLine (Position, [Comment Position])
x : [FieldLine (Position, [Comment Position])]
xs ->
    let col :: Int
col = (FieldLine (Position, [Comment Position]) -> Int -> Int)
-> Int -> [FieldLine (Position, [Comment Position])] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int)
-> (FieldLine (Position, [Comment Position]) -> Int)
-> FieldLine (Position, [Comment Position])
-> Int
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLine (Position, [Comment Position]) -> Int
forall cs. FieldLine (Position, cs) -> Int
fieldLineToCol) (FieldLine (Position, [Comment Position]) -> Int
forall cs. FieldLine (Position, cs) -> Int
fieldLineToCol FieldLine (Position, [Comment Position])
x) [FieldLine (Position, [Comment Position])]
xs
     in if Field (Position, [Comment Position]) -> Int
forall cs. Field (Position, cs) -> Int
fieldToRow Field (Position, [Comment Position])
f Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== FieldLine (Position, [Comment Position]) -> Int
fieldLineToFirstRow FieldLine (Position, [Comment Position])
x
          then FieldLine (Position, [Comment Position])
x FieldLine (Position, [Comment Position])
-> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
forall a. a -> [a] -> [a]
: (FieldLine (Position, [Comment Position])
 -> FieldLine (Position, [Comment Position]))
-> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
-> FieldLine (Position, [Comment Position])
-> FieldLine (Position, [Comment Position])
forall cs.
Int -> FieldLine (Position, cs) -> FieldLine (Position, cs)
reindent Int
col) [FieldLine (Position, [Comment Position])]
xs
          else (FieldLine (Position, [Comment Position])
 -> FieldLine (Position, [Comment Position]))
-> [FieldLine (Position, [Comment Position])]
-> [FieldLine (Position, [Comment Position])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
-> FieldLine (Position, [Comment Position])
-> FieldLine (Position, [Comment Position])
forall cs.
Int -> FieldLine (Position, cs) -> FieldLine (Position, cs)
reindent Int
col) [FieldLine (Position, [Comment Position])]
fls

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

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

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

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

reindent ::
  Int ->
  Fields.FieldLine (Position.Position, cs) ->
  Fields.FieldLine (Position.Position, cs)
reindent :: forall cs.
Int -> FieldLine (Position, cs) -> FieldLine (Position, cs)
reindent Int
col (Fields.FieldLine (Position
p, cs
cs) FieldName
b) =
  (Position, cs) -> FieldName -> FieldLine (Position, cs)
forall ann. ann -> FieldName -> FieldLine ann
Fields.FieldLine (Position
p, cs
cs) (FieldName -> FieldLine (Position, cs))
-> FieldName -> FieldLine (Position, cs)
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> FieldName
ByteString.replicate (Position -> Int
Position.positionCol Position
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
col) Word8
0x20 FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
b

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