{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}

-- | Tools to print, parse and fix cabal files, 'ByteString' and 'Field' lists.
module CabalFix
  ( -- * Usage
    -- $usage

    -- * Configuration
    Config (..),
    defaultConfig,
    AddPolicy (..),
    CommaStyle (..),
    CommaTrail (..),
    DepAlignment (..),
    ValueAlignment (..),
    Margin (..),

    -- * CabalFields
    Comment,
    CabalFields (..),
    cabalFields',
    fieldList',

    -- * Lenses
    -- $lenses
    topfield',
    field',
    subfield',
    section',
    secFields',
    fieldOrSection',
    overField,
    overFields,
    pname,
    fieldLines',
    fieldName',
    secArgs',
    secArgBS',
    fieldLine',
    fieldValues',

    -- * Parsing
    parseCabalFields,

    -- * Printing
    printCabalFields,

    -- * Fixes
    fixCabalFields,
    fixCabalFile,
    fixesCommas,
    addsFields,
    addField,
    fixBuildDeps,

    -- * Dependency
    Dep (..),

    -- * Examples
    minimalExampleBS,
    minimalConfig,
  )
where

import CabalFix.FlatParse (depP, runParserEither)
import Control.Category ((>>>))
import Control.Monad
import Data.Bifunctor
import Data.Bool
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as C
import Data.Foldable
import Data.Function
import Data.Functor.Identity
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.String.Interpolate
import Data.TreeDiff hiding (FieldName)
import Data.TreeDiff.OMap qualified as OMap
import Data.Vector qualified as V
import Distribution.Fields
import Distribution.Fields.Field
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Utils.Generic
import Distribution.Version
import GHC.Generics hiding (to)
import Optics.Extra
import Text.PrettyPrint qualified as PP
import Prelude

