module CabalGild.Unstable.Action.ReflowText where

import qualified CabalGild.Unstable.Extra.Field as Field
import qualified CabalGild.Unstable.Extra.FieldLine as FieldLine
import qualified CabalGild.Unstable.Extra.List as List
import qualified CabalGild.Unstable.Extra.Name as Name
import qualified CabalGild.Unstable.Extra.String as String
import qualified CabalGild.Unstable.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

-- | A wrapper around 'fields' to allow this to be composed with other actions.
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)

-- | Reflows the free text field values if the Cabal spec version is recent
-- enough (at least @3.0@).
--
-- Note that this requires comments to be already attached. That's because
-- comments should not be attached to blank lines, which this function will
-- insert.
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 =
  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

-- | Reflows the free text field value if applicable. Otherwise returns the
-- field as is. If the field is a section, the fields within the section will
-- be recursively reflowed.
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

-- | The names of the fields that should be reflowed.
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"
      ]

-- | Reflows the field lines for the given field. This is just a wrapper around
-- 'fixRows' and 'fixCols'.
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

-- | Inserts blank lines between field lines if necessary.
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

-- | Reindents field lines by finding the least indented line and adjusting the
-- other lines relative to that one. Note that if the first field line is on
-- the same line as the field itself, it will never be reindented.
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

-- | Extracts the column number from a field line.
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

-- | Extracts the /first/ row number from a field line, which might belong to
-- one of its comments.
fieldLineToFirstRow ::
  Fields.FieldLine (Position.Position, [Comment.Comment Position.Position]) ->
  Int
fieldLineToFirstRow :: FieldLine (Position, [Comment Position]) -> Int
fieldLineToFirstRow =
  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

-- | Extracts the /last/ row number from a field line, which will not belong to
-- any of its comments.
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

-- | Extracts the row number from a field.
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

-- | Reindents the field line using the given column number.
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

-- | Creates a blank field line at the given row number.
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