{-# 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 #-}
module CabalFix
(
Config (..),
defaultConfig,
AddPolicy (..),
CommaStyle (..),
CommaTrail (..),
DepAlignment (..),
ValueAlignment (..),
Margin (..),
Comment,
CabalFields (..),
cabalFields',
fieldList',
topfield',
field',
subfield',
section',
secFields',
fieldOrSection',
overField,
overFields,
pname,
fieldLines',
fieldName',
secArgs',
secArgBS',
fieldLine',
fieldValues',
parseCabalFields,
printCabalFields,
fixCabalFields,
fixCabalFile,
fixesCommas,
addsFields,
addField,
fixBuildDeps,
Dep (..),
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
data Config = Config
{
Config -> [ByteString]
freeTexts :: [ByteString],
Config -> [ByteString]
fieldRemovals :: [ByteString],
Config -> [(ByteString, ByteString)]
preferredDeps :: [(ByteString, ByteString)],
Config -> [(ByteString, ByteString, AddPolicy)]
addFields :: [(ByteString, ByteString, AddPolicy)],
Config -> [(ByteString, CommaStyle, CommaTrail)]
fixCommas :: [(ByteString, CommaStyle, CommaTrail)],
Config -> [ByteString]
sortFieldLines :: [ByteString],
Config -> Bool
doSortFields :: Bool,
Config -> [(ByteString, Double)]
fieldOrdering :: [(ByteString, Double)],
Config -> Bool
doFixBuildDeps :: Bool,
Config -> DepAlignment
depAlignment :: DepAlignment,
Config -> Bool
removeBlankFields :: Bool,
Config -> ValueAlignment
valueAligned :: ValueAlignment,
Config -> Int
valueAlignGap :: Int,
Config -> Margin
sectionMargin :: Margin,
:: Margin,
Config -> Int
narrowN :: Int,
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)
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
data CommaStyle
=
PrefixCommas
|
PostfixCommas
|
FreeformCommas
|
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)
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)
data AddPolicy
=
AddReplace
|
AddAppend
|
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)
]
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)]
defaultFieldLineSorts :: [ByteString]
defaultFieldLineSorts :: [ByteString]
defaultFieldLineSorts =
[ ByteString
"build-depends",
ByteString
"exposed-modules",
ByteString
"default-extensions",
ByteString
"ghc-options",
ByteString
"extra-doc-files",
ByteString
"tested-with"
]
defaultPreferredDeps :: [(ByteString, ByteString)]
defaultPreferredDeps :: [(ByteString, ByteString)]
defaultPreferredDeps = [(ByteString
"base", ByteString
">=4.17 && <5")]
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)
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)
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)
instance Semigroup Margin where
Margin
NoMargin <> :: Margin -> Margin -> Margin
<> Margin
NoMargin = Margin
NoMargin
Margin
_ <> Margin
_ = Margin
Margin
type = [ByteString]
data CabalFields = CabalFields {CabalFields -> Vector (Field [ByteString])
fields :: V.Vector (Field Comment), :: 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 []
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)])
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)
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
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))
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
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))
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
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
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)
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')
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")
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
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"
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
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
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
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'
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)
)
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)
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
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)
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
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
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]))
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
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))
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)
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)
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
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]]
=
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)
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
]
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]
showFieldsIndent ::
Config ->
(ann -> CommentPosition) ->
(ann -> [String] -> [String]) ->
Int ->
[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
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
$
(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
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
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)]
= [(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
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])
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)
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|]
minimalConfig :: Config
minimalConfig :: Config
minimalConfig =
Config
{ freeTexts :: [ByteString]
freeTexts = [ByteString
"description"],
fieldRemovals :: [ByteString]
fieldRemovals = [],
preferredDeps :: [(ByteString, ByteString)]
preferredDeps =
[ ( ByteString
"base",
ByteString
">=4.17 && <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
}