-- $setup
--
-- >>> :set -XOverloadedStrings
-- >>> :set -XOverloadedLabels
-- >>> import CabalFix
-- >>> import Optics.Extra
-- >>> import Data.ByteString.Char8 qualified as C
-- >>> import CabalFix.Patch
-- >>> bs = minimalExampleBS
-- >>> cfg = defaultConfig
-- >>> (Just cf) = preview (cabalFields' cfg) bs
-- >>> fs = cf & view (#fields % fieldList')
-- >>> printCabalFields cfg (cf & over (#fields % fieldList') (take 4)) & C.putStr
-- cabal-version: 3.0
-- name: minimal
-- version: 0.1.0.0
-- license: BSD-2-Clause

-- $usage
--
-- >>> :set -XOverloadedStrings
-- >>> :set -XOverloadedLabels
-- >>> import CabalFix
-- >>> import Optics.Extra
-- >>> import Data.ByteString.Char8 qualified as C
-- >>> import CabalFix.Patch
-- >>> bs = minimalExampleBS
-- >>> cfg = defaultConfig
-- >>> (Just cf) = preview (cabalFields' cfg) bs
-- >>> fs = cf & view (#fields % fieldList')
-- >>> printCabalFields cfg (cf & over (#fields % fieldList') (take 4)) & C.putStr
-- cabal-version: 3.0
-- name: minimal
-- version: 0.1.0.0
-- license: BSD-2-Clause

-- | Configuration values for various aspects of (re)rendering a cabal file.
data Config = Config
  { -- | fields that should be converted to free text
    Config -> [ByteString]
freeTexts :: [ByteString],
    -- | fields that should be removed
    Config -> [ByteString]
fieldRemovals :: [ByteString],
    -- | Preferred dependency ranges
    Config -> [(ByteString, ByteString)]
preferredDeps :: [(ByteString, ByteString)],
    -- | Add fields (Overwriting depends on an 'AddPolicy')
    Config -> [(ByteString, ByteString, AddPolicy)]
addFields :: [(ByteString, ByteString, AddPolicy)],
    -- | Fields where CommaStyle should be checked and fixed.
    Config -> [(ByteString, CommaStyle, CommaTrail)]
fixCommas :: [(ByteString, CommaStyle, CommaTrail)],
    -- | Fields where elements should be sorted alphabetically
    Config -> [ByteString]
sortFieldLines :: [ByteString],
    -- | Whether to sort Fields.
    Config -> Bool
doSortFields :: Bool,
    -- | The preferred ordering of Fields if they are sorted (lower numbers are placed first).
    Config -> [(ByteString, Double)]
fieldOrdering :: [(ByteString, Double)],
    -- | Whether to fix the build dependency Field
    Config -> Bool
doFixBuildDeps :: Bool,
    -- | How to align build dependencies
    Config -> DepAlignment
depAlignment :: DepAlignment,
    -- | Whether to remove Fields with no information
    Config -> Bool
removeBlankFields :: Bool,
    -- | Whether to column-align values
    Config -> ValueAlignment
valueAligned :: ValueAlignment,
    -- | The number of spaces between the field nameand the value, if aligned.
    Config -> Int
valueAlignGap :: Int,
    -- | Margin between sections
    Config -> Margin
sectionMargin :: Margin,
    -- | Margin around comments
    Config -> Margin
commentMargin :: Margin,
    -- | Shift from narrow style to multi-line beyond this column size.
    Config -> Int
narrowN :: Int,
    -- | Indentation value
    Config -> Int
indentN :: Int
  }
  deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
/= :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show, ReadPrec [Config]
ReadPrec Config
Int -> ReadS Config
ReadS [Config]
(Int -> ReadS Config)
-> ReadS [Config]
-> ReadPrec Config
-> ReadPrec [Config]
-> Read Config
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Config
readsPrec :: Int -> ReadS Config
$creadList :: ReadS [Config]
readList :: ReadS [Config]
$creadPrec :: ReadPrec Config
readPrec :: ReadPrec Config
$creadListPrec :: ReadPrec [Config]
readListPrec :: ReadPrec [Config]
Read, (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Config -> Rep Config x
from :: forall x. Config -> Rep Config x
$cto :: forall x. Rep Config x -> Config
to :: forall x. Rep Config x -> Config
Generic)

-- | An opinionated configuration for formatting cabal files.
--
-- Some opinions (that can be configured):
--
-- >>> fixCommas defaultConfig
-- [("extra-doc-files",NoCommas,NoTrailer),("build-depends",PrefixCommas,Trailer)]
--
-- 'PrefixCommas' are better for the dependency list as dependency ranges are already noisy enough without a comma thrown in. 'Trailer' (which means leading comma for prefixed commas) is neater and easier to prepend to, append to & sort.
--
-- If a field list doesn't need commas, then they should be removed.
--
-- >>> preferredDeps defaultConfig
-- [("base",">=4.14 && <5")]
--
-- Standard practice compared with the much tighter eg @base ^>=4.17.2.1@
--
-- >>> sortFieldLines defaultConfig
-- ["build-depends","exposed-modules","default-extensions","ghc-options","extra-doc-files","tested-with"]
--
-- Sort all the things, but especially the module list.
--
-- >>> valueAligned defaultConfig
-- ValueUnaligned
--
-- Adding an extra, long-named field to the cabal file means we have to re-align all the value parts in all the other fields.
--
-- >>> depAlignment defaultConfig
-- DepAligned
--
-- build-depends is so busy, however, the extra alignment becomes more important.
--
-- >>> doSortFields defaultConfig
-- True
--
-- Whatever the order, fields should have the same order within each section.
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
  [ByteString]
-> [ByteString]
-> [(ByteString, ByteString)]
-> [(ByteString, ByteString, AddPolicy)]
-> [(ByteString, CommaStyle, CommaTrail)]
-> [ByteString]
-> Bool
-> [(ByteString, Double)]
-> Bool
-> DepAlignment
-> Bool
-> ValueAlignment
-> Int
-> Margin
-> Margin
-> Int
-> Int
-> Config
Config
    [ByteString
"description"]
    []
    [(ByteString, ByteString)]
defaultPreferredDeps
    []
    [(ByteString, CommaStyle, CommaTrail)]
defaultFixCommas
    [ByteString]
defaultFieldLineSorts
    Bool
True
    [(ByteString, Double)]
defaultFieldOrdering
    Bool
True
    DepAlignment
DepAligned
    Bool
True
    ValueAlignment
ValueUnaligned
    Int
1
    Margin
Margin
    Margin
NoMargin
    Int
60
    Int
4

-- | The style for comma-separated values
data CommaStyle
  = -- | commas before values
    PrefixCommas
  | -- | commas after values
    PostfixCommas
  | -- | comma freedom
    FreeformCommas
  | -- | remove commas (allowed for some fields)
    NoCommas
  deriving (CommaStyle -> CommaStyle -> Bool
(CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> Bool) -> Eq CommaStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommaStyle -> CommaStyle -> Bool
== :: CommaStyle -> CommaStyle -> Bool
$c/= :: CommaStyle -> CommaStyle -> Bool
/= :: CommaStyle -> CommaStyle -> Bool
Eq, Int -> CommaStyle -> ShowS
[CommaStyle] -> ShowS
CommaStyle -> String
(Int -> CommaStyle -> ShowS)
-> (CommaStyle -> String)
-> ([CommaStyle] -> ShowS)
-> Show CommaStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommaStyle -> ShowS
showsPrec :: Int -> CommaStyle -> ShowS
$cshow :: CommaStyle -> String
show :: CommaStyle -> String
$cshowList :: [CommaStyle] -> ShowS
showList :: [CommaStyle] -> ShowS
Show, ReadPrec [CommaStyle]
ReadPrec CommaStyle
Int -> ReadS CommaStyle
ReadS [CommaStyle]
(Int -> ReadS CommaStyle)
-> ReadS [CommaStyle]
-> ReadPrec CommaStyle
-> ReadPrec [CommaStyle]
-> Read CommaStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CommaStyle
readsPrec :: Int -> ReadS CommaStyle
$creadList :: ReadS [CommaStyle]
readList :: ReadS [CommaStyle]
$creadPrec :: ReadPrec CommaStyle
readPrec :: ReadPrec CommaStyle
$creadListPrec :: ReadPrec [CommaStyle]
readListPrec :: ReadPrec [CommaStyle]
Read, (forall x. CommaStyle -> Rep CommaStyle x)
-> (forall x. Rep CommaStyle x -> CommaStyle) -> Generic CommaStyle
forall x. Rep CommaStyle x -> CommaStyle
forall x. CommaStyle -> Rep CommaStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommaStyle -> Rep CommaStyle x
from :: forall x. CommaStyle -> Rep CommaStyle x
$cto :: forall x. Rep CommaStyle x -> CommaStyle
to :: forall x. Rep CommaStyle x -> CommaStyle
Generic)

-- | Include a trailing (or leading) comma, after the last value (or before the first value.)
data CommaTrail
  = Trailer
  | NoTrailer
  deriving (CommaTrail -> CommaTrail -> Bool
(CommaTrail -> CommaTrail -> Bool)
-> (CommaTrail -> CommaTrail -> Bool) -> Eq CommaTrail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommaTrail -> CommaTrail -> Bool
== :: CommaTrail -> CommaTrail -> Bool
$c/= :: CommaTrail -> CommaTrail -> Bool
/= :: CommaTrail -> CommaTrail -> Bool
Eq, Int -> CommaTrail -> ShowS
[CommaTrail] -> ShowS
CommaTrail -> String
(Int -> CommaTrail -> ShowS)
-> (CommaTrail -> String)
-> ([CommaTrail] -> ShowS)
-> Show CommaTrail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommaTrail -> ShowS
showsPrec :: Int -> CommaTrail -> ShowS
$cshow :: CommaTrail -> String
show :: CommaTrail -> String
$cshowList :: [CommaTrail] -> ShowS
showList :: [CommaTrail] -> ShowS
Show, ReadPrec [CommaTrail]
ReadPrec CommaTrail
Int -> ReadS CommaTrail
ReadS [CommaTrail]
(Int -> ReadS CommaTrail)
-> ReadS [CommaTrail]
-> ReadPrec CommaTrail
-> ReadPrec [CommaTrail]
-> Read CommaTrail
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CommaTrail
readsPrec :: Int -> ReadS CommaTrail
$creadList :: ReadS [CommaTrail]
readList :: ReadS [CommaTrail]
$creadPrec :: ReadPrec CommaTrail
readPrec :: ReadPrec CommaTrail
$creadListPrec :: ReadPrec [CommaTrail]
readListPrec :: ReadPrec [CommaTrail]
Read, (forall x. CommaTrail -> Rep CommaTrail x)
-> (forall x. Rep CommaTrail x -> CommaTrail) -> Generic CommaTrail
forall x. Rep CommaTrail x -> CommaTrail
forall x. CommaTrail -> Rep CommaTrail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommaTrail -> Rep CommaTrail x
from :: forall x. CommaTrail -> Rep CommaTrail x
$cto :: forall x. Rep CommaTrail x -> CommaTrail
to :: forall x. Rep CommaTrail x -> CommaTrail
Generic)

-- | Policy for Fields listed in 'addFields'
data AddPolicy
  = -- | Replace existing values
    AddReplace
  | -- | Append after existing values
    AddAppend
  | -- | Add only of the Field doesn't exist
    AddIfNotExisting
  deriving (AddPolicy -> AddPolicy -> Bool
(AddPolicy -> AddPolicy -> Bool)
-> (AddPolicy -> AddPolicy -> Bool) -> Eq AddPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddPolicy -> AddPolicy -> Bool
== :: AddPolicy -> AddPolicy -> Bool
$c/= :: AddPolicy -> AddPolicy -> Bool
/= :: AddPolicy -> AddPolicy -> Bool
Eq, Int -> AddPolicy -> ShowS
[AddPolicy] -> ShowS
AddPolicy -> String
(Int -> AddPolicy -> ShowS)
-> (AddPolicy -> String)
-> ([AddPolicy] -> ShowS)
-> Show AddPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddPolicy -> ShowS
showsPrec :: Int -> AddPolicy -> ShowS
$cshow :: AddPolicy -> String
show :: AddPolicy -> String
$cshowList :: [AddPolicy] -> ShowS
showList :: [AddPolicy] -> ShowS
Show, ReadPrec [AddPolicy]
ReadPrec AddPolicy
Int -> ReadS AddPolicy
ReadS [AddPolicy]
(Int -> ReadS AddPolicy)
-> ReadS [AddPolicy]
-> ReadPrec AddPolicy
-> ReadPrec [AddPolicy]
-> Read AddPolicy
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AddPolicy
readsPrec :: Int -> ReadS AddPolicy
$creadList :: ReadS [AddPolicy]
readList :: ReadS [AddPolicy]
$creadPrec :: ReadPrec AddPolicy
readPrec :: ReadPrec AddPolicy
$creadListPrec :: ReadPrec [AddPolicy]
readListPrec :: ReadPrec [AddPolicy]
Read, (forall x. AddPolicy -> Rep AddPolicy x)
-> (forall x. Rep AddPolicy x -> AddPolicy) -> Generic AddPolicy
forall x. Rep AddPolicy x -> AddPolicy
forall x. AddPolicy -> Rep AddPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddPolicy -> Rep AddPolicy x
from :: forall x. AddPolicy -> Rep AddPolicy x
$cto :: forall x. Rep AddPolicy x -> AddPolicy
to :: forall x. Rep AddPolicy x -> AddPolicy
Generic)

defaultFixCommas :: [(ByteString, CommaStyle, CommaTrail)]
defaultFixCommas :: [(ByteString, CommaStyle, CommaTrail)]
defaultFixCommas =
  [ (ByteString
"extra-doc-files", CommaStyle
NoCommas, CommaTrail
NoTrailer),
    (ByteString
"build-depends", CommaStyle
PrefixCommas, CommaTrail
Trailer)
  ]

-- | An opionated ordering of fields.
defaultFieldOrdering :: [(ByteString, Double)]
defaultFieldOrdering :: [(ByteString, Double)]
defaultFieldOrdering = [(ByteString
"cabal-version", Double
0), (ByteString
"import", Double
1), (ByteString
"main-is", Double
2), (ByteString
"default-language", Double
3), (ByteString
"name", Double
4), (ByteString
"hs-source-dirs", Double
5), (ByteString
"version", Double
6), (ByteString
"build-depends", Double
7), (ByteString
"exposed-modules", Double
8), (ByteString
"license", Double
9), (ByteString
"license-file", Double
10), (ByteString
"other-modules", Double
11), (ByteString
"copyright", Double
12), (ByteString
"category", Double
13), (ByteString
"author", Double
14), (ByteString
"default-extensions", Double
15), (ByteString
"ghc-options", Double
16), (ByteString
"maintainer", Double
17), (ByteString
"homepage", Double
18), (ByteString
"bug-reports", Double
19), (ByteString
"synopsis", Double
20), (ByteString
"description", Double
21), (ByteString
"build-type", Double
22), (ByteString
"tested-with", Double
23), (ByteString
"extra-doc-files", Double
24), (ByteString
"source-repository", Double
25), (ByteString
"type", Double
26), (ByteString
"common", Double
27), (ByteString
"location", Double
28), (ByteString
"library", Double
29), (ByteString
"executable", Double
30), (ByteString
"test-suite", Double
31)]

-- An opinionated list of fields whose elements should be sorted.
defaultFieldLineSorts :: [ByteString]
defaultFieldLineSorts :: [ByteString]
defaultFieldLineSorts =
  [ ByteString
"build-depends",
    ByteString
"exposed-modules",
    ByteString
"default-extensions",
    ByteString
"ghc-options",
    ByteString
"extra-doc-files",
    ByteString
"tested-with"
  ]

-- An opinionated list of preferred builddeps:
--
defaultPreferredDeps :: [(ByteString, ByteString)]
defaultPreferredDeps :: [(ByteString, ByteString)]
defaultPreferredDeps = [(ByteString
"base", ByteString
">=4.14 && <5")]

-- | Whether the value part of each field should be vertically aligned on a column.
data ValueAlignment = ValueAligned | ValueUnaligned deriving (ValueAlignment -> ValueAlignment -> Bool
(ValueAlignment -> ValueAlignment -> Bool)
-> (ValueAlignment -> ValueAlignment -> Bool) -> Eq ValueAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValueAlignment -> ValueAlignment -> Bool
== :: ValueAlignment -> ValueAlignment -> Bool
$c/= :: ValueAlignment -> ValueAlignment -> Bool
/= :: ValueAlignment -> ValueAlignment -> Bool
Eq, Int -> ValueAlignment -> ShowS
[ValueAlignment] -> ShowS
ValueAlignment -> String
(Int -> ValueAlignment -> ShowS)
-> (ValueAlignment -> String)
-> ([ValueAlignment] -> ShowS)
-> Show ValueAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueAlignment -> ShowS
showsPrec :: Int -> ValueAlignment -> ShowS
$cshow :: ValueAlignment -> String
show :: ValueAlignment -> String
$cshowList :: [ValueAlignment] -> ShowS
showList :: [ValueAlignment] -> ShowS
Show, ReadPrec [ValueAlignment]
ReadPrec ValueAlignment
Int -> ReadS ValueAlignment
ReadS [ValueAlignment]
(Int -> ReadS ValueAlignment)
-> ReadS [ValueAlignment]
-> ReadPrec ValueAlignment
-> ReadPrec [ValueAlignment]
-> Read ValueAlignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ValueAlignment
readsPrec :: Int -> ReadS ValueAlignment
$creadList :: ReadS [ValueAlignment]
readList :: ReadS [ValueAlignment]
$creadPrec :: ReadPrec ValueAlignment
readPrec :: ReadPrec ValueAlignment
$creadListPrec :: ReadPrec [ValueAlignment]
readListPrec :: ReadPrec [ValueAlignment]
Read, (forall x. ValueAlignment -> Rep ValueAlignment x)
-> (forall x. Rep ValueAlignment x -> ValueAlignment)
-> Generic ValueAlignment
forall x. Rep ValueAlignment x -> ValueAlignment
forall x. ValueAlignment -> Rep ValueAlignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ValueAlignment -> Rep ValueAlignment x
from :: forall x. ValueAlignment -> Rep ValueAlignment x
$cto :: forall x. Rep ValueAlignment x -> ValueAlignment
to :: forall x. Rep ValueAlignment x -> ValueAlignment
Generic)

-- | Whether the range part of the dependency list should be vertically aligned on a column.
data DepAlignment = DepAligned | DepUnaligned deriving (DepAlignment -> DepAlignment -> Bool
(DepAlignment -> DepAlignment -> Bool)
-> (DepAlignment -> DepAlignment -> Bool) -> Eq DepAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepAlignment -> DepAlignment -> Bool
== :: DepAlignment -> DepAlignment -> Bool
$c/= :: DepAlignment -> DepAlignment -> Bool
/= :: DepAlignment -> DepAlignment -> Bool
Eq, Int -> DepAlignment -> ShowS
[DepAlignment] -> ShowS
DepAlignment -> String
(Int -> DepAlignment -> ShowS)
-> (DepAlignment -> String)
-> ([DepAlignment] -> ShowS)
-> Show DepAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepAlignment -> ShowS
showsPrec :: Int -> DepAlignment -> ShowS
$cshow :: DepAlignment -> String
show :: DepAlignment -> String
$cshowList :: [DepAlignment] -> ShowS
showList :: [DepAlignment] -> ShowS
Show, ReadPrec [DepAlignment]
ReadPrec DepAlignment
Int -> ReadS DepAlignment
ReadS [DepAlignment]
(Int -> ReadS DepAlignment)
-> ReadS [DepAlignment]
-> ReadPrec DepAlignment
-> ReadPrec [DepAlignment]
-> Read DepAlignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DepAlignment
readsPrec :: Int -> ReadS DepAlignment
$creadList :: ReadS [DepAlignment]
readList :: ReadS [DepAlignment]
$creadPrec :: ReadPrec DepAlignment
readPrec :: ReadPrec DepAlignment
$creadListPrec :: ReadPrec [DepAlignment]
readListPrec :: ReadPrec [DepAlignment]
Read)

-- | A margin tracker for combining sections.
data Margin = Margin | NoMargin
  deriving (Margin -> Margin -> Bool
(Margin -> Margin -> Bool)
-> (Margin -> Margin -> Bool) -> Eq Margin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Margin -> Margin -> Bool
== :: Margin -> Margin -> Bool
$c/= :: Margin -> Margin -> Bool
/= :: Margin -> Margin -> Bool
Eq, Int -> Margin -> ShowS
[Margin] -> ShowS
Margin -> String
(Int -> Margin -> ShowS)
-> (Margin -> String) -> ([Margin] -> ShowS) -> Show Margin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Margin -> ShowS
showsPrec :: Int -> Margin -> ShowS
$cshow :: Margin -> String
show :: Margin -> String
$cshowList :: [Margin] -> ShowS
showList :: [Margin] -> ShowS
Show, ReadPrec [Margin]
ReadPrec Margin
Int -> ReadS Margin
ReadS [Margin]
(Int -> ReadS Margin)
-> ReadS [Margin]
-> ReadPrec Margin
-> ReadPrec [Margin]
-> Read Margin
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Margin
readsPrec :: Int -> ReadS Margin
$creadList :: ReadS [Margin]
readList :: ReadS [Margin]
$creadPrec :: ReadPrec Margin
readPrec :: ReadPrec Margin
$creadListPrec :: ReadPrec [Margin]
readListPrec :: ReadPrec [Margin]
Read, (forall x. Margin -> Rep Margin x)
-> (forall x. Rep Margin x -> Margin) -> Generic Margin
forall x. Rep Margin x -> Margin
forall x. Margin -> Rep Margin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Margin -> Rep Margin x
from :: forall x. Margin -> Rep Margin x
$cto :: forall x. Rep Margin x -> Margin
to :: forall x. Rep Margin x -> Margin
Generic)

-- | Collapse margins, any margin = margin
instance Semigroup Margin where
  Margin
NoMargin <> :: Margin -> Margin -> Margin
<> Margin
NoMargin = Margin
NoMargin
  Margin
_ <> Margin
_ = Margin
Margin

-- | Note that cabal does not have multi-line comments
type Comment = [ByteString]

-- | 'Field' list annotated with a 'Comment'
--
-- Note that this type does not contain any position information.
--
-- The construction assumes that comments relate to fields below, so there is potential for an end comment unrelated to any particular field.
data CabalFields = CabalFields {CabalFields -> Vector (Field [ByteString])
fields :: V.Vector (Field Comment), CabalFields -> [ByteString]
endComment :: Comment} deriving ((forall x. CabalFields -> Rep CabalFields x)
-> (forall x. Rep CabalFields x -> CabalFields)
-> Generic CabalFields
forall x. Rep CabalFields x -> CabalFields
forall x. CabalFields -> Rep CabalFields x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CabalFields -> Rep CabalFields x
from :: forall x. CabalFields -> Rep CabalFields x
$cto :: forall x. Rep CabalFields x -> CabalFields
to :: forall x. Rep CabalFields x -> CabalFields
Generic, CabalFields -> CabalFields -> Bool
(CabalFields -> CabalFields -> Bool)
-> (CabalFields -> CabalFields -> Bool) -> Eq CabalFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CabalFields -> CabalFields -> Bool
== :: CabalFields -> CabalFields -> Bool
$c/= :: CabalFields -> CabalFields -> Bool
/= :: CabalFields -> CabalFields -> Bool
Eq, Int -> CabalFields -> ShowS
[CabalFields] -> ShowS
CabalFields -> String
(Int -> CabalFields -> ShowS)
-> (CabalFields -> String)
-> ([CabalFields] -> ShowS)
-> Show CabalFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CabalFields -> ShowS
showsPrec :: Int -> CabalFields -> ShowS
$cshow :: CabalFields -> String
show :: CabalFields -> String
$cshowList :: [CabalFields] -> ShowS
showList :: [CabalFields] -> ShowS
Show)

instance Semigroup CabalFields where
  (CabalFields Vector (Field [ByteString])
fs [ByteString]
ec) <> :: CabalFields -> CabalFields -> CabalFields
<> (CabalFields Vector (Field [ByteString])
fs' [ByteString]
ec') = Vector (Field [ByteString]) -> [ByteString] -> CabalFields
CabalFields (Vector (Field [ByteString])
fs Vector (Field [ByteString])
-> Vector (Field [ByteString]) -> Vector (Field [ByteString])
forall a. Semigroup a => a -> a -> a
<> Vector (Field [ByteString])
fs') ([ByteString]
ec [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
ec')

instance Monoid CabalFields where
  mempty :: CabalFields
mempty = Vector (Field [ByteString]) -> [ByteString] -> CabalFields
CabalFields Vector (Field [ByteString])
forall a. Vector a
V.empty []

-- | iso to flip between vectors and lists easily.
--
-- >>> cf & view (#fields % fieldList') & take 2
-- [Field (Name [] "cabal-version") [FieldLine [] "3.0"],Field (Name [] "name") [FieldLine [] "minimal"]]
fieldList' :: Iso' (V.Vector (Field Comment)) [Field Comment]
fieldList' :: Iso' (Vector (Field [ByteString])) [Field [ByteString]]
fieldList' = (Vector (Field [ByteString]) -> [Field [ByteString]])
-> ([Field [ByteString]] -> Vector (Field [ByteString]))
-> Iso' (Vector (Field [ByteString])) [Field [ByteString]]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Vector (Field [ByteString]) -> [Field [ByteString]]
forall a. Vector a -> [a]
V.toList [Field [ByteString]] -> Vector (Field [ByteString])
forall a. [a] -> Vector a
V.fromList

instance ToExpr (FieldLine Comment) where
  toExpr :: FieldLine [ByteString] -> Expr
toExpr FieldLine [ByteString]
fl = String -> OMap String Expr -> Expr
Rec String
"FieldLine" ([(String, Expr)] -> OMap String Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList [(String
"comment", [ByteString] -> Expr
forall a. ToExpr a => a -> Expr
toExpr (FieldLine [ByteString] -> [ByteString]
forall ann. FieldLine ann -> ann
fieldLineAnn FieldLine [ByteString]
fl)), (String
"fieldline", ByteString -> Expr
forall a. ToExpr a => a -> Expr
toExpr (FieldLine [ByteString] -> ByteString
forall ann. FieldLine ann -> ByteString
fieldLineBS FieldLine [ByteString]
fl))])

instance ToExpr (Name Comment) where
  toExpr :: Name [ByteString] -> Expr
toExpr Name [ByteString]
n = String -> OMap String Expr -> Expr
Rec String
"Name" ([(String, Expr)] -> OMap String Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList [(String
"comment", [ByteString] -> Expr
forall a. ToExpr a => a -> Expr
toExpr (Name [ByteString] -> [ByteString]
forall ann. Name ann -> ann
nameAnn Name [ByteString]
n)), (String
"name", ByteString -> Expr
forall a. ToExpr a => a -> Expr
toExpr (Name [ByteString] -> ByteString
forall ann. Name ann -> ByteString
getName Name [ByteString]
n))])

instance ToExpr (SectionArg Comment) where
  toExpr :: SectionArg [ByteString] -> Expr
toExpr (SecArgName [ByteString]
c ByteString
bs) = String -> OMap String Expr -> Expr
Rec String
"SecArgName" ([(String, Expr)] -> OMap String Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList [(String
"comment", [ByteString] -> Expr
forall a. ToExpr a => a -> Expr
toExpr [ByteString]
c), (String
"arg", ByteString -> Expr
forall a. ToExpr a => a -> Expr
toExpr ByteString
bs)])
  toExpr (SecArgStr [ByteString]
c ByteString
bs) = String -> OMap String Expr -> Expr
Rec String
"SecArgStr" ([(String, Expr)] -> OMap String Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList [(String
"comment", [ByteString] -> Expr
forall a. ToExpr a => a -> Expr
toExpr [ByteString]
c), (String
"arg", ByteString -> Expr
forall a. ToExpr a => a -> Expr
toExpr ByteString
bs)])
  toExpr (SecArgOther [ByteString]
c ByteString
bs) = String -> OMap String Expr -> Expr
Rec String
"SecArgOther" ([(String, Expr)] -> OMap String Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList [(String
"comment", [ByteString] -> Expr
forall a. ToExpr a => a -> Expr
toExpr [ByteString]
c), (String
"arg", ByteString -> Expr
forall a. ToExpr a => a -> Expr
toExpr ByteString
bs)])

instance ToExpr (Field Comment) where
  toExpr :: Field [ByteString] -> Expr
toExpr (Field Name [ByteString]
n [FieldLine [ByteString]]
fls) = String -> OMap String Expr -> Expr
Rec String
"Field" ([(String, Expr)] -> OMap String Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList [(String
"name", Name [ByteString] -> Expr
forall a. ToExpr a => a -> Expr
toExpr Name [ByteString]
n), (String
"field lines", [FieldLine [ByteString]] -> Expr
forall a. ToExpr a => a -> Expr
toExpr [FieldLine [ByteString]]
fls)])
  toExpr (Section Name [ByteString]
n [SectionArg [ByteString]]
ss [Field [ByteString]]
fs) = String -> OMap String Expr -> Expr
Rec String
"Section" ([(String, Expr)] -> OMap String Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList [(String
"name", Name [ByteString] -> Expr
forall a. ToExpr a => a -> Expr
toExpr Name [ByteString]
n), (String
"section args", [SectionArg [ByteString]] -> Expr
forall a. ToExpr a => a -> Expr
toExpr [SectionArg [ByteString]]
ss), (String
"fields", [Field [ByteString]] -> Expr
forall a. ToExpr a => a -> Expr
toExpr [Field [ByteString]]
fs)])

instance ToExpr CabalFields where
  toExpr :: CabalFields -> Expr
toExpr CabalFields
cf = String -> OMap String Expr -> Expr
Rec String
"CabalFields" ([(String, Expr)] -> OMap String Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList [(String
"fields", Vector (Field [ByteString]) -> Expr
forall a. ToExpr a => a -> Expr
toExpr (Vector (Field [ByteString]) -> Expr)
-> Vector (Field [ByteString]) -> Expr
forall a b. (a -> b) -> a -> b
$ CabalFields -> Vector (Field [ByteString])
fields CabalFields
cf), (String
"extras", [ByteString] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([ByteString] -> Expr) -> [ByteString] -> Expr
forall a b. (a -> b) -> a -> b
$ CabalFields -> [ByteString]
endComment CabalFields
cf)])

-- | A Prism betwixt a 'ByteString' and a 'CabalFields'.
--
-- >>> cf & over (#fields % fieldList') (take 2) & review (cabalFields' cfg) & C.putStr
-- cabal-version: 3.0
-- name: minimal
cabalFields' :: Config -> Prism' ByteString CabalFields
cabalFields' :: Config -> Prism' ByteString CabalFields
cabalFields' Config
cfg = (CabalFields -> ByteString)
-> (ByteString -> Either ByteString CabalFields)
-> Prism' ByteString CabalFields
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Config -> CabalFields -> ByteString
printCabalFields Config
cfg) (Config -> ByteString -> Either ByteString CabalFields
parseCabalFields Config
cfg)

-- $lenses
--
-- Lensing into 'Field' is tricky.
--
-- A 'Field' is a sum type of a field constructor or a section constructor, and a section contains fields.
--
-- Sometimes you only want to modify a field (and not a section). Other times you want to access a section but not a field. Sometimes you want to modify either a field or a section, and the fields within sections. It can be difficult to remember which lens is which.
--
-- The use of a list is also problematic; it is hard to safely delete a field, and invalid cabals are easily represented. A list can easily contain two name fields say, which is an invalid state. It can contain no name which is also invalid. It is difficult, however, to switch to a map because sections contain lists of fields (and not maps of fields).
--
-- Most useful are lenses that lens into named fields.

-- | A lens that doesn't descend into sections. It will lens the first-encountered named field, if any.
--
-- >>> view (topfield' "name") cf
-- Just (Field (Name [] "name") [FieldLine [] "minimal"])
--
-- >>> view (topfield' "build-depends") cf
-- Nothing
topfield' :: FieldName -> Lens' CabalFields (Maybe (Field Comment))
topfield' :: ByteString -> Lens' CabalFields (Maybe (Field [ByteString]))
topfield' ByteString
name = (CabalFields -> Maybe (Field [ByteString]))
-> (CabalFields -> Maybe (Field [ByteString]) -> CabalFields)
-> Lens' CabalFields (Maybe (Field [ByteString]))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Optic' A_Getter '[] CabalFields [Field [ByteString]]
-> CabalFields -> [Field [ByteString]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
#fields Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
-> Iso' (Vector (Field [ByteString])) [Field [ByteString]]
-> Optic
     A_Lens
     '[]
     CabalFields
     CabalFields
     [Field [ByteString]]
     [Field [ByteString]]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Iso' (Vector (Field [ByteString])) [Field [ByteString]]
fieldList' Optic
  A_Lens
  '[]
  CabalFields
  CabalFields
  [Field [ByteString]]
  [Field [ByteString]]
-> Optic
     A_Getter
     '[]
     [Field [ByteString]]
     [Field [ByteString]]
     [Field [ByteString]]
     [Field [ByteString]]
-> Optic' A_Getter '[] CabalFields [Field [ByteString]]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% ByteString
-> Optic
     A_Getter
     '[]
     [Field [ByteString]]
     [Field [ByteString]]
     [Field [ByteString]]
     [Field [ByteString]]
field' ByteString
name) (CabalFields -> [Field [ByteString]])
-> ([Field [ByteString]] -> Maybe (Field [ByteString]))
-> CabalFields
-> Maybe (Field [ByteString])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Field [ByteString]] -> Maybe (Field [ByteString])
forall a. [a] -> Maybe a
listToMaybe) (ByteString
-> CabalFields -> Maybe (Field [ByteString]) -> CabalFields
fieldSet ByteString
name)

fieldSet :: FieldName -> CabalFields -> Maybe (Field Comment) -> CabalFields
fieldSet :: ByteString
-> CabalFields -> Maybe (Field [ByteString]) -> CabalFields
fieldSet ByteString
name CabalFields
cf Maybe (Field [ByteString])
f =
  case (Field [ByteString] -> Bool)
-> Vector (Field [ByteString]) -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
V.findIndex ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
name) (ByteString -> Bool)
-> (Field [ByteString] -> ByteString) -> Field [ByteString] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name [ByteString] -> ByteString
forall ann. Name ann -> ByteString
getName (Name [ByteString] -> ByteString)
-> (Field [ByteString] -> Name [ByteString])
-> Field [ByteString]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field [ByteString] -> Name [ByteString]
forall ann. Field ann -> Name ann
fieldName) (Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
-> CabalFields -> Vector (Field [ByteString])
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
#fields CabalFields
cf) of
    Just Int
i -> case Maybe (Field [ByteString])
f of
      Maybe (Field [ByteString])
Nothing -> CabalFields
cf CabalFields -> (CabalFields -> CabalFields) -> CabalFields
forall a b. a -> (a -> b) -> b
& Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
-> (Vector (Field [ByteString]) -> Vector (Field [ByteString]))
-> CabalFields
-> CabalFields
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
#fields (\Vector (Field [ByteString])
v -> Int -> Vector (Field [ByteString]) -> Vector (Field [ByteString])
forall a. Int -> Vector a -> Vector a
V.take Int
i Vector (Field [ByteString])
v Vector (Field [ByteString])
-> Vector (Field [ByteString]) -> Vector (Field [ByteString])
forall a. Semigroup a => a -> a -> a
<> Int -> Vector (Field [ByteString]) -> Vector (Field [ByteString])
forall a. Int -> Vector a -> Vector a
V.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Vector (Field [ByteString])
v)
      Just Field [ByteString]
f' -> CabalFields
cf CabalFields -> (CabalFields -> CabalFields) -> CabalFields
forall a b. a -> (a -> b) -> b
& Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
-> (Vector (Field [ByteString]) -> Vector (Field [ByteString]))
-> CabalFields
-> CabalFields
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
#fields (\Vector (Field [ByteString])
v -> Int -> Vector (Field [ByteString]) -> Vector (Field [ByteString])
forall a. Int -> Vector a -> Vector a
V.take Int
i Vector (Field [ByteString])
v Vector (Field [ByteString])
-> Vector (Field [ByteString]) -> Vector (Field [ByteString])
forall a. Semigroup a => a -> a -> a
<> Field [ByteString] -> Vector (Field [ByteString])
forall a. a -> Vector a
V.singleton Field [ByteString]
f' Vector (Field [ByteString])
-> Vector (Field [ByteString]) -> Vector (Field [ByteString])
forall a. Semigroup a => a -> a -> a
<> Int -> Vector (Field [ByteString]) -> Vector (Field [ByteString])
forall a. Int -> Vector a -> Vector a
V.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Vector (Field [ByteString])
v)
    Maybe Int
Nothing -> CabalFields
cf CabalFields -> (CabalFields -> CabalFields) -> CabalFields
forall a b. a -> (a -> b) -> b
& (CabalFields -> CabalFields)
-> (Field [ByteString] -> CabalFields -> CabalFields)
-> Maybe (Field [ByteString])
-> CabalFields
-> CabalFields
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CabalFields -> CabalFields
forall a. a -> a
id (Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
-> (Vector (Field [ByteString]) -> Vector (Field [ByteString]))
-> CabalFields
-> CabalFields
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
#fields ((Vector (Field [ByteString]) -> Vector (Field [ByteString]))
 -> CabalFields -> CabalFields)
-> (Field [ByteString]
    -> Vector (Field [ByteString]) -> Vector (Field [ByteString]))
-> Field [ByteString]
-> CabalFields
-> CabalFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Field [ByteString]
f -> (Vector (Field [ByteString])
-> Vector (Field [ByteString]) -> Vector (Field [ByteString])
forall a. Semigroup a => a -> a -> a
<> Field [ByteString] -> Vector (Field [ByteString])
forall a. a -> Vector a
V.singleton Field [ByteString]
f))) Maybe (Field [ByteString])
f

-- | A lens by name into a field (but not a section).
--
-- >>> fs & view (field' "version")
-- [Field (Name [] "version") [FieldLine [] "0.1.0.0"]]
field' :: FieldName -> Getter [Field Comment] [Field Comment]
field' :: ByteString
-> Optic
     A_Getter
     '[]
     [Field [ByteString]]
     [Field [ByteString]]
     [Field [ByteString]]
     [Field [ByteString]]
field' ByteString
name = ([Field [ByteString]] -> [Field [ByteString]])
-> Optic
     A_Getter
     '[]
     [Field [ByteString]]
     [Field [ByteString]]
     [Field [ByteString]]
     [Field [ByteString]]
forall s a. (s -> a) -> Getter s a
to ((Field [ByteString] -> Bool)
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Field [ByteString] -> Bool) -> Field [ByteString] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field [ByteString] -> Bool
forall ann. Field ann -> Bool
isSection) ([Field [ByteString]] -> [Field [ByteString]])
-> ([Field [ByteString]] -> [Field [ByteString]])
-> [Field [ByteString]]
-> [Field [ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Field [ByteString] -> Bool)
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString -> Field [ByteString] -> Bool
forall ann. ByteString -> Field ann -> Bool
isName ByteString
name))

-- | A getter by name into a field (including within sections)
--
-- >>> fs & toListOf (each % subfield' "default-language")
-- [[],[],[],[],[],[],[],[],[Field (Name [] "default-language") [FieldLine [] "GHC2021"]],[Field (Name [] "default-language") [FieldLine [] "GHC2021"]]]
subfield' :: FieldName -> Getter (Field Comment) [Field Comment]
subfield' :: ByteString -> Getter (Field [ByteString]) [Field [ByteString]]
subfield' ByteString
name = (Field [ByteString] -> [Field [ByteString]])
-> Getter (Field [ByteString]) [Field [ByteString]]
forall s a. (s -> a) -> Getter s a
to (ByteString -> Field [ByteString] -> [Field [ByteString]]
forall ann. ByteString -> Field ann -> [Field ann]
subfield_ ByteString
name)

subfield_ :: FieldName -> Field ann -> [Field ann]
subfield_ :: forall ann. ByteString -> Field ann -> [Field ann]
subfield_ ByteString
name Field ann
f = (Field ann -> Bool) -> [Field ann] -> [Field ann]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString -> Field ann -> Bool
forall ann. ByteString -> Field ann -> Bool
isName ByteString
name) ([Field ann] -> [Field ann]) -> [Field ann] -> [Field ann]
forall a b. (a -> b) -> a -> b
$ Field ann -> [Field ann]
forall ann. Field ann -> [Field ann]
fieldUniverse Field ann
f

-- | A getter of a section (not a field)
--
-- >>> fs & foldOf (section' "library" % each % secFields' % field' "exposed-modules")
-- [Field (Name [] "exposed-modules") [FieldLine [] "MyLib"]]
section' :: FieldName -> Getter [Field ann] [Field ann]
section' :: forall ann. ByteString -> Getter [Field ann] [Field ann]
section' ByteString
name = ([Field ann] -> [Field ann]) -> Getter [Field ann] [Field ann]
forall s a. (s -> a) -> Getter s a
to ((Field ann -> Bool) -> [Field ann] -> [Field ann]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Field ann
f -> ByteString -> Field ann -> Bool
forall ann. ByteString -> Field ann -> Bool
isName ByteString
name Field ann
f Bool -> Bool -> Bool
&& Field ann -> Bool
forall ann. Field ann -> Bool
isSection Field ann
f))

-- | A getter of section fields
secFields' :: Lens' (Field ann) [Field ann]
secFields' :: forall ann. Lens' (Field ann) [Field ann]
secFields' = (Field ann -> [Field ann])
-> (Field ann -> [Field ann] -> Field ann)
-> Lens (Field ann) (Field ann) [Field ann] [Field ann]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Field ann -> [Field ann]
forall ann. Field ann -> [Field ann]
secFieldsView Field ann -> [Field ann] -> Field ann
forall ann. Field ann -> [Field ann] -> Field ann
secFieldsSet

secFieldsSet :: Field ann -> [Field ann] -> Field ann
secFieldsSet :: forall ann. Field ann -> [Field ann] -> Field ann
secFieldsSet f :: Field ann
f@(Field {}) [Field ann]
_ = Field ann
f
secFieldsSet (Section Name ann
n [SectionArg ann]
sa [Field ann]
_) [Field ann]
fs = Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section Name ann
n [SectionArg ann]
sa [Field ann]
fs

secFieldsView :: Field ann -> [Field ann]
secFieldsView :: forall ann. Field ann -> [Field ann]
secFieldsView (Field {}) = []
secFieldsView (Section Name ann
_ [SectionArg ann]
_ [Field ann]
fs) = [Field ann]
fs

-- | A getter by name of a field or section.
fieldOrSection' :: FieldName -> Getter [Field ann] [Field ann]
fieldOrSection' :: forall ann. ByteString -> Getter [Field ann] [Field ann]
fieldOrSection' ByteString
name = ([Field ann] -> [Field ann]) -> Getter [Field ann] [Field ann]
forall s a. (s -> a) -> Getter s a
to ((Field ann -> Bool) -> [Field ann] -> [Field ann]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString -> Field ann -> Bool
forall ann. ByteString -> Field ann -> Bool
isName ByteString
name))

isName :: FieldName -> Field ann -> Bool
isName :: forall ann. ByteString -> Field ann -> Bool
isName ByteString
name = (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
name) (ByteString -> Bool)
-> (Field ann -> ByteString) -> Field ann -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens '[] (Field ann) ByteString -> Field ann -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (Field ann) ByteString
forall ann. Lens' (Field ann) ByteString
fieldName'

isSection :: Field ann -> Bool
isSection :: forall ann. Field ann -> Bool
isSection (Section {}) = Bool
True
isSection (Field {}) = Bool
False

-- | A mapping into the field structure, operating on field lists in sections as well as the field itself.
overField :: (Field ann -> Field ann) -> Field ann -> Field ann
overField :: forall ann. (Field ann -> Field ann) -> Field ann -> Field ann
overField Field ann -> Field ann
f' f :: Field ann
f@(Field {}) = Field ann -> Field ann
f' Field ann
f
overField Field ann -> Field ann
f' (Section Name ann
n [SectionArg ann]
sa [Field ann]
fs) = Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section Name ann
n [SectionArg ann]
sa ((Field ann -> Field ann) -> [Field ann] -> [Field ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Field ann -> Field ann) -> Field ann -> Field ann
forall ann. (Field ann -> Field ann) -> Field ann -> Field ann
overField Field ann -> Field ann
f') [Field ann]
fs)

-- | A mapping into the field structure, operating on field lists in sections as well as field lists themselves.
overFields :: ([Field ann] -> [Field ann]) -> [Field ann] -> [Field ann]
overFields :: forall ann.
([Field ann] -> [Field ann]) -> [Field ann] -> [Field ann]
overFields [Field ann] -> [Field ann]
f [Field ann]
fs = [Field ann] -> [Field ann]
f ([Field ann] -> [Field ann]) -> [Field ann] -> [Field ann]
forall a b. (a -> b) -> a -> b
$ (Field ann -> Field ann) -> [Field ann] -> [Field ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field ann -> Field ann
inner [Field ann]
fs
  where
    inner :: Field ann -> Field ann
inner f' :: Field ann
f'@(Field {}) = Field ann
f'
    inner (Section Name ann
n [SectionArg ann]
sa [Field ann]
fs') = Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section Name ann
n [SectionArg ann]
sa (([Field ann] -> [Field ann]) -> [Field ann] -> [Field ann]
forall ann.
([Field ann] -> [Field ann]) -> [Field ann] -> [Field ann]
overFields [Field ann] -> [Field ann]
f [Field ann]
fs')

-- | Project name. Errors if the field is missing.
--
-- >>> pname cf
-- "minimal"
pname :: CabalFields -> ByteString
pname :: CabalFields -> ByteString
pname CabalFields
cf = CabalFields
cf CabalFields
-> (CabalFields -> Maybe ByteString) -> Maybe ByteString
forall a b. a -> (a -> b) -> b
& Optic' An_AffineFold '[] CabalFields ByteString
-> CabalFields -> Maybe ByteString
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (ByteString -> Lens' CabalFields (Maybe (Field [ByteString]))
topfield' ByteString
"name" Lens' CabalFields (Maybe (Field [ByteString]))
-> Optic
     A_Prism
     '[]
     (Maybe (Field [ByteString]))
     (Maybe (Field [ByteString]))
     (Field [ByteString])
     (Field [ByteString])
-> Optic
     An_AffineTraversal
     '[]
     CabalFields
     CabalFields
     (Field [ByteString])
     (Field [ByteString])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  '[]
  (Maybe (Field [ByteString]))
  (Maybe (Field [ByteString]))
  (Field [ByteString])
  (Field [ByteString])
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Optic
  An_AffineTraversal
  '[]
  CabalFields
  CabalFields
  (Field [ByteString])
  (Field [ByteString])
-> Optic
     A_Lens
     '[]
     (Field [ByteString])
     (Field [ByteString])
     [FieldLine [ByteString]]
     [FieldLine [ByteString]]
-> Optic
     An_AffineTraversal
     '[]
     CabalFields
     CabalFields
     [FieldLine [ByteString]]
     [FieldLine [ByteString]]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (Field [ByteString])
  (Field [ByteString])
  [FieldLine [ByteString]]
  [FieldLine [ByteString]]
forall ann. Lens' (Field ann) [FieldLine ann]
fieldLines' Optic
  An_AffineTraversal
  '[]
  CabalFields
  CabalFields
  [FieldLine [ByteString]]
  [FieldLine [ByteString]]
-> Optic
     An_AffineTraversal
     '[]
     [FieldLine [ByteString]]
     [FieldLine [ByteString]]
     (FieldLine [ByteString])
     (FieldLine [ByteString])
-> Optic
     An_AffineTraversal
     '[]
     CabalFields
     CabalFields
     (FieldLine [ByteString])
     (FieldLine [ByteString])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index [FieldLine [ByteString]]
-> Optic'
     (IxKind [FieldLine [ByteString]])
     '[]
     [FieldLine [ByteString]]
     (IxValue [FieldLine [ByteString]])
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Int
Index [FieldLine [ByteString]]
0 Optic
  An_AffineTraversal
  '[]
  CabalFields
  CabalFields
  (FieldLine [ByteString])
  (FieldLine [ByteString])
-> Optic
     A_Getter
     '[]
     (FieldLine [ByteString])
     (FieldLine [ByteString])
     ByteString
     ByteString
-> Optic' An_AffineFold '[] CabalFields ByteString
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (FieldLine [ByteString] -> ByteString)
-> Optic
     A_Getter
     '[]
     (FieldLine [ByteString])
     (FieldLine [ByteString])
     ByteString
     ByteString
forall s a. (s -> a) -> Getter s a
to FieldLine [ByteString] -> ByteString
forall ann. FieldLine ann -> ByteString
fieldLineBS) Maybe ByteString -> (Maybe ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (String -> ByteString
forall a. HasCallStack => String -> a
error String
"no name field")

-- | Name of (field or section).
--
-- >>> head fs & view fieldName'
-- "cabal-version"
fieldName' :: Lens' (Field ann) ByteString
fieldName' :: forall ann. Lens' (Field ann) ByteString
fieldName' = (Field ann -> ByteString)
-> (Field ann -> ByteString -> Field ann)
-> Lens (Field ann) (Field ann) ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Field ann -> Name ann
forall ann. Field ann -> Name ann
fieldName (Field ann -> Name ann)
-> (Name ann -> ByteString) -> Field ann -> ByteString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Name ann -> ByteString
forall ann. Name ann -> ByteString
getName) Field ann -> ByteString -> Field ann
forall {ann}. Field ann -> ByteString -> Field ann
fieldNameSet
  where
    fieldNameSet :: Field ann -> ByteString -> Field ann
fieldNameSet (Field (Name ann
ann ByteString
_) [FieldLine ann]
fls) ByteString
name = Name ann -> [FieldLine ann] -> Field ann
forall ann. Name ann -> [FieldLine ann] -> Field ann
Field (ann -> ByteString -> Name ann
forall ann. ann -> ByteString -> Name ann
Name ann
ann ByteString
name) [FieldLine ann]
fls
    fieldNameSet (Section (Name ann
ann ByteString
_) [SectionArg ann]
sa [Field ann]
fs) ByteString
name = Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section (ann -> ByteString -> Name ann
forall ann. ann -> ByteString -> Name ann
Name ann
ann ByteString
name) [SectionArg ann]
sa [Field ann]
fs

inNameList :: [ByteString] -> Field ann -> Bool
inNameList :: forall ann. [ByteString] -> Field ann -> Bool
inNameList [ByteString]
ns Field ann
f = Optic' A_Lens '[] (Field ann) ByteString -> Field ann -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (Field ann) ByteString
forall ann. Lens' (Field ann) ByteString
fieldName' Field ann
f ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
ns

-- | Lens into field lines
--
-- >>> fs & foldOf (section' "test-suite" % each % secFields' % field' "build-depends" % each % fieldLines')
-- [FieldLine [] "base ^>=4.17.2.1,",FieldLine [] "minimal"]
fieldLines' :: Lens' (Field ann) [FieldLine ann]
fieldLines' :: forall ann. Lens' (Field ann) [FieldLine ann]
fieldLines' = (Field ann -> [FieldLine ann])
-> (Field ann -> [FieldLine ann] -> Field ann)
-> Lens (Field ann) (Field ann) [FieldLine ann] [FieldLine ann]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Field ann -> [FieldLine ann]
forall ann. Field ann -> [FieldLine ann]
fieldFieldLinesView Field ann -> [FieldLine ann] -> Field ann
forall ann. Field ann -> [FieldLine ann] -> Field ann
fieldFieldLinesSet

fieldFieldLinesView :: Field ann -> [FieldLine ann]
fieldFieldLinesView :: forall ann. Field ann -> [FieldLine ann]
fieldFieldLinesView (Field Name ann
_ [FieldLine ann]
fls) = [FieldLine ann]
fls
fieldFieldLinesView Field ann
_ = []

fieldFieldLinesSet :: Field ann -> [FieldLine ann] -> Field ann
fieldFieldLinesSet :: forall ann. Field ann -> [FieldLine ann] -> Field ann
fieldFieldLinesSet (Field Name ann
n [FieldLine ann]
_) [FieldLine ann]
fls = Name ann -> [FieldLine ann] -> Field ann
forall ann. Name ann -> [FieldLine ann] -> Field ann
Field Name ann
n [FieldLine ann]
fls
fieldFieldLinesSet Field ann
_ [FieldLine ann]
_ = String -> Field ann
forall a. HasCallStack => String -> a
error String
"setting a section field line"

-- * SectionArg

-- | lens into SectionArg part of a section.
--
-- Errors if you actually have a field.
--
-- >>> fs & foldOf (section' "test-suite" % each % secArgs')
-- [SecArgName [] "minimal-test"]
secArgs' :: Lens' (Field ann) [SectionArg ann]
secArgs' :: forall ann. Lens' (Field ann) [SectionArg ann]
secArgs' = (Field ann -> [SectionArg ann])
-> (Field ann -> [SectionArg ann] -> Field ann)
-> Lens (Field ann) (Field ann) [SectionArg ann] [SectionArg ann]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Field ann -> [SectionArg ann]
forall ann. Field ann -> [SectionArg ann]
secArgView Field ann -> [SectionArg ann] -> Field ann
forall ann. Field ann -> [SectionArg ann] -> Field ann
secArgSet

secArgView :: Field ann -> [SectionArg ann]
secArgView :: forall ann. Field ann -> [SectionArg ann]
secArgView (Field {}) = String -> [SectionArg ann]
forall a. HasCallStack => String -> a
error String
"not a section"
secArgView (Section Name ann
_ [SectionArg ann]
a [Field ann]
_) = [SectionArg ann]
a

secArgSet :: Field ann -> [SectionArg ann] -> Field ann
secArgSet :: forall ann. Field ann -> [SectionArg ann] -> Field ann
secArgSet (Field {}) [SectionArg ann]
_ = String -> Field ann
forall a. HasCallStack => String -> a
error String
"not a section"
secArgSet (Section Name ann
n [SectionArg ann]
_ [Field ann]
fs) [SectionArg ann]
a = Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section Name ann
n [SectionArg ann]
a [Field ann]
fs

-- | secArg lens into a ByteString representation
--
-- >>> fs & foldOf (section' "test-suite" % each % secArgs' % each % secArgBS')
-- ("name","minimal-test")
secArgBS' :: Lens' (SectionArg ann) (ByteString, ByteString)
secArgBS' :: forall ann. Lens' (SectionArg ann) (ByteString, ByteString)
secArgBS' = (SectionArg ann -> (ByteString, ByteString))
-> (SectionArg ann -> (ByteString, ByteString) -> SectionArg ann)
-> Lens
     (SectionArg ann)
     (SectionArg ann)
     (ByteString, ByteString)
     (ByteString, ByteString)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SectionArg ann -> (ByteString, ByteString)
forall a. SectionArg a -> (ByteString, ByteString)
secArgBSView SectionArg ann -> (ByteString, ByteString) -> SectionArg ann
forall ann.
SectionArg ann -> (ByteString, ByteString) -> SectionArg ann
secArgBSSet

secArgBSView :: SectionArg a -> (ByteString, ByteString)
secArgBSView :: forall a. SectionArg a -> (ByteString, ByteString)
secArgBSView (SecArgName a
_ ByteString
n) = (ByteString
"name", ByteString
n)
secArgBSView (SecArgStr a
_ ByteString
n) = (ByteString
"str", ByteString
n)
secArgBSView (SecArgOther a
_ ByteString
n) = (ByteString
"other", ByteString
n)

secArgBSSet :: SectionArg ann -> (ByteString, ByteString) -> SectionArg ann
secArgBSSet :: forall ann.
SectionArg ann -> (ByteString, ByteString) -> SectionArg ann
secArgBSSet SectionArg ann
sa (ByteString
t, ByteString
a) = case ByteString
t of
  ByteString
"name" -> ann -> ByteString -> SectionArg ann
forall ann. ann -> ByteString -> SectionArg ann
SecArgName (SectionArg ann -> ann
forall ann. SectionArg ann -> ann
sectionArgAnn SectionArg ann
sa) ByteString
a
  ByteString
"str" -> ann -> ByteString -> SectionArg ann
forall ann. ann -> ByteString -> SectionArg ann
SecArgStr (SectionArg ann -> ann
forall ann. SectionArg ann -> ann
sectionArgAnn SectionArg ann
sa) ByteString
a
  ByteString
_ -> ann -> ByteString -> SectionArg ann
forall ann. ann -> ByteString -> SectionArg ann
SecArgOther (SectionArg ann -> ann
forall ann. SectionArg ann -> ann
sectionArgAnn SectionArg ann
sa) ByteString
a

-- | lens into field line contents.
--
-- >>>  fs & toListOf (section' "test-suite" % each % secFields' % field' "build-depends" % each % fieldLines' % each % fieldLine')
-- ["base ^>=4.17.2.1,","minimal"]
fieldLine' :: Lens' (FieldLine ann) ByteString
fieldLine' :: forall ann. Lens' (FieldLine ann) ByteString
fieldLine' = (FieldLine ann -> ByteString)
-> (FieldLine ann -> ByteString -> FieldLine ann)
-> Lens (FieldLine ann) (FieldLine ann) ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FieldLine ann -> ByteString
forall ann. FieldLine ann -> ByteString
fieldLineBS FieldLine ann -> ByteString -> FieldLine ann
forall {ann}. FieldLine ann -> ByteString -> FieldLine ann
setValueFL
  where
    setValueFL :: FieldLine ann -> ByteString -> FieldLine ann
setValueFL (FieldLine ann
ann ByteString
_) = ann -> ByteString -> FieldLine ann
forall ann. ann -> ByteString -> FieldLine ann
FieldLine ann
ann

-- | A fold of a field list into a ByteString.
fieldValues' :: FieldName -> Optic A_Fold '[Int, Int] [Field Comment] [Field Comment] ByteString ByteString
fieldValues' :: ByteString
-> Optic
     A_Fold
     '[Int, Int]
     [Field [ByteString]]
     [Field [ByteString]]
     ByteString
     ByteString
fieldValues' ByteString
name = ByteString
-> Optic
     A_Getter
     '[]
     [Field [ByteString]]
     [Field [ByteString]]
     [Field [ByteString]]
     [Field [ByteString]]
field' ByteString
name Optic
  A_Getter
  '[]
  [Field [ByteString]]
  [Field [ByteString]]
  [Field [ByteString]]
  [Field [ByteString]]
-> Optic
     A_Traversal
     '[Int]
     [Field [ByteString]]
     [Field [ByteString]]
     (Field [ByteString])
     (Field [ByteString])
-> Optic
     A_Fold
     '[Int]
     [Field [ByteString]]
     [Field [ByteString]]
     (Field [ByteString])
     (Field [ByteString])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  '[Int]
  [Field [ByteString]]
  [Field [ByteString]]
  (Field [ByteString])
  (Field [ByteString])
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Fold
  '[Int]
  [Field [ByteString]]
  [Field [ByteString]]
  (Field [ByteString])
  (Field [ByteString])
-> Optic
     A_Lens
     '[]
     (Field [ByteString])
     (Field [ByteString])
     [FieldLine [ByteString]]
     [FieldLine [ByteString]]
-> Optic
     A_Fold
     '[Int]
     [Field [ByteString]]
     [Field [ByteString]]
     [FieldLine [ByteString]]
     [FieldLine [ByteString]]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (Field [ByteString])
  (Field [ByteString])
  [FieldLine [ByteString]]
  [FieldLine [ByteString]]
forall ann. Lens' (Field ann) [FieldLine ann]
fieldLines' Optic
  A_Fold
  '[Int]
  [Field [ByteString]]
  [Field [ByteString]]
  [FieldLine [ByteString]]
  [FieldLine [ByteString]]
-> Optic
     A_Traversal
     '[Int]
     [FieldLine [ByteString]]
     [FieldLine [ByteString]]
     (FieldLine [ByteString])
     (FieldLine [ByteString])
-> Optic
     A_Fold
     '[Int, Int]
     [Field [ByteString]]
     [Field [ByteString]]
     (FieldLine [ByteString])
     (FieldLine [ByteString])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  '[Int]
  [FieldLine [ByteString]]
  [FieldLine [ByteString]]
  (FieldLine [ByteString])
  (FieldLine [ByteString])
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Fold
  '[Int, Int]
  [Field [ByteString]]
  [Field [ByteString]]
  (FieldLine [ByteString])
  (FieldLine [ByteString])
-> Optic
     A_Lens
     '[]
     (FieldLine [ByteString])
     (FieldLine [ByteString])
     ByteString
     ByteString
-> Optic
     A_Fold
     '[Int, Int]
     [Field [ByteString]]
     [Field [ByteString]]
     ByteString
     ByteString
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FieldLine [ByteString])
  (FieldLine [ByteString])
  ByteString
  ByteString
forall ann. Lens' (FieldLine ann) ByteString
fieldLine'

-- * fixes

-- | fix order:
--
-- - removes fields
--
-- - removes blank fields
--
-- - fixes commas
--
-- - adds Fields
--
-- - fix build dependencies
--
-- - sort field lines
--
-- - sort fields
fixCabalFields :: Config -> CabalFields -> CabalFields
fixCabalFields :: Config -> CabalFields -> CabalFields
fixCabalFields Config
cfg CabalFields
cf =
  CabalFields
cf
    CabalFields -> (CabalFields -> CabalFields) -> CabalFields
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  '[]
  CabalFields
  CabalFields
  [Field [ByteString]]
  [Field [ByteString]]
-> ([Field [ByteString]] -> [Field [ByteString]])
-> CabalFields
-> CabalFields
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
      (Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
#fields Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
-> Iso' (Vector (Field [ByteString])) [Field [ByteString]]
-> Optic
     A_Lens
     '[]
     CabalFields
     CabalFields
     [Field [ByteString]]
     [Field [ByteString]]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Iso' (Vector (Field [ByteString])) [Field [ByteString]]
fieldList')
      ( ([Field [ByteString]] -> [Field [ByteString]])
-> [Field [ByteString]] -> [Field [ByteString]]
forall ann.
([Field ann] -> [Field ann]) -> [Field ann] -> [Field ann]
overFields ((Field [ByteString] -> Bool)
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Field [ByteString] -> Bool) -> Field [ByteString] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Field [ByteString] -> Bool
forall ann. [ByteString] -> Field ann -> Bool
inNameList (Config -> [ByteString]
fieldRemovals Config
cfg)))
          ([Field [ByteString]] -> [Field [ByteString]])
-> ([Field [ByteString]] -> [Field [ByteString]])
-> [Field [ByteString]]
-> [Field [ByteString]]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Field [ByteString]] -> [Field [ByteString]])
-> [Field [ByteString]] -> [Field [ByteString]]
forall ann.
([Field ann] -> [Field ann]) -> [Field ann] -> [Field ann]
overFields (([Field [ByteString]] -> [Field [ByteString]])
-> ([Field [ByteString]] -> [Field [ByteString]])
-> Bool
-> [Field [ByteString]]
-> [Field [ByteString]]
forall a. a -> a -> Bool -> a
bool [Field [ByteString]] -> [Field [ByteString]]
forall a. a -> a
id ((Field [ByteString] -> Bool)
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (Field [ByteString] -> Bool) -> Field [ByteString] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field [ByteString] -> Bool
forall ann. Field ann -> Bool
isBlankField)) (Config -> Bool
removeBlankFields Config
cfg))
          ([Field [ByteString]] -> [Field [ByteString]])
-> ([Field [ByteString]] -> [Field [ByteString]])
-> [Field [ByteString]]
-> [Field [ByteString]]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Field [ByteString] -> Field [ByteString])
-> [Field [ByteString]] -> [Field [ByteString]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Field [ByteString] -> Field [ByteString])
-> Field [ByteString] -> Field [ByteString]
forall ann. (Field ann -> Field ann) -> Field ann -> Field ann
overField (Config -> Field [ByteString] -> Field [ByteString]
forall ann. Config -> Field ann -> Field ann
fixesCommas Config
cfg))
          ([Field [ByteString]] -> [Field [ByteString]])
-> ([Field [ByteString]] -> [Field [ByteString]])
-> [Field [ByteString]]
-> [Field [ByteString]]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Config -> [Field [ByteString]] -> [Field [ByteString]]
addsFields Config
cfg
          ([Field [ByteString]] -> [Field [ByteString]])
-> ([Field [ByteString]] -> [Field [ByteString]])
-> [Field [ByteString]]
-> [Field [ByteString]]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Field [ByteString]] -> [Field [ByteString]])
-> ([Field [ByteString]] -> [Field [ByteString]])
-> Bool
-> [Field [ByteString]]
-> [Field [ByteString]]
forall a. a -> a -> Bool -> a
bool [Field [ByteString]] -> [Field [ByteString]]
forall a. a -> a
id ((Field [ByteString] -> Field [ByteString])
-> [Field [ByteString]] -> [Field [ByteString]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Field [ByteString] -> Field [ByteString])
-> Field [ByteString] -> Field [ByteString]
forall ann. (Field ann -> Field ann) -> Field ann -> Field ann
overField (Config -> ByteString -> Field [ByteString] -> Field [ByteString]
forall ann. Config -> ByteString -> Field ann -> Field ann
fixBuildDeps Config
cfg (CabalFields -> ByteString
pname CabalFields
cf)))) (Config -> Bool
doFixBuildDeps Config
cfg)
          ([Field [ByteString]] -> [Field [ByteString]])
-> ([Field [ByteString]] -> [Field [ByteString]])
-> [Field [ByteString]]
-> [Field [ByteString]]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Field [ByteString] -> Field [ByteString])
-> [Field [ByteString]] -> [Field [ByteString]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Field [ByteString] -> Field [ByteString])
-> Field [ByteString] -> Field [ByteString]
forall ann. (Field ann -> Field ann) -> Field ann -> Field ann
overField ([ByteString] -> Field [ByteString] -> Field [ByteString]
forall ann. [ByteString] -> Field ann -> Field ann
sortFieldLinesFor (Config -> [ByteString]
sortFieldLines Config
cfg)))
          ([Field [ByteString]] -> [Field [ByteString]])
-> ([Field [ByteString]] -> [Field [ByteString]])
-> [Field [ByteString]]
-> [Field [ByteString]]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Field [ByteString]] -> [Field [ByteString]])
-> ([Field [ByteString]] -> [Field [ByteString]])
-> Bool
-> [Field [ByteString]]
-> [Field [ByteString]]
forall a. a -> a -> Bool -> a
bool [Field [ByteString]] -> [Field [ByteString]]
forall a. a -> a
id (([Field [ByteString]] -> [Field [ByteString]])
-> [Field [ByteString]] -> [Field [ByteString]]
forall ann.
([Field ann] -> [Field ann]) -> [Field ann] -> [Field ann]
overFields (Config -> [Field [ByteString]] -> [Field [ByteString]]
forall ann. Config -> [Field ann] -> [Field ann]
sortFields Config
cfg)) (Config -> Bool
doSortFields Config
cfg)
      )

-- | Fix a cabal file in-place
fixCabalFile :: FilePath -> Config -> IO Bool
fixCabalFile :: String -> Config -> IO Bool
fixCabalFile String
fp Config
cfg = do
  ByteString
bs <- String -> IO ByteString
BS.readFile String
fp
  IO Bool -> (CabalFields -> IO Bool) -> Maybe CabalFields -> IO Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
    (\CabalFields
cf -> String -> ByteString -> IO ()
BS.writeFile String
fp (Config -> CabalFields -> ByteString
printCabalFields Config
cfg (Config -> CabalFields -> CabalFields
fixCabalFields Config
cfg CabalFields
cf)) IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
    (Prism' ByteString CabalFields -> ByteString -> Maybe CabalFields
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Config -> Prism' ByteString CabalFields
cabalFields' Config
cfg) ByteString
bs)

-- * blank field removal

-- | Is the field blank (including has no section arguments if a section)
isBlankField :: Field ann -> Bool
isBlankField :: forall ann. Field ann -> Bool
isBlankField (Field Name ann
_ [FieldLine ann]
fs) = [FieldLine ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldLine ann]
fs
isBlankField (Section Name ann
_ [SectionArg ann]
sas [Field ann]
fss) = [Field ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Field ann]
fss Bool -> Bool -> Bool
&& [SectionArg ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SectionArg ann]
sas

-- * commas

-- | Fix the comma usage in a field list
--
-- >>> fs & toListOf (section' "test-suite" % each % secFields' % field' "build-depends" % each) & fmap (fixesCommas cfg)
-- [Field (Name [] "build-depends") [FieldLine [] ", base ^>=4.17.2.1",FieldLine [] ", minimal"]]
fixesCommas :: Config -> Field ann -> Field ann
fixesCommas :: forall ann. Config -> Field ann -> Field ann
fixesCommas Config
cfg Field ann
x = (Field ann -> (Field ann -> Field ann) -> Field ann)
-> Field ann -> [Field ann -> Field ann] -> Field ann
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Field ann -> (Field ann -> Field ann) -> Field ann
forall a b. a -> (a -> b) -> b
(&) Field ann
x ([Field ann -> Field ann] -> Field ann)
-> [Field ann -> Field ann] -> Field ann
forall a b. (a -> b) -> a -> b
$ Config -> [(ByteString, CommaStyle, CommaTrail)]
fixCommas Config
cfg [(ByteString, CommaStyle, CommaTrail)]
-> ([(ByteString, CommaStyle, CommaTrail)]
    -> [Field ann -> Field ann])
-> [Field ann -> Field ann]
forall a b. a -> (a -> b) -> b
& ((ByteString, CommaStyle, CommaTrail) -> Field ann -> Field ann)
-> [(ByteString, CommaStyle, CommaTrail)]
-> [Field ann -> Field ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ByteString
n, CommaStyle
s, CommaTrail
t) -> (Field ann -> Field ann)
-> (Field ann -> Field ann) -> Bool -> Field ann -> Field ann
forall a. a -> a -> Bool -> a
bool Field ann -> Field ann
forall a. a -> a
id (CommaStyle -> CommaTrail -> Field ann -> Field ann
forall ann. CommaStyle -> CommaTrail -> Field ann -> Field ann
fixCommasF CommaStyle
s CommaTrail
t) ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
n) (ByteString -> Bool) -> ByteString -> Bool
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens '[] (Field ann) ByteString -> Field ann -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (Field ann) ByteString
forall ann. Lens' (Field ann) ByteString
fieldName' Field ann
x))

addCommaBS :: CommaStyle -> CommaTrail -> [ByteString] -> [ByteString]
addCommaBS :: CommaStyle -> CommaTrail -> [ByteString] -> [ByteString]
addCommaBS CommaStyle
commaStyle CommaTrail
trailStyle [ByteString]
xs = case CommaTrail
trailStyle of
  CommaTrail
NoTrailer -> case CommaStyle
commaStyle of
    CommaStyle
PostfixCommas -> ((ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
",") (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
init [ByteString]
xs) [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [[ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
last [ByteString]
xs]
    CommaStyle
PrefixCommas -> [ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
head [ByteString]
xs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ((ByteString
", " <>) (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
tail [ByteString]
xs)
    -- since we don't know the prior comma strategy, we just guess here.
    CommaStyle
FreeformCommas -> ((ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
",") (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
init [ByteString]
xs) [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [[ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
last [ByteString]
xs]
    CommaStyle
NoCommas -> [ByteString]
xs
  CommaTrail
Trailer -> case CommaStyle
commaStyle of
    CommaStyle
PostfixCommas -> (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
",") (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
xs
    CommaStyle
PrefixCommas -> (ByteString
", " <>) (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
xs
    -- since we don't know the prior comma strategy, we just guess here.
    CommaStyle
FreeformCommas -> (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
",") (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
xs
    CommaStyle
NoCommas -> [ByteString]
xs

stripCommaBS :: ByteString -> ByteString
stripCommaBS :: ByteString -> ByteString
stripCommaBS ByteString
bs =
  ByteString -> ByteString -> Maybe ByteString
C.stripPrefix ByteString
", " ByteString
bs
    Maybe ByteString -> (Maybe ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe
      ( ByteString -> ByteString -> Maybe ByteString
C.stripPrefix ByteString
"," ByteString
bs
          Maybe ByteString -> (Maybe ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe
            ( ByteString -> ByteString -> Maybe ByteString
C.stripSuffix ByteString
"," ByteString
bs
                Maybe ByteString -> (Maybe ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
bs
            )
      )

fixCommasF :: CommaStyle -> CommaTrail -> Field ann -> Field ann
fixCommasF :: forall ann. CommaStyle -> CommaTrail -> Field ann -> Field ann
fixCommasF CommaStyle
s CommaTrail
t Field ann
f = Field ann
fls'
  where
    fls :: [ByteString]
fls = Optic' A_Traversal '[Int] (Field ann) ByteString
-> Field ann -> [ByteString]
forall k (is :: IxList) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Lens' (Field ann) [FieldLine ann]
forall ann. Lens' (Field ann) [FieldLine ann]
fieldLines' Lens' (Field ann) [FieldLine ann]
-> Optic
     A_Traversal
     '[Int]
     [FieldLine ann]
     [FieldLine ann]
     (FieldLine ann)
     (FieldLine ann)
-> Optic
     A_Traversal
     '[Int]
     (Field ann)
     (Field ann)
     (FieldLine ann)
     (FieldLine ann)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  '[Int]
  [FieldLine ann]
  [FieldLine ann]
  (FieldLine ann)
  (FieldLine ann)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  '[Int]
  (Field ann)
  (Field ann)
  (FieldLine ann)
  (FieldLine ann)
-> Optic
     A_Lens '[] (FieldLine ann) (FieldLine ann) ByteString ByteString
-> Optic' A_Traversal '[Int] (Field ann) ByteString
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] (FieldLine ann) (FieldLine ann) ByteString ByteString
forall ann. Lens' (FieldLine ann) ByteString
fieldLine') Field ann
f
    fls' :: Field ann
fls' = Lens' (Field ann) [FieldLine ann]
-> [FieldLine ann] -> Field ann -> Field ann
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' (Field ann) [FieldLine ann]
forall ann. Lens' (Field ann) [FieldLine ann]
fieldLines' ((ByteString -> FieldLine ann -> FieldLine ann)
-> [ByteString] -> [FieldLine ann] -> [FieldLine ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Optic
  A_Lens '[] (FieldLine ann) (FieldLine ann) ByteString ByteString
-> ByteString -> FieldLine ann -> FieldLine ann
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens '[] (FieldLine ann) (FieldLine ann) ByteString ByteString
forall ann. Lens' (FieldLine ann) ByteString
fieldLine') (CommaStyle -> CommaTrail -> [ByteString] -> [ByteString]
addCommaBS CommaStyle
s CommaTrail
t ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
stripCommaBS [ByteString]
fls) (Lens' (Field ann) [FieldLine ann] -> Field ann -> [FieldLine ann]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' (Field ann) [FieldLine ann]
forall ann. Lens' (Field ann) [FieldLine ann]
fieldLines' Field ann
f)) Field ann
f

-- | add fields
--
-- >>> addsFields (cfg & set #addFields [("description", "added by addsFields", AddReplace)]) []
-- [Field (Name [] "description") [FieldLine [] "added by addsFields"]]
addsFields :: Config -> [Field Comment] -> [Field Comment]
addsFields :: Config -> [Field [ByteString]] -> [Field [ByteString]]
addsFields Config
cfg [Field [ByteString]]
x = ([Field [ByteString]]
 -> ([Field [ByteString]] -> [Field [ByteString]])
 -> [Field [ByteString]])
-> [Field [ByteString]]
-> [[Field [ByteString]] -> [Field [ByteString]]]
-> [Field [ByteString]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Field [ByteString]]
-> ([Field [ByteString]] -> [Field [ByteString]])
-> [Field [ByteString]]
forall a b. a -> (a -> b) -> b
(&) [Field [ByteString]]
x ([[Field [ByteString]] -> [Field [ByteString]]]
 -> [Field [ByteString]])
-> [[Field [ByteString]] -> [Field [ByteString]]]
-> [Field [ByteString]]
forall a b. (a -> b) -> a -> b
$ Config -> [(ByteString, ByteString, AddPolicy)]
addFields Config
cfg [(ByteString, ByteString, AddPolicy)]
-> ([(ByteString, ByteString, AddPolicy)]
    -> [[Field [ByteString]] -> [Field [ByteString]]])
-> [[Field [ByteString]] -> [Field [ByteString]]]
forall a b. a -> (a -> b) -> b
& ((ByteString, ByteString, AddPolicy)
 -> [Field [ByteString]] -> [Field [ByteString]])
-> [(ByteString, ByteString, AddPolicy)]
-> [[Field [ByteString]] -> [Field [ByteString]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ByteString
n, ByteString
v, AddPolicy
p) -> AddPolicy
-> Field [ByteString]
-> [Field [ByteString]]
-> [Field [ByteString]]
forall ann. AddPolicy -> Field ann -> [Field ann] -> [Field ann]
addField AddPolicy
p (Name [ByteString] -> [FieldLine [ByteString]] -> Field [ByteString]
forall ann. Name ann -> [FieldLine ann] -> Field ann
Field ([ByteString] -> ByteString -> Name [ByteString]
forall ann. ann -> ByteString -> Name ann
Name [] ByteString
n) [[ByteString] -> ByteString -> FieldLine [ByteString]
forall ann. ann -> ByteString -> FieldLine ann
FieldLine [] ByteString
v]))

-- | Add a field according to an AddPolicy.
addField :: AddPolicy -> Field ann -> [Field ann] -> [Field ann]
addField :: forall ann. AddPolicy -> Field ann -> [Field ann] -> [Field ann]
addField AddPolicy
p Field ann
f [Field ann]
fs = case AddPolicy
p of
  AddPolicy
AddReplace -> [Field ann]
notsames [Field ann] -> [Field ann] -> [Field ann]
forall a. Semigroup a => a -> a -> a
<> [Field ann
f]
  AddPolicy
AddAppend -> [Field ann]
fs [Field ann] -> [Field ann] -> [Field ann]
forall a. Semigroup a => a -> a -> a
<> [Field ann
f]
  AddPolicy
AddIfNotExisting -> [Field ann] -> [Field ann] -> Bool -> [Field ann]
forall a. a -> a -> Bool -> a
bool [Field ann]
fs ([Field ann]
fs [Field ann] -> [Field ann] -> [Field ann]
forall a. Semigroup a => a -> a -> a
<> [Field ann
f]) ([Field ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Field ann]
sames)
  where
    sames :: [Field ann]
sames = (Field ann -> Bool) -> [Field ann] -> [Field ann]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Optic' A_Lens '[] (Field ann) ByteString -> Field ann -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (Field ann) ByteString
forall ann. Lens' (Field ann) ByteString
fieldName' Field ann
f ==) (ByteString -> Bool)
-> (Field ann -> ByteString) -> Field ann -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens '[] (Field ann) ByteString -> Field ann -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (Field ann) ByteString
forall ann. Lens' (Field ann) ByteString
fieldName') [Field ann]
fs
    notsames :: [Field ann]
notsames = (Field ann -> Bool) -> [Field ann] -> [Field ann]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Optic' A_Lens '[] (Field ann) ByteString -> Field ann -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (Field ann) ByteString
forall ann. Lens' (Field ann) ByteString
fieldName' Field ann
f /=) (ByteString -> Bool)
-> (Field ann -> ByteString) -> Field ann -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens '[] (Field ann) ByteString -> Field ann -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (Field ann) ByteString
forall ann. Lens' (Field ann) ByteString
fieldName') [Field ann]
fs

-- | Align dependencies (if depAlignment is DepAligned), remove ranges for any self-dependency, and substitute preferred dependency ranges.
--
-- >>> fs & toListOf (section' "test-suite" % each % secFields' % field' "build-depends" % each) & fmap (fixBuildDeps cfg "minimal")
-- [Field (Name [] "build-depends") [FieldLine [] ", base    >=4.14 && <5",FieldLine [] ", minimal"]]
fixBuildDeps :: Config -> FieldName -> Field ann -> Field ann
fixBuildDeps :: forall ann. Config -> ByteString -> Field ann -> Field ann
fixBuildDeps Config
cfg ByteString
pname Field ann
f = (Field ann -> Field ann) -> Field ann -> Field ann
forall ann. (Field ann -> Field ann) -> Field ann -> Field ann
overField ((Field ann -> Field ann)
-> (Field ann -> Field ann) -> Bool -> Field ann -> Field ann
forall a. a -> a -> Bool -> a
bool Field ann -> Field ann
forall a. a -> a
id (Optic
  A_Lens '[] (Field ann) (Field ann) [FieldLine ann] [FieldLine ann]
-> ([FieldLine ann] -> [FieldLine ann]) -> Field ann -> Field ann
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens '[] (Field ann) (Field ann) [FieldLine ann] [FieldLine ann]
forall ann. Lens' (Field ann) [FieldLine ann]
fieldLines' (Config -> ByteString -> [FieldLine ann] -> [FieldLine ann]
forall ann.
Config -> ByteString -> [FieldLine ann] -> [FieldLine ann]
fixBDLines Config
cfg ByteString
pname)) (ByteString -> Field ann -> Bool
forall ann. ByteString -> Field ann -> Bool
isName ByteString
"build-depends" Field ann
f)) Field ann
f

fixBDLines :: Config -> ByteString -> [FieldLine ann] -> [FieldLine ann]
fixBDLines :: forall ann.
Config -> ByteString -> [FieldLine ann] -> [FieldLine ann]
fixBDLines Config
cfg ByteString
libdep [FieldLine ann]
fls = [FieldLine ann]
fls'
  where
    align :: DepAlignment
align = Config -> DepAlignment
depAlignment Config
cfg
    deps :: [Dep]
deps = [Dep
x | (Right Dep
x) <- FieldLine ann -> Either ByteString Dep
forall ann. FieldLine ann -> Either ByteString Dep
parseDepFL (FieldLine ann -> Either ByteString Dep)
-> [FieldLine ann] -> [Either ByteString Dep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldLine ann]
fls]
    pds :: [ByteString]
pds = CommaStyle -> CommaTrail -> [ByteString] -> [ByteString]
addCommaBS CommaStyle
commaStyle CommaTrail
trailStyle ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Config -> ByteString -> DepAlignment -> [Dep] -> [ByteString]
printDepsPreferred Config
cfg ByteString
libdep DepAlignment
align [Dep]
deps
    fls' :: [FieldLine ann]
fls' = (ByteString -> FieldLine ann -> FieldLine ann)
-> [ByteString] -> [FieldLine ann] -> [FieldLine ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Optic
  A_Lens '[] (FieldLine ann) (FieldLine ann) ByteString ByteString
-> ByteString -> FieldLine ann -> FieldLine ann
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens '[] (FieldLine ann) (FieldLine ann) ByteString ByteString
forall ann. Lens' (FieldLine ann) ByteString
fieldLine') [ByteString]
pds [FieldLine ann]
fls

    (CommaStyle
commaStyle, CommaTrail
trailStyle) =
      (CommaStyle, CommaTrail)
-> ((ByteString, CommaStyle, CommaTrail)
    -> (CommaStyle, CommaTrail))
-> Maybe (ByteString, CommaStyle, CommaTrail)
-> (CommaStyle, CommaTrail)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (CommaStyle
PostfixCommas, CommaTrail
NoTrailer)
        (\(ByteString
_, CommaStyle
x, CommaTrail
y) -> (CommaStyle
x, CommaTrail
y))
        (((ByteString, CommaStyle, CommaTrail) -> Bool)
-> [(ByteString, CommaStyle, CommaTrail)]
-> Maybe (ByteString, CommaStyle, CommaTrail)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"build-depends") (ByteString -> Bool)
-> ((ByteString, CommaStyle, CommaTrail) -> ByteString)
-> (ByteString, CommaStyle, CommaTrail)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(ByteString
x, CommaStyle
_, CommaTrail
_) -> ByteString
x)) (Config -> [(ByteString, CommaStyle, CommaTrail)]
fixCommas Config
cfg))

-- | Split of a dependency 'FieldLine' into the dependency name and the range.
data Dep = Dep {Dep -> ByteString
dep :: ByteString, Dep -> ByteString
depRange :: ByteString} deriving (Int -> Dep -> ShowS
[Dep] -> ShowS
Dep -> String
(Int -> Dep -> ShowS)
-> (Dep -> String) -> ([Dep] -> ShowS) -> Show Dep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dep -> ShowS
showsPrec :: Int -> Dep -> ShowS
$cshow :: Dep -> String
show :: Dep -> String
$cshowList :: [Dep] -> ShowS
showList :: [Dep] -> ShowS
Show, Eq Dep
Eq Dep =>
(Dep -> Dep -> Ordering)
-> (Dep -> Dep -> Bool)
-> (Dep -> Dep -> Bool)
-> (Dep -> Dep -> Bool)
-> (Dep -> Dep -> Bool)
-> (Dep -> Dep -> Dep)
-> (Dep -> Dep -> Dep)
-> Ord Dep
Dep -> Dep -> Bool
Dep -> Dep -> Ordering
Dep -> Dep -> Dep
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Dep -> Dep -> Ordering
compare :: Dep -> Dep -> Ordering
$c< :: Dep -> Dep -> Bool
< :: Dep -> Dep -> Bool
$c<= :: Dep -> Dep -> Bool
<= :: Dep -> Dep -> Bool
$c> :: Dep -> Dep -> Bool
> :: Dep -> Dep -> Bool
$c>= :: Dep -> Dep -> Bool
>= :: Dep -> Dep -> Bool
$cmax :: Dep -> Dep -> Dep
max :: Dep -> Dep -> Dep
$cmin :: Dep -> Dep -> Dep
min :: Dep -> Dep -> Dep
Ord, Dep -> Dep -> Bool
(Dep -> Dep -> Bool) -> (Dep -> Dep -> Bool) -> Eq Dep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dep -> Dep -> Bool
== :: Dep -> Dep -> Bool
$c/= :: Dep -> Dep -> Bool
/= :: Dep -> Dep -> Bool
Eq, (forall x. Dep -> Rep Dep x)
-> (forall x. Rep Dep x -> Dep) -> Generic Dep
forall x. Rep Dep x -> Dep
forall x. Dep -> Rep Dep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Dep -> Rep Dep x
from :: forall x. Dep -> Rep Dep x
$cto :: forall x. Rep Dep x -> Dep
to :: forall x. Rep Dep x -> Dep
Generic)

normDepRange :: ByteString -> ByteString
normDepRange :: ByteString -> ByteString
normDepRange ByteString
dr = (ByteString
-> (VersionRange -> ByteString) -> Maybe VersionRange -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
dr (String -> ByteString
C.pack (String -> ByteString)
-> (VersionRange -> String) -> VersionRange -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (VersionRange -> Doc) -> VersionRange -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRange -> Doc
forall a. Pretty a => a -> Doc
pretty) (Maybe VersionRange -> ByteString)
-> (ByteString -> Maybe VersionRange) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe VersionRange
forall a. Parsec a => ByteString -> Maybe a
simpleParsecBS :: ByteString -> Maybe VersionRange)) ByteString
dr

printDepPreferred :: Config -> ByteString -> Int -> Dep -> ByteString
printDepPreferred :: Config -> ByteString -> Int -> Dep -> ByteString
printDepPreferred Config
cfg ByteString
libd Int
n (Dep ByteString
d ByteString
r) = ByteString -> [ByteString] -> ByteString
C.intercalate (String -> ByteString
C.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' ') ([ByteString
d] [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
rs)
  where
    r' :: ByteString
r' = ByteString -> ByteString -> Bool -> ByteString
forall a. a -> a -> Bool -> a
bool (ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe (ByteString -> ByteString
normDepRange ByteString
r) (ByteString -> Map ByteString ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
d ([(ByteString, ByteString)] -> Map ByteString ByteString
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Config -> [(ByteString, ByteString)]
preferredDeps Config
cfg)))) (ByteString -> ByteString
normDepRange ByteString
r) (ByteString
libd ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
d)
    rs :: [ByteString]
rs = [ByteString] -> [ByteString] -> Bool -> [ByteString]
forall a. a -> a -> Bool -> a
bool [ByteString
r'] [] (ByteString
r' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"")

printDepsPreferred :: Config -> ByteString -> DepAlignment -> [Dep] -> [ByteString]
printDepsPreferred :: Config -> ByteString -> DepAlignment -> [Dep] -> [ByteString]
printDepsPreferred Config
cfg ByteString
libd DepAlignment
DepUnaligned [Dep]
ds = Config -> ByteString -> Int -> Dep -> ByteString
printDepPreferred Config
cfg ByteString
libd Int
1 (Dep -> ByteString) -> [Dep] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dep]
ds
printDepsPreferred Config
cfg ByteString
libd DepAlignment
DepAligned [Dep]
ds = (Int -> Dep -> ByteString) -> [Int] -> [Dep] -> [ByteString]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Config -> ByteString -> Int -> Dep -> ByteString
printDepPreferred Config
cfg ByteString
libd) [Int]
ns [Dep]
ds
  where
    ls :: [Int]
ls = ByteString -> Int
BS.length (ByteString -> Int) -> (Dep -> ByteString) -> Dep -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dep -> ByteString
dep (Dep -> Int) -> [Dep] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dep]
ds
    ns :: [Int]
ns = (\Int
x -> [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
ls

parseDepFL :: FieldLine ann -> Either ByteString Dep
parseDepFL :: forall ann. FieldLine ann -> Either ByteString Dep
parseDepFL FieldLine ann
fl = (ByteString -> ByteString -> Dep)
-> (ByteString, ByteString) -> Dep
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Dep
Dep ((ByteString, ByteString) -> Dep)
-> Either ByteString (ByteString, ByteString)
-> Either ByteString Dep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (ByteString, ByteString)
-> ByteString -> Either ByteString (ByteString, ByteString)
forall e a. IsString e => Parser e a -> ByteString -> Either e a
runParserEither Parser ByteString (ByteString, ByteString)
forall e. Parser e (ByteString, ByteString)
depP (Optic' A_Lens '[] (FieldLine ann) ByteString
-> FieldLine ann -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (FieldLine ann) ByteString
forall ann. Lens' (FieldLine ann) ByteString
fieldLine' FieldLine ann
fl)

-- | sort field lines for listed fields
sortFieldLinesFor :: [ByteString] -> Field ann -> Field ann
sortFieldLinesFor :: forall ann. [ByteString] -> Field ann -> Field ann
sortFieldLinesFor [ByteString]
ns f :: Field ann
f@(Field Name ann
n [FieldLine ann]
fl) =
  Name ann -> [FieldLine ann] -> Field ann
forall ann. Name ann -> [FieldLine ann] -> Field ann
Field Name ann
n ([FieldLine ann] -> [FieldLine ann] -> Bool -> [FieldLine ann]
forall a. a -> a -> Bool -> a
bool [FieldLine ann]
fl ((FieldLine ann -> ByteString) -> [FieldLine ann] -> [FieldLine ann]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn FieldLine ann -> ByteString
forall ann. FieldLine ann -> ByteString
fieldLineBS [FieldLine ann]
fl) (Optic' A_Lens '[] (Field ann) ByteString -> Field ann -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (Field ann) ByteString
forall ann. Lens' (Field ann) ByteString
fieldName' Field ann
f ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
ns))
sortFieldLinesFor [ByteString]
ns (Section Name ann
n [SectionArg ann]
a [Field ann]
fss) = Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section Name ann
n [SectionArg ann]
a ([ByteString] -> Field ann -> Field ann
forall ann. [ByteString] -> Field ann -> Field ann
sortFieldLinesFor [ByteString]
ns (Field ann -> Field ann) -> [Field ann] -> [Field ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field ann]
fss)

-- | sorting fields, based on fieldOrdering configuration.
--
-- A secondary ordering is based on the first fieldline (for fields) or section args (for sections).
sortFields :: Config -> [Field ann] -> [Field ann]
sortFields :: forall ann. Config -> [Field ann] -> [Field ann]
sortFields Config
cfg [Field ann]
fs = ([Field ann] -> [Field ann]) -> [Field ann] -> [Field ann]
forall ann.
([Field ann] -> [Field ann]) -> [Field ann] -> [Field ann]
overFields ((Field ann -> (Double, Maybe ByteString))
-> [Field ann] -> [Field ann]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (\Field ann
f -> (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
100 (ByteString -> Map ByteString Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Optic' A_Lens '[] (Field ann) ByteString -> Field ann -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (Field ann) ByteString
forall ann. Lens' (Field ann) ByteString
fieldName' Field ann
f) ([(ByteString, Double)] -> Map ByteString Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ByteString, Double)] -> Map ByteString Double)
-> [(ByteString, Double)] -> Map ByteString Double
forall a b. (a -> b) -> a -> b
$ Config -> [(ByteString, Double)]
fieldOrdering Config
cfg)), Field ann -> Maybe ByteString
forall ann. Field ann -> Maybe ByteString
name2 Field ann
f))) [Field ann]
fs

name2 :: Field ann -> Maybe ByteString
name2 :: forall ann. Field ann -> Maybe ByteString
name2 (Field Name ann
_ [FieldLine ann]
fl) = [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe (FieldLine ann -> ByteString
forall ann. FieldLine ann -> ByteString
fieldLineBS (FieldLine ann -> ByteString) -> [FieldLine ann] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldLine ann]
fl)
name2 (Section Name ann
_ [SectionArg ann]
a [Field ann]
_) = [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe ([ByteString] -> Maybe ByteString)
-> [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (SectionArg ann -> (ByteString, ByteString))
-> SectionArg ann
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens '[] (SectionArg ann) (ByteString, ByteString)
-> SectionArg ann -> (ByteString, ByteString)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] (SectionArg ann) (ByteString, ByteString)
forall ann. Lens' (SectionArg ann) (ByteString, ByteString)
secArgBS' (SectionArg ann -> ByteString) -> [SectionArg ann] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SectionArg ann]
a

-- | Printing
--
-- Convert a 'CabalFields' to a 'ByteString'
--
-- >>> printCabalFields cfg (cf & over (#fields % fieldList') (take 4)) & C.putStr
-- cabal-version: 3.0
-- name: minimal
-- version: 0.1.0.0
-- license: BSD-2-Clause
printCabalFields :: Config -> CabalFields -> ByteString
printCabalFields :: Config -> CabalFields -> ByteString
printCabalFields Config
cfg CabalFields
cf =
  ( String -> ByteString
C.pack
      (String -> ByteString)
-> ([Field [ByteString]] -> String)
-> [Field [ByteString]]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config
-> ([String] -> CommentPosition)
-> ([String] -> [String] -> [String])
-> Int
-> [PrettyField [String]]
-> String
forall ann.
Config
-> (ann -> CommentPosition)
-> (ann -> [String] -> [String])
-> Int
-> [PrettyField ann]
-> String
showFieldsIndent Config
cfg [String] -> CommentPosition
fComment (([String] -> [String]) -> [String] -> [String] -> [String]
forall a b. a -> b -> a
const [String] -> [String]
forall a. a -> a
id) (Config -> Int
indentN Config
cfg)
      ([PrettyField [String]] -> String)
-> ([Field [ByteString]] -> [PrettyField [String]])
-> [Field [ByteString]]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrettyField [ByteString] -> PrettyField [String])
-> [PrettyField [ByteString]] -> [PrettyField [String]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([ByteString] -> [String])
-> PrettyField [ByteString] -> PrettyField [String]
forall a b. (a -> b) -> PrettyField a -> PrettyField b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
C.unpack))
      ([PrettyField [ByteString]] -> [PrettyField [String]])
-> ([Field [ByteString]] -> [PrettyField [ByteString]])
-> [Field [ByteString]]
-> [PrettyField [String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Field [ByteString]] -> [PrettyField [ByteString]]
printFieldsComments
      ([Field [ByteString]] -> ByteString)
-> [Field [ByteString]] -> ByteString
forall a b. (a -> b) -> a -> b
$ Optic
  A_Lens
  '[]
  CabalFields
  CabalFields
  [Field [ByteString]]
  [Field [ByteString]]
-> CabalFields -> [Field [ByteString]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
#fields Optic' A_Lens '[] CabalFields (Vector (Field [ByteString]))
-> Iso' (Vector (Field [ByteString])) [Field [ByteString]]
-> Optic
     A_Lens
     '[]
     CabalFields
     CabalFields
     [Field [ByteString]]
     [Field [ByteString]]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Iso' (Vector (Field [ByteString])) [Field [ByteString]]
fieldList') CabalFields
cf
  )
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> ByteString
C.unlines (Optic' A_Lens '[] CabalFields [ByteString]
-> CabalFields -> [ByteString]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] CabalFields [ByteString]
#endComment CabalFields
cf)
  where
    fComment :: [String] -> CommentPosition
fComment [] = CommentPosition
NoComment
    fComment [String]
xs = [String] -> CommentPosition
CommentBefore [String]
xs

printFieldsComments :: [Field [ByteString]] -> [PrettyField [ByteString]]
printFieldsComments :: [Field [ByteString]] -> [PrettyField [ByteString]]
printFieldsComments =
  Identity [PrettyField [ByteString]] -> [PrettyField [ByteString]]
forall a. Identity a -> a
runIdentity
    (Identity [PrettyField [ByteString]] -> [PrettyField [ByteString]])
-> ([Field [ByteString]] -> Identity [PrettyField [ByteString]])
-> [Field [ByteString]]
-> [PrettyField [ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [FieldLine [ByteString]] -> Identity Doc)
-> (ByteString -> [SectionArg [ByteString]] -> Identity [Doc])
-> [Field [ByteString]]
-> Identity [PrettyField [ByteString]]
forall (f :: * -> *) ann.
Applicative f =>
(ByteString -> [FieldLine ann] -> f Doc)
-> (ByteString -> [SectionArg ann] -> f [Doc])
-> [Field ann]
-> f [PrettyField ann]
genericFromParsecFields
      (Doc -> Identity Doc
forall a. a -> Identity a
Identity (Doc -> Identity Doc)
-> (ByteString -> [FieldLine [ByteString]] -> Doc)
-> ByteString
-> [FieldLine [ByteString]]
-> Identity Doc
forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
.: ByteString -> [FieldLine [ByteString]] -> Doc
prettyFieldLines)
      ([Doc] -> Identity [Doc]
forall a. a -> Identity a
Identity ([Doc] -> Identity [Doc])
-> (ByteString -> [SectionArg [ByteString]] -> [Doc])
-> ByteString
-> [SectionArg [ByteString]]
-> Identity [Doc]
forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
.: ByteString -> [SectionArg [ByteString]] -> [Doc]
prettySectionArgs)
  where
    (.:) :: (a -> b) -> (c -> d -> a) -> (c -> d -> b)
    (a -> b
f .: :: forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
.: c -> d -> a
g) c
x d
y = a -> b
f (c -> d -> a
g c
x d
y)

-- | Used in 'fromParsecFields'.
prettyFieldLines :: FieldName -> [FieldLine [ByteString]] -> PP.Doc
prettyFieldLines :: ByteString -> [FieldLine [ByteString]] -> Doc
prettyFieldLines ByteString
_ [FieldLine [ByteString]]
fls =
  [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
    [[Doc]] -> [Doc]
forall a. Monoid a => [a] -> a
mconcat ([[Doc]] -> [Doc]) -> [[Doc]] -> [Doc]
forall a b. (a -> b) -> a -> b
$
      [ String -> Doc
PP.text (String -> Doc) -> (ByteString -> String) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
fromUTF8BS (ByteString -> Doc) -> [ByteString] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
cs [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString
bs]
        | FieldLine [ByteString]
cs ByteString
bs <- [FieldLine [ByteString]]
fls
      ]

-- | Used in 'fromParsecFields'.
prettySectionArgs :: FieldName -> [SectionArg [ByteString]] -> [PP.Doc]
prettySectionArgs :: ByteString -> [SectionArg [ByteString]] -> [Doc]
prettySectionArgs ByteString
_ =
  (SectionArg [ByteString] -> Doc)
-> [SectionArg [ByteString]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SectionArg [ByteString] -> Doc)
 -> [SectionArg [ByteString]] -> [Doc])
-> (SectionArg [ByteString] -> Doc)
-> [SectionArg [ByteString]]
-> [Doc]
forall a b. (a -> b) -> a -> b
$
    [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc)
-> (SectionArg [ByteString] -> [Doc])
-> SectionArg [ByteString]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      SecArgName [ByteString]
cs ByteString
bs -> String -> Doc
showToken (String -> Doc) -> (ByteString -> String) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
fromUTF8BS (ByteString -> Doc) -> [ByteString] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
cs [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString
bs]
      SecArgStr [ByteString]
cs ByteString
bs -> String -> Doc
showToken (String -> Doc) -> (ByteString -> String) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
fromUTF8BS (ByteString -> Doc) -> [ByteString] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
cs [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString
bs]
      SecArgOther [ByteString]
cs ByteString
bs -> String -> Doc
PP.text (String -> Doc) -> (ByteString -> String) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
fromUTF8BS (ByteString -> Doc) -> [ByteString] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
cs [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString
bs]

-- | 'showFields' with user specified indentation.
showFieldsIndent ::
  Config ->
  -- | Convert an annotation to lined to preceed the field or section.
  (ann -> CommentPosition) ->
  -- | Post-process non-annotation produced lines.
  (ann -> [String] -> [String]) ->
  -- | Indentation level.
  Int ->
  -- | Fields/sections to show.
  [PrettyField ann] ->
  String
showFieldsIndent :: forall ann.
Config
-> (ann -> CommentPosition)
-> (ann -> [String] -> [String])
-> Int
-> [PrettyField ann]
-> String
showFieldsIndent Config
cfg ann -> CommentPosition
rann ann -> [String] -> [String]
post Int
n = [String] -> String
unlines ([String] -> String)
-> ([PrettyField ann] -> [String]) -> [PrettyField ann] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Opts ann -> [PrettyField ann] -> [String]
forall ann. Config -> Opts ann -> [PrettyField ann] -> [String]
renderFields Config
cfg ((ann -> CommentPosition)
-> ShowS -> (ann -> [String] -> [String]) -> Opts ann
forall ann.
(ann -> CommentPosition)
-> ShowS -> (ann -> [String] -> [String]) -> Opts ann
Opts ann -> CommentPosition
rann ShowS
indent ann -> [String] -> [String]
post)
  where
    -- few hardcoded, "unrolled"  variants.
    indent :: ShowS
indent
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = ShowS
indent4
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = ShowS
indent2
      | Bool
otherwise = (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1) Char
' ' ++)

    indent4 :: String -> String
    indent4 :: ShowS
indent4 [] = []
    indent4 String
xs = Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

    indent2 :: String -> String
    indent2 :: ShowS
indent2 [] = []
    indent2 String
xs = Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

data Opts ann = Opts
  { forall ann. Opts ann -> ann -> CommentPosition
_optAnnotation :: ann -> CommentPosition,
    forall ann. Opts ann -> ShowS
_optIndent :: String -> String,
    forall ann. Opts ann -> ann -> [String] -> [String]
_optPostprocess :: ann -> [String] -> [String]
  }

renderFields :: Config -> Opts ann -> [PrettyField ann] -> [String]
renderFields :: forall ann. Config -> Opts ann -> [PrettyField ann] -> [String]
renderFields Config
cfg Opts ann
opts [PrettyField ann]
fields = [Block] -> [String]
flattenBlocks [Block]
blocks
  where
    len :: Int
len = Int -> [PrettyField ann] -> Int
forall {ann}. Int -> [PrettyField ann] -> Int
maxNameLength Int
0 [PrettyField ann]
fields
    blocks :: [Block]
blocks =
      (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> (Block -> [String]) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [String]
_contentsBlock) ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ -- empty blocks cause extra newlines #8236
        (PrettyField ann -> Block) -> [PrettyField ann] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map (Config -> Opts ann -> Int -> PrettyField ann -> Block
forall ann. Config -> Opts ann -> Int -> PrettyField ann -> Block
renderField Config
cfg Opts ann
opts Int
len) [PrettyField ann]
fields

    maxNameLength :: Int -> [PrettyField ann] -> Int
maxNameLength !Int
acc [] = Int
acc
    maxNameLength !Int
acc (PrettyField ann
_ ByteString
name Doc
_ : [PrettyField ann]
rest) = Int -> [PrettyField ann] -> Int
maxNameLength (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
acc (ByteString -> Int
BS.length ByteString
name)) [PrettyField ann]
rest
    maxNameLength !Int
acc (PrettySection {} : [PrettyField ann]
rest) = Int -> [PrettyField ann] -> Int
maxNameLength Int
acc [PrettyField ann]
rest
    maxNameLength !Int
acc (PrettyField ann
PrettyEmpty : [PrettyField ann]
rest) = Int -> [PrettyField ann] -> Int
maxNameLength Int
acc [PrettyField ann]
rest

-- | Block of lines with flags for optional blank lines before and after
data Block = Block
  { Block -> Margin
_beforeBlock :: Margin,
    Block -> Margin
_afterBlock :: Margin,
    Block -> [String]
_contentsBlock :: [String]
  }
  deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Block -> ShowS
showsPrec :: Int -> Block -> ShowS
$cshow :: Block -> String
show :: Block -> String
$cshowList :: [Block] -> ShowS
showList :: [Block] -> ShowS
Show, Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
/= :: Block -> Block -> Bool
Eq, ReadPrec [Block]
ReadPrec Block
Int -> ReadS Block
ReadS [Block]
(Int -> ReadS Block)
-> ReadS [Block]
-> ReadPrec Block
-> ReadPrec [Block]
-> Read Block
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Block
readsPrec :: Int -> ReadS Block
$creadList :: ReadS [Block]
readList :: ReadS [Block]
$creadPrec :: ReadPrec Block
readPrec :: ReadPrec Block
$creadListPrec :: ReadPrec [Block]
readListPrec :: ReadPrec [Block]
Read, (forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Block -> Rep Block x
from :: forall x. Block -> Rep Block x
$cto :: forall x. Rep Block x -> Block
to :: forall x. Rep Block x -> Block
Generic)

flattenBlocks :: [Block] -> [String]
flattenBlocks :: [Block] -> [String]
flattenBlocks = [Block] -> [String]
go0
  where
    go0 :: [Block] -> [String]
go0 [] = []
    go0 (Block Margin
_before Margin
after [String]
strs : [Block]
blocks) = [String]
strs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Margin -> [Block] -> [String]
go Margin
after [Block]
blocks

    go :: Margin -> [Block] -> [String]
go Margin
_surr' [] = []
    go Margin
surr' (Block Margin
before Margin
after [String]
strs : [Block]
blocks) = [String] -> [String]
ins ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
strs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Margin -> [Block] -> [String]
go Margin
after [Block]
blocks
      where
        ins :: [String] -> [String]
ins
          | Margin
surr' Margin -> Margin -> Margin
forall a. Semigroup a => a -> a -> a
<> Margin
before Margin -> Margin -> Bool
forall a. Eq a => a -> a -> Bool
== Margin
Margin = (String
"" :)
          | Bool
otherwise = [String] -> [String]
forall a. a -> a
id

lines_ :: String -> [String]
lines_ :: String -> [String]
lines_ [] = []
lines_ String
s = String -> [String]
lines String
s [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String] -> [String] -> Bool -> [String]
forall a. a -> a -> Bool -> a
bool [] [String
""] ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. HasCallStack => [a] -> a
last (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
s)

renderField :: Config -> Opts ann -> Int -> PrettyField ann -> Block
renderField :: forall ann. Config -> Opts ann -> Int -> PrettyField ann -> Block
renderField Config
cfg (Opts ann -> CommentPosition
rann ShowS
indent ann -> [String] -> [String]
post) Int
fw (PrettyField ann
ann ByteString
name Doc
doc) =
  Margin -> Margin -> [String] -> Block
Block Margin
before Margin
after [String]
content
  where
    content :: [String]
content = case CommentPosition
comments of
      CommentBefore [String]
cs -> [String]
cs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ann -> [String] -> [String]
post ann
ann [String]
lines'
      CommentAfter [String]
cs -> ann -> [String] -> [String]
post ann
ann [String]
lines' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
cs
      CommentPosition
NoComment -> ann -> [String] -> [String]
post ann
ann [String]
lines'
    comments :: CommentPosition
comments = ann -> CommentPosition
rann ann
ann
    before :: Margin
before = case CommentPosition
comments of
      CommentBefore [] -> Margin
NoMargin
      CommentAfter [] -> Margin
NoMargin
      CommentPosition
NoComment -> Margin
NoMargin
      CommentPosition
_ -> Config -> Margin
commentMargin Config
cfg

    ([String]
lines', Margin
after) = case String -> [String]
lines_ String
narrow of
      [] -> ([String
name' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":"], Margin
NoMargin)
      [String
singleLine]
        | String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
singleLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Config -> Int
narrowN Config
cfg ->
            ([String
name' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 (Int
fw Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
name' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Config -> Int
valueAlignGap Config
cfg Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Config -> ValueAlignment
valueAligned Config
cfg ValueAlignment -> ValueAlignment -> Bool
forall a. Eq a => a -> a -> Bool
== ValueAlignment
ValueAligned)) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
narrow], Margin
NoMargin)
      [String]
_ -> ((String
name' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
indent (String -> [String]
lines_ (Doc -> String
PP.render Doc
doc)), Margin
NoMargin)

    name' :: String
name' = ByteString -> String
fromUTF8BS ByteString
name
    narrow :: String
narrow = Style -> Doc -> String
PP.renderStyle Style
narrowStyle Doc
doc

    narrowStyle :: PP.Style
    narrowStyle :: Style
narrowStyle = Style
PP.style {PP.lineLength = PP.lineLength PP.style - fw}
renderField Config
cfg opts :: Opts ann
opts@(Opts ann -> CommentPosition
rann ShowS
indent ann -> [String] -> [String]
post) Int
_ (PrettySection ann
ann ByteString
name [Doc]
args [PrettyField ann]
fields) =
  Margin -> Margin -> [String] -> Block
Block (Config -> Margin
sectionMargin Config
cfg) (Config -> Margin
sectionMargin Config
cfg) ([String] -> Block) -> [String] -> Block
forall a b. (a -> b) -> a -> b
$
    [String] -> [String]
attachComments
      (ann -> [String] -> [String]
post ann
ann [Doc -> String
PP.render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
PP.hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text (ByteString -> String
fromUTF8BS ByteString
name) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
args])
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
indent (Config -> Opts ann -> [PrettyField ann] -> [String]
forall ann. Config -> Opts ann -> [PrettyField ann] -> [String]
renderFields Config
cfg Opts ann
opts [PrettyField ann]
fields)
  where
    attachComments :: [String] -> [String]
attachComments [String]
content = case ann -> CommentPosition
rann ann
ann of
      CommentBefore [String]
cs -> [String]
cs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
content
      CommentAfter [String]
cs -> [String]
content [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
cs
      CommentPosition
NoComment -> [String]
content
renderField Config
_ Opts ann
_ Int
_ PrettyField ann
PrettyEmpty = Margin -> Margin -> [String] -> Block
Block Margin
NoMargin Margin
NoMargin [String]
forall a. Monoid a => a
mempty

-- | Parse a 'ByteString' into a 'CabalFields'. Failure is possible.
--
-- >>> bs & C.lines & take 4 & C.unlines & parseCabalFields cfg
-- Right (CabalFields {fields = [Field (Name [] "cabal-version") [FieldLine [] "3.0"],Field (Name [] "name") [FieldLine [] "minimal"],Field (Name [] "version") [FieldLine [] "0.1.0.0"],Field (Name [] "license") [FieldLine [] "BSD-2-Clause"]], endComment = []})
parseCabalFields :: Config -> ByteString -> Either ByteString CabalFields
parseCabalFields :: Config -> ByteString -> Either ByteString CabalFields
parseCabalFields Config
cfg ByteString
bs = case ByteString -> Either ParseError [Field Position]
readFields ByteString
bs of
  Left ParseError
err -> ByteString -> Either ByteString CabalFields
forall a b. a -> Either a b
Left (ByteString -> Either ByteString CabalFields)
-> ByteString -> Either ByteString CabalFields
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C.pack (ParseError -> String
forall a. Show a => a -> String
show ParseError
err)
  Right [Field Position]
fps ->
    (\([Field [ByteString]]
fs, [ByteString]
ec) -> CabalFields -> Either ByteString CabalFields
forall a b. b -> Either a b
Right (Vector (Field [ByteString]) -> [ByteString] -> CabalFields
CabalFields ([Field [ByteString]] -> Vector (Field [ByteString])
forall a. [a] -> Vector a
V.fromList [Field [ByteString]]
fs) [ByteString]
ec)) (([Field [ByteString]], [ByteString])
 -> Either ByteString CabalFields)
-> ([Field [ByteString]], [ByteString])
-> Either ByteString CabalFields
forall a b. (a -> b) -> a -> b
$
      (([Field [ByteString]], [ByteString])
 -> (([Field [ByteString]], [ByteString])
     -> ([Field [ByteString]], [ByteString]))
 -> ([Field [ByteString]], [ByteString]))
-> ([Field [ByteString]], [ByteString])
-> [([Field [ByteString]], [ByteString])
    -> ([Field [ByteString]], [ByteString])]
-> ([Field [ByteString]], [ByteString])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Field [ByteString]], [ByteString])
-> (([Field [ByteString]], [ByteString])
    -> ([Field [ByteString]], [ByteString]))
-> ([Field [ByteString]], [ByteString])
forall a b. a -> (a -> b) -> b
(&) ((Field Position -> Field [ByteString])
-> [Field Position] -> [Field [ByteString]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Position -> [ByteString]) -> Field Position -> Field [ByteString]
forall a b. (a -> b) -> Field a -> Field b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ByteString] -> Position -> [ByteString]
forall a b. a -> b -> a
const [])) [Field Position]
fs, []) ((Maybe ([Int], String)
 -> [ByteString]
 -> ([Field [ByteString]], [ByteString])
 -> ([Field [ByteString]], [ByteString]))
-> (Maybe ([Int], String), [ByteString])
-> ([Field [ByteString]], [ByteString])
-> ([Field [ByteString]], [ByteString])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe ([Int], String)
-> [ByteString]
-> ([Field [ByteString]], [ByteString])
-> ([Field [ByteString]], [ByteString])
addComment ((Maybe ([Int], String), [ByteString])
 -> ([Field [ByteString]], [ByteString])
 -> ([Field [ByteString]], [ByteString]))
-> [(Maybe ([Int], String), [ByteString])]
-> [([Field [ByteString]], [ByteString])
    -> ([Field [ByteString]], [ByteString])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe ([Int], String), [ByteString])]
cfs)
    where
      fs :: [Field Position]
fs = [ByteString] -> [Field Position] -> [Field Position]
convertFreeTexts (Optic' A_Lens '[] Config [ByteString] -> Config -> [ByteString]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] Config [ByteString]
#freeTexts Config
cfg) [Field Position]
fps
      cs :: [(Int, [ByteString])]
cs = ByteString -> [(Int, [ByteString])]
extractComments ByteString
bs
      pt :: [(Int, ([Int], String))]
pt = Map Int ([Int], String) -> [(Int, ([Int], String))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Int ([Int], String) -> [(Int, ([Int], String))])
-> Map Int ([Int], String) -> [(Int, ([Int], String))]
forall a b. (a -> b) -> a -> b
$ [Field Position] -> Map Int ([Int], String)
makePositionTree [Field Position]
fs
      cfs :: [(Maybe ([Int], String), [ByteString])]
cfs = ((Maybe (Int, ([Int], String)), [ByteString])
 -> (Maybe ([Int], String), [ByteString]))
-> [(Maybe (Int, ([Int], String)), [ByteString])]
-> [(Maybe ([Int], String), [ByteString])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (Int, ([Int], String)) -> Maybe ([Int], String))
-> (Maybe (Int, ([Int], String)), [ByteString])
-> (Maybe ([Int], String), [ByteString])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (((Int, ([Int], String)) -> ([Int], String))
-> Maybe (Int, ([Int], String)) -> Maybe ([Int], String)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, ([Int], String)) -> ([Int], String)
forall a b. (a, b) -> b
snd)) ((Int -> Maybe (Int, ([Int], String)))
-> (Int, [ByteString])
-> (Maybe (Int, ([Int], String)), [ByteString])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Int -> (Int, ([Int], String)))
-> Maybe Int -> Maybe (Int, ([Int], String))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Int, ([Int], String))]
pt List.!!) (Maybe Int -> Maybe (Int, ([Int], String)))
-> (Int -> Maybe Int) -> Int -> Maybe (Int, ([Int], String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x -> ((Int, ([Int], String)) -> Bool)
-> [(Int, ([Int], String))] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
List.findIndex (\(Int, ([Int], String))
e -> (Int, ([Int], String)) -> Int
forall a b. (a, b) -> a
fst (Int, ([Int], String))
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
x) [(Int, ([Int], String))]
pt)) ((Int, [ByteString])
 -> (Maybe (Int, ([Int], String)), [ByteString]))
-> [(Int, [ByteString])]
-> [(Maybe (Int, ([Int], String)), [ByteString])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, [ByteString])]
cs)

convertFreeText :: [ByteString] -> Field Position -> Field Position
convertFreeText :: [ByteString] -> Field Position -> Field Position
convertFreeText [ByteString]
freeTexts f :: Field Position
f@(Field Name Position
n [FieldLine Position]
fls) = Field Position -> Field Position -> Bool -> Field Position
forall a. a -> a -> Bool -> a
bool Field Position
f (Name Position -> [FieldLine Position] -> Field Position
forall ann. Name ann -> [FieldLine ann] -> Field ann
Field Name Position
n ([FieldLine Position] -> [FieldLine Position]
convertToFreeText [FieldLine Position]
fls)) ([ByteString] -> Field Position -> Bool
forall ann. [ByteString] -> Field ann -> Bool
inNameList [ByteString]
freeTexts Field Position
f)
convertFreeText [ByteString]
freeTexts (Section Name Position
n [SectionArg Position]
a [Field Position]
fss) = Name Position
-> [SectionArg Position] -> [Field Position] -> Field Position
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section Name Position
n [SectionArg Position]
a ([ByteString] -> [Field Position] -> [Field Position]
convertFreeTexts [ByteString]
freeTexts [Field Position]
fss)

convertFreeTexts :: [ByteString] -> [Field Position] -> [Field Position]
convertFreeTexts :: [ByteString] -> [Field Position] -> [Field Position]
convertFreeTexts [ByteString]
freeTexts [Field Position]
fs = (Maybe (Field Position), [Field Position]) -> [Field Position]
forall a b. (a, b) -> b
snd ((Maybe (Field Position), [Field Position]) -> [Field Position])
-> (Maybe (Field Position), [Field Position]) -> [Field Position]
forall a b. (a -> b) -> a -> b
$ ((Maybe (Field Position), [Field Position])
 -> Field Position -> (Maybe (Field Position), [Field Position]))
-> (Maybe (Field Position), [Field Position])
-> [Field Position]
-> (Maybe (Field Position), [Field Position])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Maybe (Field Position), [Field Position])
-> Field Position -> (Maybe (Field Position), [Field Position])
step (Maybe (Field Position)
forall a. Maybe a
Nothing, []) [Field Position]
fs
  where
    step :: (Maybe (Field Position), [Field Position]) -> Field Position -> (Maybe (Field Position), [Field Position])
    step :: (Maybe (Field Position), [Field Position])
-> Field Position -> (Maybe (Field Position), [Field Position])
step (Maybe (Field Position)
Nothing, [Field Position]
res) Field Position
nextFP = case [ByteString] -> Field Position -> Bool
forall ann. [ByteString] -> Field ann -> Bool
inNameList [ByteString]
freeTexts Field Position
nextFP of
      Bool
True -> (Field Position -> Maybe (Field Position)
forall a. a -> Maybe a
Just ([ByteString] -> Field Position -> Field Position
convertFreeText [ByteString]
freeTexts Field Position
nextFP), [Field Position]
res)
      Bool
False -> (Maybe (Field Position)
forall a. Maybe a
Nothing, [Field Position]
res [Field Position] -> [Field Position] -> [Field Position]
forall a. Semigroup a => a -> a -> a
<> [Field Position
nextFP])
    step (Just Field Position
freeFP, [Field Position]
res) Field Position
nextFP = case [ByteString] -> Field Position -> Bool
forall ann. [ByteString] -> Field ann -> Bool
inNameList [ByteString]
freeTexts Field Position
nextFP of
      Bool
True -> (Field Position -> Maybe (Field Position)
forall a. a -> Maybe a
Just ([ByteString] -> Field Position -> Field Position
convertFreeText [ByteString]
freeTexts Field Position
nextFP), [Field Position]
res [Field Position] -> [Field Position] -> [Field Position]
forall a. Semigroup a => a -> a -> a
<> [Field Position
freeFP'])
      Bool
False -> (Maybe (Field Position)
forall a. Maybe a
Nothing, [Field Position]
res [Field Position] -> [Field Position] -> [Field Position]
forall a. Semigroup a => a -> a -> a
<> [Field Position
freeFP', Field Position
nextFP])
      where
        (Field Name Position
n [FieldLine Position]
fls) = Field Position
freeFP
        c1 :: Int
c1 = Field Position -> Int
firstCol Field Position
nextFP
        c0 :: Int
c0 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
c1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Field Position -> Maybe Int
firstColFls Field Position
freeFP
        (FieldLine Position
ann ByteString
fls') = FieldLine Position
-> Maybe (FieldLine Position) -> FieldLine Position
forall a. a -> Maybe a -> a
fromMaybe (Position -> ByteString -> FieldLine Position
forall ann. ann -> ByteString -> FieldLine ann
FieldLine (Int -> Int -> Position
Position Int
0 Int
0) ByteString
"") ([FieldLine Position] -> Maybe (FieldLine Position)
forall a. [a] -> Maybe a
listToMaybe [FieldLine Position]
fls)
        freeFP' :: Field Position
freeFP' = Name Position -> [FieldLine Position] -> Field Position
forall ann. Name ann -> [FieldLine ann] -> Field ann
Field Name Position
n [Position -> ByteString -> FieldLine Position
forall ann. ann -> ByteString -> FieldLine ann
FieldLine Position
ann (ByteString
fls' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
C.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ByteString -> [ByteString]
C.lines ByteString
fls')) Char
'\n'))]

firstCol :: Field Position -> Int
firstCol :: Field Position -> Int
firstCol (Field (Name (Position Int
c Int
_) ByteString
_) [FieldLine Position]
_) = Int
c
firstCol (Section (Name (Position Int
c Int
_) ByteString
_) [SectionArg Position]
_ [Field Position]
_) = Int
c

firstColFls :: Field Position -> Maybe Int
firstColFls :: Field Position -> Maybe Int
firstColFls (Field Name Position
_ []) = Maybe Int
forall a. Maybe a
Nothing
firstColFls (Field Name Position
_ ((FieldLine (Position Int
c Int
_) ByteString
_) : [FieldLine Position]
_)) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
c
firstColFls (Section {}) = String -> Maybe Int
forall a. HasCallStack => String -> a
error String
"no field lines in a section"

convertToFreeText :: [FieldLine Position] -> [FieldLine Position]
convertToFreeText :: [FieldLine Position] -> [FieldLine Position]
convertToFreeText [] = []
convertToFreeText ((FieldLine (Position Int
r0 Int
c0) ByteString
bs0) : [FieldLine Position]
xs) = [Position -> ByteString -> FieldLine Position
forall ann. ann -> ByteString -> FieldLine ann
FieldLine (Int -> Int -> Position
Position Int
r0 Int
c0) ByteString
x]
  where
    x :: ByteString
x = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int, [ByteString]) -> [ByteString]
forall a b. (a, b) -> b
snd ((Int, [ByteString]) -> [ByteString])
-> (Int, [ByteString]) -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ((Int, [ByteString]) -> FieldLine Position -> (Int, [ByteString]))
-> (Int, [ByteString])
-> [FieldLine Position]
-> (Int, [ByteString])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(Int
r', [ByteString]
xs') (FieldLine (Position Int
r Int
_) ByteString
bs) -> (Int
r, [ByteString]
xs' [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r') ByteString
"\n" [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString
bs])) (Int
r0, [ByteString
bs0]) [FieldLine Position]
xs

extractComments :: BS.ByteString -> [(Int, Comment)]
extractComments :: ByteString -> [(Int, [ByteString])]
extractComments = [(Int, ByteString)] -> [(Int, [ByteString])]
go ([(Int, ByteString)] -> [(Int, [ByteString])])
-> (ByteString -> [(Int, ByteString)])
-> ByteString
-> [(Int, [ByteString])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] ([ByteString] -> [(Int, ByteString)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(Int, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
forall {a}. (Eq a, Num a) => a -> Bool
isSpace8) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
C.lines
  where
    go :: [(Int, BS.ByteString)] -> [(Int, Comment)]
    go :: [(Int, ByteString)] -> [(Int, [ByteString])]
go [] = []
    go ((Int
n, ByteString
bs) : [(Int, ByteString)]
rest)
      | ByteString -> Bool
isComment ByteString
bs = case ((Int, ByteString) -> Bool)
-> [(Int, ByteString)]
-> ([(Int, ByteString)], [(Int, ByteString)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((ByteString -> Bool
isComment (ByteString -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall {t}. (t -> Bool) -> (t -> Bool) -> t -> Bool
.|| ByteString -> Bool
BS.null) (ByteString -> Bool)
-> ((Int, ByteString) -> ByteString) -> (Int, ByteString) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd) [(Int, ByteString)]
rest of
          ([(Int, ByteString)]
h, [(Int, ByteString)]
t) -> (Int
n, ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ((Int, ByteString) -> ByteString)
-> [(Int, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd [(Int, ByteString)]
h) (Int, [ByteString])
-> [(Int, [ByteString])] -> [(Int, [ByteString])]
forall a. a -> [a] -> [a]
: [(Int, ByteString)] -> [(Int, [ByteString])]
go [(Int, ByteString)]
t
      | Bool
otherwise = [(Int, ByteString)] -> [(Int, [ByteString])]
go [(Int, ByteString)]
rest

    (t -> Bool
f .|| :: (t -> Bool) -> (t -> Bool) -> t -> Bool
.|| t -> Bool
g) t
x = t -> Bool
f t
x Bool -> Bool -> Bool
|| t -> Bool
g t
x

    isSpace8 :: a -> Bool
isSpace8 a
w = a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
9 Bool -> Bool -> Bool
|| a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
32

    isComment :: BS.ByteString -> Bool
    isComment :: ByteString -> Bool
isComment = ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"--"

data FieldPath
  = End
  | Nth Int FieldPath -- nth field
  deriving (FieldPath -> FieldPath -> Bool
(FieldPath -> FieldPath -> Bool)
-> (FieldPath -> FieldPath -> Bool) -> Eq FieldPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldPath -> FieldPath -> Bool
== :: FieldPath -> FieldPath -> Bool
$c/= :: FieldPath -> FieldPath -> Bool
/= :: FieldPath -> FieldPath -> Bool
Eq, Eq FieldPath
Eq FieldPath =>
(FieldPath -> FieldPath -> Ordering)
-> (FieldPath -> FieldPath -> Bool)
-> (FieldPath -> FieldPath -> Bool)
-> (FieldPath -> FieldPath -> Bool)
-> (FieldPath -> FieldPath -> Bool)
-> (FieldPath -> FieldPath -> FieldPath)
-> (FieldPath -> FieldPath -> FieldPath)
-> Ord FieldPath
FieldPath -> FieldPath -> Bool
FieldPath -> FieldPath -> Ordering
FieldPath -> FieldPath -> FieldPath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FieldPath -> FieldPath -> Ordering
compare :: FieldPath -> FieldPath -> Ordering
$c< :: FieldPath -> FieldPath -> Bool
< :: FieldPath -> FieldPath -> Bool
$c<= :: FieldPath -> FieldPath -> Bool
<= :: FieldPath -> FieldPath -> Bool
$c> :: FieldPath -> FieldPath -> Bool
> :: FieldPath -> FieldPath -> Bool
$c>= :: FieldPath -> FieldPath -> Bool
>= :: FieldPath -> FieldPath -> Bool
$cmax :: FieldPath -> FieldPath -> FieldPath
max :: FieldPath -> FieldPath -> FieldPath
$cmin :: FieldPath -> FieldPath -> FieldPath
min :: FieldPath -> FieldPath -> FieldPath
Ord, Int -> FieldPath -> ShowS
[FieldPath] -> ShowS
FieldPath -> String
(Int -> FieldPath -> ShowS)
-> (FieldPath -> String)
-> ([FieldPath] -> ShowS)
-> Show FieldPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldPath -> ShowS
showsPrec :: Int -> FieldPath -> ShowS
$cshow :: FieldPath -> String
show :: FieldPath -> String
$cshowList :: [FieldPath] -> ShowS
showList :: [FieldPath] -> ShowS
Show)

makePositionTree :: [Field Position] -> Map.Map Int ([Int], String)
makePositionTree :: [Field Position] -> Map Int ([Int], String)
makePositionTree [Field Position]
fs = Map Int ([Int], String)
-> [Int] -> [Field Position] -> Map Int ([Int], String)
forall {b}.
IsString b =>
Map Int ([Int], b)
-> [Int] -> [Field Position] -> Map Int ([Int], b)
foldFss Map Int ([Int], String)
forall k a. Map k a
Map.empty [] [Field Position]
fs
  where
    foldFss :: Map Int ([Int], b)
-> [Int] -> [Field Position] -> Map Int ([Int], b)
foldFss Map Int ([Int], b)
m [Int]
cursor [Field Position]
fs = (Map Int ([Int], b), [Int]) -> Map Int ([Int], b)
forall a b. (a, b) -> a
fst ((Map Int ([Int], b), [Int]) -> Map Int ([Int], b))
-> (Map Int ([Int], b), [Int]) -> Map Int ([Int], b)
forall a b. (a -> b) -> a -> b
$ ((Map Int ([Int], b), [Int])
 -> Field Position -> (Map Int ([Int], b), [Int]))
-> (Map Int ([Int], b), [Int])
-> [Field Position]
-> (Map Int ([Int], b), [Int])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map Int ([Int], b), [Int])
-> Field Position -> (Map Int ([Int], b), [Int])
stepFss (Map Int ([Int], b)
m, [Int]
cursor [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int
0]) [Field Position]
fs
    stepFss :: (Map Int ([Int], b), [Int])
-> Field Position -> (Map Int ([Int], b), [Int])
stepFss (Map Int ([Int], b)
m, [Int]
cursor) (Field (Name (Position Int
c Int
_) ByteString
_) [FieldLine Position]
fls) =
      (Map Int ([Int], b)
-> [Int] -> [FieldLine Position] -> Map Int ([Int], b)
forall {t :: * -> *} {b}.
(Foldable t, IsString b) =>
Map Int ([Int], b)
-> [Int] -> t (FieldLine Position) -> Map Int ([Int], b)
foldFls ((([Int], b) -> ([Int], b) -> ([Int], b))
-> Int -> ([Int], b) -> Map Int ([Int], b) -> Map Int ([Int], b)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\([Int], b)
_ ([Int], b)
o -> ([Int], b)
o) Int
c ([Int]
cursor, b
"fieldname") Map Int ([Int], b)
m) [Int]
cursor [FieldLine Position]
fls, [Int] -> [Int]
inc [Int]
cursor)
    stepFss (Map Int ([Int], b)
m, [Int]
cursor) (Section (Name (Position Int
c Int
_) ByteString
_) [SectionArg Position]
sas [Field Position]
fss) =
      (Map Int ([Int], b)
-> [Int] -> [Field Position] -> Map Int ([Int], b)
foldFss (Map Int ([Int], b)
-> [Int] -> [SectionArg Position] -> Map Int ([Int], b)
forall {t :: * -> *} {b}.
(Foldable t, IsString b, Functor t) =>
Map Int ([Int], b)
-> [Int] -> t (SectionArg Position) -> Map Int ([Int], b)
foldSas ((([Int], b) -> ([Int], b) -> ([Int], b))
-> Int -> ([Int], b) -> Map Int ([Int], b) -> Map Int ([Int], b)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\([Int], b)
_ ([Int], b)
o -> ([Int], b)
o) Int
c ([Int]
cursor, b
"sectionname") Map Int ([Int], b)
m) [Int]
cursor [SectionArg Position]
sas) [Int]
cursor [Field Position]
fss, [Int] -> [Int]
inc [Int]
cursor)
    foldFls :: Map Int ([Int], b)
-> [Int] -> t (FieldLine Position) -> Map Int ([Int], b)
foldFls Map Int ([Int], b)
m [Int]
c t (FieldLine Position)
fls = (Map Int ([Int], b), [Int]) -> Map Int ([Int], b)
forall a b. (a, b) -> a
fst ((Map Int ([Int], b), [Int]) -> Map Int ([Int], b))
-> (Map Int ([Int], b), [Int]) -> Map Int ([Int], b)
forall a b. (a -> b) -> a -> b
$ ((Map Int ([Int], b), [Int])
 -> FieldLine Position -> (Map Int ([Int], b), [Int]))
-> (Map Int ([Int], b), [Int])
-> t (FieldLine Position)
-> (Map Int ([Int], b), [Int])
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map Int ([Int], b), [Int])
-> FieldLine Position -> (Map Int ([Int], b), [Int])
forall {b}.
IsString b =>
(Map Int ([Int], b), [Int])
-> FieldLine Position -> (Map Int ([Int], b), [Int])
stepFls (Map Int ([Int], b)
m, [Int]
c [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int
0]) t (FieldLine Position)
fls
    stepFls :: (Map Int ([Int], b), [Int])
-> FieldLine Position -> (Map Int ([Int], b), [Int])
stepFls (Map Int ([Int], b)
m, [Int]
cursor) (FieldLine (Position Int
c Int
_) ByteString
_) = ((([Int], b) -> ([Int], b) -> ([Int], b))
-> Int -> ([Int], b) -> Map Int ([Int], b) -> Map Int ([Int], b)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\([Int], b)
_ ([Int], b)
o -> ([Int], b)
o) Int
c ([Int]
cursor, b
"fieldline") Map Int ([Int], b)
m, [Int] -> [Int]
inc [Int]
cursor)
    foldSas :: Map Int ([Int], b)
-> [Int] -> t (SectionArg Position) -> Map Int ([Int], b)
foldSas Map Int ([Int], b)
m [Int]
c t (SectionArg Position)
sas = (Map Int ([Int], b), [Int]) -> Map Int ([Int], b)
forall a b. (a, b) -> a
fst ((Map Int ([Int], b), [Int]) -> Map Int ([Int], b))
-> (Map Int ([Int], b), [Int]) -> Map Int ([Int], b)
forall a b. (a -> b) -> a -> b
$ ((Map Int ([Int], b), [Int])
 -> Position -> (Map Int ([Int], b), [Int]))
-> (Map Int ([Int], b), [Int])
-> t Position
-> (Map Int ([Int], b), [Int])
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map Int ([Int], b), [Int])
-> Position -> (Map Int ([Int], b), [Int])
forall {b}.
IsString b =>
(Map Int ([Int], b), [Int])
-> Position -> (Map Int ([Int], b), [Int])
stepSas (Map Int ([Int], b)
m, [Int]
c [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int
0]) (SectionArg Position -> Position
forall ann. SectionArg ann -> ann
sectionArgAnn (SectionArg Position -> Position)
-> t (SectionArg Position) -> t Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (SectionArg Position)
sas)
    stepSas :: (Map Int ([Int], b), [Int])
-> Position -> (Map Int ([Int], b), [Int])
stepSas (Map Int ([Int], b)
m, [Int]
cursor) (Position Int
c Int
_) = ((([Int], b) -> ([Int], b) -> ([Int], b))
-> Int -> ([Int], b) -> Map Int ([Int], b) -> Map Int ([Int], b)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\([Int], b)
_ ([Int], b)
o -> ([Int], b)
o) Int
c ([Int]
cursor, b
"sectionarg") Map Int ([Int], b)
m, [Int] -> [Int]
inc [Int]
cursor)

    inc :: [Int] -> [Int]
    inc :: [Int] -> [Int]
inc [] = []
    inc [Int]
xs = [Int] -> [Int]
forall a. [a] -> [a]
reverse (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. HasCallStack => [a] -> a
last [Int]
xs Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
xs))

addComment :: Maybe ([Int], String) -> [ByteString] -> ([Field [ByteString]], [ByteString]) -> ([Field [ByteString]], [ByteString])
addComment :: Maybe ([Int], String)
-> [ByteString]
-> ([Field [ByteString]], [ByteString])
-> ([Field [ByteString]], [ByteString])
addComment Maybe ([Int], String)
Nothing [ByteString]
cs ([Field [ByteString]]
fs, [ByteString]
extras) = ([Field [ByteString]]
fs, [ByteString]
extras [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
cs)
addComment (Just ([Int]
cursor, String
tag)) [ByteString]
cs ([Field [ByteString]]
fs, [ByteString]
extras) = ([ByteString]
-> [Int] -> String -> [Field [ByteString]] -> [Field [ByteString]]
addc [ByteString]
cs [Int]
cursor String
tag [Field [ByteString]]
fs, [ByteString]
extras)

addc :: [ByteString] -> [Int] -> String -> [Field [ByteString]] -> [Field [ByteString]]
addc :: [ByteString]
-> [Int] -> String -> [Field [ByteString]] -> [Field [ByteString]]
addc [ByteString]
comments [] String
_ [Field [ByteString]]
fs = [Field [ByteString]]
fs
addc [ByteString]
comments [Int
x] String
"fieldname" [Field [ByteString]]
fs = Int -> [Field [ByteString]] -> [Field [ByteString]]
forall a. Int -> [a] -> [a]
take Int
x [Field [ByteString]]
fs [Field [ByteString]]
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. Semigroup a => a -> a -> a
<> [Field [ByteString]
f'] [Field [ByteString]]
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. Semigroup a => a -> a -> a
<> Int -> [Field [ByteString]] -> [Field [ByteString]]
forall a. Int -> [a] -> [a]
drop (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Field [ByteString]]
fs
  where
    (Field (Name [ByteString]
cs ByteString
n) [FieldLine [ByteString]]
fls) = [Field [ByteString]] -> Int -> Field [ByteString]
forall a. HasCallStack => [a] -> Int -> a
(List.!!) [Field [ByteString]]
fs Int
x
    f' :: Field [ByteString]
f' = Name [ByteString] -> [FieldLine [ByteString]] -> Field [ByteString]
forall ann. Name ann -> [FieldLine ann] -> Field ann
Field ([ByteString] -> ByteString -> Name [ByteString]
forall ann. ann -> ByteString -> Name ann
Name ([ByteString]
cs [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
comments) ByteString
n) [FieldLine [ByteString]]
fls
addc [ByteString]
comments [Int
x] String
"sectionname" [Field [ByteString]]
fs = Int -> [Field [ByteString]] -> [Field [ByteString]]
forall a. Int -> [a] -> [a]
take Int
x [Field [ByteString]]
fs [Field [ByteString]]
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. Semigroup a => a -> a -> a
<> [Field [ByteString]
f'] [Field [ByteString]]
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. Semigroup a => a -> a -> a
<> Int -> [Field [ByteString]] -> [Field [ByteString]]
forall a. Int -> [a] -> [a]
drop (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Field [ByteString]]
fs
  where
    (Section (Name [ByteString]
cs ByteString
n) [SectionArg [ByteString]]
a [Field [ByteString]]
fss) = [Field [ByteString]] -> Int -> Field [ByteString]
forall a. HasCallStack => [a] -> Int -> a
(List.!!) [Field [ByteString]]
fs Int
x
    f' :: Field [ByteString]
f' = Name [ByteString]
-> [SectionArg [ByteString]]
-> [Field [ByteString]]
-> Field [ByteString]
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section ([ByteString] -> ByteString -> Name [ByteString]
forall ann. ann -> ByteString -> Name ann
Name ([ByteString]
cs [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
comments) ByteString
n) [SectionArg [ByteString]]
a [Field [ByteString]]
fss
addc [ByteString]
comments [Int
x, Int
y] String
"fieldline" [Field [ByteString]]
fs = Int -> [Field [ByteString]] -> [Field [ByteString]]
forall a. Int -> [a] -> [a]
take Int
x [Field [ByteString]]
fs [Field [ByteString]]
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. Semigroup a => a -> a -> a
<> [Field [ByteString]
f'] [Field [ByteString]]
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. Semigroup a => a -> a -> a
<> Int -> [Field [ByteString]] -> [Field [ByteString]]
forall a. Int -> [a] -> [a]
drop (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Field [ByteString]]
fs
  where
    (Field Name [ByteString]
n [FieldLine [ByteString]]
fls) = [Field [ByteString]] -> Int -> Field [ByteString]
forall a. HasCallStack => [a] -> Int -> a
(List.!!) [Field [ByteString]]
fs Int
x
    (FieldLine [ByteString]
cs ByteString
bs) = [FieldLine [ByteString]] -> Int -> FieldLine [ByteString]
forall a. HasCallStack => [a] -> Int -> a
(List.!!) [FieldLine [ByteString]]
fls Int
y
    fl' :: FieldLine [ByteString]
fl' = [ByteString] -> ByteString -> FieldLine [ByteString]
forall ann. ann -> ByteString -> FieldLine ann
FieldLine ([ByteString]
cs [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
comments) ByteString
bs
    f' :: Field [ByteString]
f' = Name [ByteString] -> [FieldLine [ByteString]] -> Field [ByteString]
forall ann. Name ann -> [FieldLine ann] -> Field ann
Field Name [ByteString]
n (Int -> [FieldLine [ByteString]] -> [FieldLine [ByteString]]
forall a. Int -> [a] -> [a]
take Int
y [FieldLine [ByteString]]
fls [FieldLine [ByteString]]
-> [FieldLine [ByteString]] -> [FieldLine [ByteString]]
forall a. Semigroup a => a -> a -> a
<> [FieldLine [ByteString]
fl'] [FieldLine [ByteString]]
-> [FieldLine [ByteString]] -> [FieldLine [ByteString]]
forall a. Semigroup a => a -> a -> a
<> Int -> [FieldLine [ByteString]] -> [FieldLine [ByteString]]
forall a. Int -> [a] -> [a]
drop (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [FieldLine [ByteString]]
fls)
addc [ByteString]
comments [Int
x, Int
y] String
"sectionarg" [Field [ByteString]]
fs = Int -> [Field [ByteString]] -> [Field [ByteString]]
forall a. Int -> [a] -> [a]
take Int
x [Field [ByteString]]
fs [Field [ByteString]]
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. Semigroup a => a -> a -> a
<> [Field [ByteString]
f'] [Field [ByteString]]
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. Semigroup a => a -> a -> a
<> Int -> [Field [ByteString]] -> [Field [ByteString]]
forall a. Int -> [a] -> [a]
drop (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Field [ByteString]]
fs
  where
    (Section Name [ByteString]
n [SectionArg [ByteString]]
sas [Field [ByteString]]
fss) = [Field [ByteString]] -> Int -> Field [ByteString]
forall a. HasCallStack => [a] -> Int -> a
(List.!!) [Field [ByteString]]
fs Int
x
    sa' :: SectionArg [ByteString]
sa' = ([ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
comments) ([ByteString] -> [ByteString])
-> SectionArg [ByteString] -> SectionArg [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SectionArg [ByteString]] -> Int -> SectionArg [ByteString]
forall a. HasCallStack => [a] -> Int -> a
(List.!!) [SectionArg [ByteString]]
sas Int
y
    f' :: Field [ByteString]
f' = Name [ByteString]
-> [SectionArg [ByteString]]
-> [Field [ByteString]]
-> Field [ByteString]
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section Name [ByteString]
n (Int -> [SectionArg [ByteString]] -> [SectionArg [ByteString]]
forall a. Int -> [a] -> [a]
take Int
y [SectionArg [ByteString]]
sas [SectionArg [ByteString]]
-> [SectionArg [ByteString]] -> [SectionArg [ByteString]]
forall a. Semigroup a => a -> a -> a
<> [SectionArg [ByteString]
sa'] [SectionArg [ByteString]]
-> [SectionArg [ByteString]] -> [SectionArg [ByteString]]
forall a. Semigroup a => a -> a -> a
<> Int -> [SectionArg [ByteString]] -> [SectionArg [ByteString]]
forall a. Int -> [a] -> [a]
drop (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [SectionArg [ByteString]]
sas) [Field [ByteString]]
fss
addc [ByteString]
comments (Int
x : [Int]
xs) String
tag [Field [ByteString]]
fs = Int -> [Field [ByteString]] -> [Field [ByteString]]
forall a. Int -> [a] -> [a]
take Int
x [Field [ByteString]]
fs [Field [ByteString]]
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. Semigroup a => a -> a -> a
<> [Field [ByteString]
f'] [Field [ByteString]]
-> [Field [ByteString]] -> [Field [ByteString]]
forall a. Semigroup a => a -> a -> a
<> Int -> [Field [ByteString]] -> [Field [ByteString]]
forall a. Int -> [a] -> [a]
drop (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Field [ByteString]]
fs
  where
    (Section Name [ByteString]
n [SectionArg [ByteString]]
a [Field [ByteString]]
fss) = [Field [ByteString]] -> Int -> Field [ByteString]
forall a. HasCallStack => [a] -> Int -> a
(List.!!) [Field [ByteString]]
fs Int
x
    f' :: Field [ByteString]
f' = Name [ByteString]
-> [SectionArg [ByteString]]
-> [Field [ByteString]]
-> Field [ByteString]
forall ann.
Name ann -> [SectionArg ann] -> [Field ann] -> Field ann
Section Name [ByteString]
n [SectionArg [ByteString]]
a ([ByteString]
-> [Int] -> String -> [Field [ByteString]] -> [Field [ByteString]]
addc [ByteString]
comments [Int]
xs String
tag [Field [ByteString]]
fss)

-- | Minimal cabal file contents for testing purposes. Originally created via:
--
-- > mkdir minimal && cd minimal && cabal init --minimal --simple --overwrite --lib --tests --language=GHC2021 --license=BSD-2-Clause  -p minimal
minimalExampleBS :: ByteString
minimalExampleBS :: ByteString
minimalExampleBS =
  [i|cabal-version:   3.0
name:            minimal
version:         0.1.0.0
license:         BSD-2-Clause
license-file:    LICENSE
build-type:      Simple
extra-doc-files: CHANGELOG.md

common warnings
    ghc-options: -Wall

library
    import:           warnings
    exposed-modules:  MyLib
    build-depends:    base ^>=4.17.2.1
    hs-source-dirs:   src
    default-language: GHC2021

test-suite minimal-test
    import:           warnings
    default-language: GHC2021
    type:             exitcode-stdio-1.0
    hs-source-dirs:   test
    main-is:          Main.hs
    build-depends:
        base ^>=4.17.2.1,
        minimal|]

-- | A config close to the @cabal init@ styles.
minimalConfig :: Config
minimalConfig :: Config
minimalConfig =
  Config
    { freeTexts :: [ByteString]
freeTexts = [ByteString
"description"],
      fieldRemovals :: [ByteString]
fieldRemovals = [],
      preferredDeps :: [(ByteString, ByteString)]
preferredDeps =
        [ ( ByteString
"base",
            ByteString
">=4.14 && <5"
          )
        ],
      addFields :: [(ByteString, ByteString, AddPolicy)]
addFields = [],
      fixCommas :: [(ByteString, CommaStyle, CommaTrail)]
fixCommas =
        [ ( ByteString
"extra-doc-files",
            CommaStyle
NoCommas,
            CommaTrail
NoTrailer
          ),
          ( ByteString
"build-depends",
            CommaStyle
PostfixCommas,
            CommaTrail
NoTrailer
          )
        ],
      sortFieldLines :: [ByteString]
sortFieldLines =
        [ ByteString
"build-depends",
          ByteString
"exposed-modules",
          ByteString
"default-extensions",
          ByteString
"ghc-options",
          ByteString
"extra-doc-files",
          ByteString
"tested-with"
        ],
      doSortFields :: Bool
doSortFields = Bool
True,
      fieldOrdering :: [(ByteString, Double)]
fieldOrdering =
        [ ( ByteString
"cabal-version",
            Double
0.0
          ),
          ( ByteString
"import",
            Double
1.0
          ),
          ( ByteString
"main-is",
            Double
2.0
          ),
          ( ByteString
"default-language",
            Double
8.6
          ),
          ( ByteString
"name",
            Double
4.0
          ),
          ( ByteString
"hs-source-dirs",
            Double
8.4
          ),
          ( ByteString
"version",
            Double
6.0
          ),
          ( ByteString
"build-depends",
            Double
8.2
          ),
          ( ByteString
"exposed-modules",
            Double
8.0
          ),
          ( ByteString
"license",
            Double
9.0
          ),
          ( ByteString
"license-file",
            Double
10.0
          ),
          ( ByteString
"other-modules",
            Double
11.0
          ),
          ( ByteString
"copyright",
            Double
12.0
          ),
          ( ByteString
"category",
            Double
13.0
          ),
          ( ByteString
"author",
            Double
14.0
          ),
          ( ByteString
"default-extensions",
            Double
15.0
          ),
          ( ByteString
"ghc-options",
            Double
16.0
          ),
          ( ByteString
"maintainer",
            Double
17.0
          ),
          ( ByteString
"homepage",
            Double
18.0
          ),
          ( ByteString
"bug-reports",
            Double
19.0
          ),
          ( ByteString
"synopsis",
            Double
20.0
          ),
          ( ByteString
"description",
            Double
21.0
          ),
          ( ByteString
"build-type",
            Double
22.0
          ),
          ( ByteString
"tested-with",
            Double
23.0
          ),
          ( ByteString
"extra-doc-files",
            Double
24.0
          ),
          ( ByteString
"source-repository",
            Double
25.0
          ),
          ( ByteString
"type",
            Double
26.0
          ),
          ( ByteString
"common",
            Double
27.0
          ),
          ( ByteString
"location",
            Double
28.0
          ),
          ( ByteString
"library",
            Double
29.0
          ),
          ( ByteString
"executable",
            Double
30.0
          ),
          ( ByteString
"test-suite",
            Double
31.0
          )
        ],
      doFixBuildDeps :: Bool
doFixBuildDeps = Bool
True,
      depAlignment :: DepAlignment
depAlignment = DepAlignment
DepAligned,
      removeBlankFields :: Bool
removeBlankFields = Bool
True,
      valueAligned :: ValueAlignment
valueAligned = ValueAlignment
ValueAligned,
      valueAlignGap :: Int
valueAlignGap = Int
1,
      sectionMargin :: Margin
sectionMargin = Margin
Margin,
      commentMargin :: Margin
commentMargin = Margin
Margin,
      narrowN :: Int
narrowN = Int
60,
      indentN :: Int
indentN = Int
4
    }