{- FOURMOLU_DISABLE -}
{- ***** DO NOT EDIT: This module is autogenerated ***** -}

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

module Ormolu.Config.Gen
  ( PrinterOpts (..)
  , CommaStyle (..)
  , FunctionArrowsStyle (..)
  , HaddockPrintStyle (..)
  , HaddockPrintStyleModule (..)
  , ImportExportStyle (..)
  , LetStyle (..)
  , InStyle (..)
  , Unicode (..)
  , SingleConstraintParens (..)
  , ColumnLimit (..)
  , emptyPrinterOpts
  , defaultPrinterOpts
  , defaultPrinterOptsYaml
  , fillMissingPrinterOpts
  , parsePrinterOptsCLI
  , parsePrinterOptsJSON
  , parsePrinterOptType
  )
where

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Functor.Identity (Identity)
import Data.Scientific (floatingOrInteger)
import qualified Data.Text as Text
import GHC.Generics (Generic)
import Text.Read (readEither, readMaybe)

-- | Options controlling formatting output.
data PrinterOpts f =
  PrinterOpts
    { -- | Number of spaces per indentation step
      forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation :: f Int
    , -- | Max line length for automatic line breaking
      forall (f :: * -> *). PrinterOpts f -> f ColumnLimit
poColumnLimit :: f ColumnLimit
    , -- | Styling of arrows in type signatures
      forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle
poFunctionArrows :: f FunctionArrowsStyle
    , -- | How to place commas in multi-line lists, records, etc.
      forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle :: f CommaStyle
    , -- | Styling of import/export lists
      forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle :: f ImportExportStyle
    , -- | Whether to full-indent or half-indent 'where' bindings past the preceding body
      forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres :: f Bool
    , -- | Whether to leave a space before an opening record brace
      forall (f :: * -> *). PrinterOpts f -> f Bool
poRecordBraceSpace :: f Bool
    , -- | Number of spaces between top-level declarations
      forall (f :: * -> *). PrinterOpts f -> f Int
poNewlinesBetweenDecls :: f Int
    , -- | How to print Haddock comments
      forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyle
poHaddockStyle :: f HaddockPrintStyle
    , -- | How to print module docstring
      forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyleModule
poHaddockStyleModule :: f HaddockPrintStyleModule
    , -- | Styling of let blocks
      forall (f :: * -> *). PrinterOpts f -> f LetStyle
poLetStyle :: f LetStyle
    , -- | How to align the 'in' keyword with respect to the 'let' keyword
      forall (f :: * -> *). PrinterOpts f -> f InStyle
poInStyle :: f InStyle
    , -- | Whether to put parentheses around a single constraint
      forall (f :: * -> *). PrinterOpts f -> f SingleConstraintParens
poSingleConstraintParens :: f SingleConstraintParens
    , -- | Output Unicode syntax
      forall (f :: * -> *). PrinterOpts f -> f Unicode
poUnicode :: f Unicode
    , -- | Give the programmer more choice on where to insert blank lines
      forall (f :: * -> *). PrinterOpts f -> f Bool
poRespectful :: f Bool
    }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (PrinterOpts f) x -> PrinterOpts f
forall (f :: * -> *) x. PrinterOpts f -> Rep (PrinterOpts f) x
$cto :: forall (f :: * -> *) x. Rep (PrinterOpts f) x -> PrinterOpts f
$cfrom :: forall (f :: * -> *) x. PrinterOpts f -> Rep (PrinterOpts f) x
Generic)

emptyPrinterOpts :: PrinterOpts Maybe
emptyPrinterOpts :: PrinterOpts Maybe
emptyPrinterOpts =
  PrinterOpts
    { poIndentation :: Maybe Int
poIndentation = forall a. Maybe a
Nothing
    , poColumnLimit :: Maybe ColumnLimit
poColumnLimit = forall a. Maybe a
Nothing
    , poFunctionArrows :: Maybe FunctionArrowsStyle
poFunctionArrows = forall a. Maybe a
Nothing
    , poCommaStyle :: Maybe CommaStyle
poCommaStyle = forall a. Maybe a
Nothing
    , poImportExportStyle :: Maybe ImportExportStyle
poImportExportStyle = forall a. Maybe a
Nothing
    , poIndentWheres :: Maybe Bool
poIndentWheres = forall a. Maybe a
Nothing
    , poRecordBraceSpace :: Maybe Bool
poRecordBraceSpace = forall a. Maybe a
Nothing
    , poNewlinesBetweenDecls :: Maybe Int
poNewlinesBetweenDecls = forall a. Maybe a
Nothing
    , poHaddockStyle :: Maybe HaddockPrintStyle
poHaddockStyle = forall a. Maybe a
Nothing
    , poHaddockStyleModule :: Maybe HaddockPrintStyleModule
poHaddockStyleModule = forall a. Maybe a
Nothing
    , poLetStyle :: Maybe LetStyle
poLetStyle = forall a. Maybe a
Nothing
    , poInStyle :: Maybe InStyle
poInStyle = forall a. Maybe a
Nothing
    , poSingleConstraintParens :: Maybe SingleConstraintParens
poSingleConstraintParens = forall a. Maybe a
Nothing
    , poUnicode :: Maybe Unicode
poUnicode = forall a. Maybe a
Nothing
    , poRespectful :: Maybe Bool
poRespectful = forall a. Maybe a
Nothing
    }

defaultPrinterOpts :: PrinterOpts Identity
defaultPrinterOpts :: PrinterOpts Identity
defaultPrinterOpts =
  PrinterOpts
    { poIndentation :: Identity Int
poIndentation = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
4
    , poColumnLimit :: Identity ColumnLimit
poColumnLimit = forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnLimit
NoLimit
    , poFunctionArrows :: Identity FunctionArrowsStyle
poFunctionArrows = forall (f :: * -> *) a. Applicative f => a -> f a
pure FunctionArrowsStyle
TrailingArrows
    , poCommaStyle :: Identity CommaStyle
poCommaStyle = forall (f :: * -> *) a. Applicative f => a -> f a
pure CommaStyle
Leading
    , poImportExportStyle :: Identity ImportExportStyle
poImportExportStyle = forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportExportStyle
ImportExportDiffFriendly
    , poIndentWheres :: Identity Bool
poIndentWheres = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    , poRecordBraceSpace :: Identity Bool
poRecordBraceSpace = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    , poNewlinesBetweenDecls :: Identity Int
poNewlinesBetweenDecls = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1
    , poHaddockStyle :: Identity HaddockPrintStyle
poHaddockStyle = forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyle
HaddockMultiLine
    , poHaddockStyleModule :: Identity HaddockPrintStyleModule
poHaddockStyleModule = forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyleModule
PrintStyleInherit
    , poLetStyle :: Identity LetStyle
poLetStyle = forall (f :: * -> *) a. Applicative f => a -> f a
pure LetStyle
LetAuto
    , poInStyle :: Identity InStyle
poInStyle = forall (f :: * -> *) a. Applicative f => a -> f a
pure InStyle
InRightAlign
    , poSingleConstraintParens :: Identity SingleConstraintParens
poSingleConstraintParens = forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleConstraintParens
ConstraintAlways
    , poUnicode :: Identity Unicode
poUnicode = forall (f :: * -> *) a. Applicative f => a -> f a
pure Unicode
UnicodeNever
    , poRespectful :: Identity Bool
poRespectful = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    }

-- | Fill the field values that are 'Nothing' in the first argument
-- with the values of the corresponding fields of the second argument.
fillMissingPrinterOpts ::
  forall f.
  Applicative f =>
  PrinterOpts Maybe ->
  PrinterOpts f ->
  PrinterOpts f
fillMissingPrinterOpts :: forall (f :: * -> *).
Applicative f =>
PrinterOpts Maybe -> PrinterOpts f -> PrinterOpts f
fillMissingPrinterOpts PrinterOpts Maybe
p1 PrinterOpts f
p2 =
  PrinterOpts
    { poIndentation :: f Int
poIndentation = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation PrinterOpts Maybe
p1)
    , poColumnLimit :: f ColumnLimit
poColumnLimit = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f ColumnLimit
poColumnLimit PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f ColumnLimit
poColumnLimit PrinterOpts Maybe
p1)
    , poFunctionArrows :: f FunctionArrowsStyle
poFunctionArrows = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle
poFunctionArrows PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle
poFunctionArrows PrinterOpts Maybe
p1)
    , poCommaStyle :: f CommaStyle
poCommaStyle = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle PrinterOpts Maybe
p1)
    , poImportExportStyle :: f ImportExportStyle
poImportExportStyle = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle PrinterOpts Maybe
p1)
    , poIndentWheres :: f Bool
poIndentWheres = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres PrinterOpts Maybe
p1)
    , poRecordBraceSpace :: f Bool
poRecordBraceSpace = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f Bool
poRecordBraceSpace PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f Bool
poRecordBraceSpace PrinterOpts Maybe
p1)
    , poNewlinesBetweenDecls :: f Int
poNewlinesBetweenDecls = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f Int
poNewlinesBetweenDecls PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f Int
poNewlinesBetweenDecls PrinterOpts Maybe
p1)
    , poHaddockStyle :: f HaddockPrintStyle
poHaddockStyle = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyle
poHaddockStyle PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyle
poHaddockStyle PrinterOpts Maybe
p1)
    , poHaddockStyleModule :: f HaddockPrintStyleModule
poHaddockStyleModule = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyleModule
poHaddockStyleModule PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyleModule
poHaddockStyleModule PrinterOpts Maybe
p1)
    , poLetStyle :: f LetStyle
poLetStyle = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f LetStyle
poLetStyle PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f LetStyle
poLetStyle PrinterOpts Maybe
p1)
    , poInStyle :: f InStyle
poInStyle = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f InStyle
poInStyle PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f InStyle
poInStyle PrinterOpts Maybe
p1)
    , poSingleConstraintParens :: f SingleConstraintParens
poSingleConstraintParens = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f SingleConstraintParens
poSingleConstraintParens PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f SingleConstraintParens
poSingleConstraintParens PrinterOpts Maybe
p1)
    , poUnicode :: f Unicode
poUnicode = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f Unicode
poUnicode PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f Unicode
poUnicode PrinterOpts Maybe
p1)
    , poRespectful :: f Bool
poRespectful = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *). PrinterOpts f -> f Bool
poRespectful PrinterOpts f
p2) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). PrinterOpts f -> f Bool
poRespectful PrinterOpts Maybe
p1)
    }

parsePrinterOptsCLI ::
  Applicative f =>
  (forall a. PrinterOptsFieldType a => String -> String -> String -> f (Maybe a)) ->
  f (PrinterOpts Maybe)
parsePrinterOptsCLI :: forall (f :: * -> *).
Applicative f =>
(forall a.
 PrinterOptsFieldType a =>
 String -> String -> String -> f (Maybe a))
-> f (PrinterOpts Maybe)
parsePrinterOptsCLI forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *).
f Int
-> f ColumnLimit
-> f FunctionArrowsStyle
-> f CommaStyle
-> f ImportExportStyle
-> f Bool
-> f Bool
-> f Int
-> f HaddockPrintStyle
-> f HaddockPrintStyleModule
-> f LetStyle
-> f InStyle
-> f SingleConstraintParens
-> f Unicode
-> f Bool
-> PrinterOpts f
PrinterOpts
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"indentation"
      String
"Number of spaces per indentation step (default: 4)"
      String
"INT"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"column-limit"
      String
"Max line length for automatic line breaking (default: none)"
      String
"OPTION"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"function-arrows"
      String
"Styling of arrows in type signatures (choices: \"trailing\", \"leading\", or \"leading-args\") (default: trailing)"
      String
"OPTION"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"comma-style"
      String
"How to place commas in multi-line lists, records, etc. (choices: \"leading\" or \"trailing\") (default: leading)"
      String
"OPTION"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"import-export-style"
      String
"Styling of import/export lists (choices: \"leading\", \"trailing\", or \"diff-friendly\") (default: diff-friendly)"
      String
"OPTION"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"indent-wheres"
      String
"Whether to full-indent or half-indent 'where' bindings past the preceding body (default: false)"
      String
"BOOL"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"record-brace-space"
      String
"Whether to leave a space before an opening record brace (default: false)"
      String
"BOOL"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"newlines-between-decls"
      String
"Number of spaces between top-level declarations (default: 1)"
      String
"INT"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"haddock-style"
      String
"How to print Haddock comments (choices: \"single-line\", \"multi-line\", or \"multi-line-compact\") (default: multi-line)"
      String
"OPTION"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"haddock-style-module"
      String
"How to print module docstring (default: same as 'haddock-style')"
      String
"OPTION"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"let-style"
      String
"Styling of let blocks (choices: \"auto\", \"inline\", \"newline\", or \"mixed\") (default: auto)"
      String
"OPTION"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"in-style"
      String
"How to align the 'in' keyword with respect to the 'let' keyword (choices: \"left-align\", \"right-align\", or \"no-space\") (default: right-align)"
      String
"OPTION"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"single-constraint-parens"
      String
"Whether to put parentheses around a single constraint (choices: \"auto\", \"always\", or \"never\") (default: always)"
      String
"OPTION"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"unicode"
      String
"Output Unicode syntax (choices: \"detect\", \"always\", or \"never\") (default: never)"
      String
"OPTION"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"respectful"
      String
"Give the programmer more choice on where to insert blank lines (default: true)"
      String
"BOOL"

parsePrinterOptsJSON ::
  Applicative f =>
  (forall a. PrinterOptsFieldType a => String -> f (Maybe a)) ->
  f (PrinterOpts Maybe)
parsePrinterOptsJSON :: forall (f :: * -> *).
Applicative f =>
(forall a. PrinterOptsFieldType a => String -> f (Maybe a))
-> f (PrinterOpts Maybe)
parsePrinterOptsJSON forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *).
f Int
-> f ColumnLimit
-> f FunctionArrowsStyle
-> f CommaStyle
-> f ImportExportStyle
-> f Bool
-> f Bool
-> f Int
-> f HaddockPrintStyle
-> f HaddockPrintStyleModule
-> f LetStyle
-> f InStyle
-> f SingleConstraintParens
-> f Unicode
-> f Bool
-> PrinterOpts f
PrinterOpts
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"indentation"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"column-limit"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"function-arrows"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"comma-style"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"import-export-style"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"indent-wheres"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"record-brace-space"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"newlines-between-decls"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"haddock-style"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"haddock-style-module"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"let-style"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"in-style"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"single-constraint-parens"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"unicode"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"respectful"

{---------- PrinterOpts field types ----------}

class Aeson.FromJSON a => PrinterOptsFieldType a where
  parsePrinterOptType :: String -> Either String a

instance PrinterOptsFieldType Int where
  parsePrinterOptType :: String -> Either String Int
parsePrinterOptType = forall a. Read a => String -> Either String a
readEither

instance PrinterOptsFieldType Bool where
  parsePrinterOptType :: String -> Either String Bool
parsePrinterOptType String
s =
    case String
s of
      String
"false" -> forall a b. b -> Either a b
Right Bool
False
      String
"true" -> forall a b. b -> Either a b
Right Bool
True
      String
_ ->
        forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s,
            String
"Valid values are: \"false\" or \"true\""
          ]

data CommaStyle
  = Leading
  | Trailing
  deriving (CommaStyle -> CommaStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommaStyle -> CommaStyle -> Bool
$c/= :: CommaStyle -> CommaStyle -> Bool
== :: CommaStyle -> CommaStyle -> Bool
$c== :: CommaStyle -> CommaStyle -> Bool
Eq, Int -> CommaStyle -> ShowS
[CommaStyle] -> ShowS
CommaStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommaStyle] -> ShowS
$cshowList :: [CommaStyle] -> ShowS
show :: CommaStyle -> String
$cshow :: CommaStyle -> String
showsPrec :: Int -> CommaStyle -> ShowS
$cshowsPrec :: Int -> CommaStyle -> ShowS
Show, Int -> CommaStyle
CommaStyle -> Int
CommaStyle -> [CommaStyle]
CommaStyle -> CommaStyle
CommaStyle -> CommaStyle -> [CommaStyle]
CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromThenTo :: CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
enumFromTo :: CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromTo :: CommaStyle -> CommaStyle -> [CommaStyle]
enumFromThen :: CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromThen :: CommaStyle -> CommaStyle -> [CommaStyle]
enumFrom :: CommaStyle -> [CommaStyle]
$cenumFrom :: CommaStyle -> [CommaStyle]
fromEnum :: CommaStyle -> Int
$cfromEnum :: CommaStyle -> Int
toEnum :: Int -> CommaStyle
$ctoEnum :: Int -> CommaStyle
pred :: CommaStyle -> CommaStyle
$cpred :: CommaStyle -> CommaStyle
succ :: CommaStyle -> CommaStyle
$csucc :: CommaStyle -> CommaStyle
Enum, CommaStyle
forall a. a -> a -> Bounded a
maxBound :: CommaStyle
$cmaxBound :: CommaStyle
minBound :: CommaStyle
$cminBound :: CommaStyle
Bounded)

data FunctionArrowsStyle
  = TrailingArrows
  | LeadingArrows
  | LeadingArgsArrows
  deriving (FunctionArrowsStyle -> FunctionArrowsStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionArrowsStyle -> FunctionArrowsStyle -> Bool
$c/= :: FunctionArrowsStyle -> FunctionArrowsStyle -> Bool
== :: FunctionArrowsStyle -> FunctionArrowsStyle -> Bool
$c== :: FunctionArrowsStyle -> FunctionArrowsStyle -> Bool
Eq, Int -> FunctionArrowsStyle -> ShowS
[FunctionArrowsStyle] -> ShowS
FunctionArrowsStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionArrowsStyle] -> ShowS
$cshowList :: [FunctionArrowsStyle] -> ShowS
show :: FunctionArrowsStyle -> String
$cshow :: FunctionArrowsStyle -> String
showsPrec :: Int -> FunctionArrowsStyle -> ShowS
$cshowsPrec :: Int -> FunctionArrowsStyle -> ShowS
Show, Int -> FunctionArrowsStyle
FunctionArrowsStyle -> Int
FunctionArrowsStyle -> [FunctionArrowsStyle]
FunctionArrowsStyle -> FunctionArrowsStyle
FunctionArrowsStyle -> FunctionArrowsStyle -> [FunctionArrowsStyle]
FunctionArrowsStyle
-> FunctionArrowsStyle
-> FunctionArrowsStyle
-> [FunctionArrowsStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FunctionArrowsStyle
-> FunctionArrowsStyle
-> FunctionArrowsStyle
-> [FunctionArrowsStyle]
$cenumFromThenTo :: FunctionArrowsStyle
-> FunctionArrowsStyle
-> FunctionArrowsStyle
-> [FunctionArrowsStyle]
enumFromTo :: FunctionArrowsStyle -> FunctionArrowsStyle -> [FunctionArrowsStyle]
$cenumFromTo :: FunctionArrowsStyle -> FunctionArrowsStyle -> [FunctionArrowsStyle]
enumFromThen :: FunctionArrowsStyle -> FunctionArrowsStyle -> [FunctionArrowsStyle]
$cenumFromThen :: FunctionArrowsStyle -> FunctionArrowsStyle -> [FunctionArrowsStyle]
enumFrom :: FunctionArrowsStyle -> [FunctionArrowsStyle]
$cenumFrom :: FunctionArrowsStyle -> [FunctionArrowsStyle]
fromEnum :: FunctionArrowsStyle -> Int
$cfromEnum :: FunctionArrowsStyle -> Int
toEnum :: Int -> FunctionArrowsStyle
$ctoEnum :: Int -> FunctionArrowsStyle
pred :: FunctionArrowsStyle -> FunctionArrowsStyle
$cpred :: FunctionArrowsStyle -> FunctionArrowsStyle
succ :: FunctionArrowsStyle -> FunctionArrowsStyle
$csucc :: FunctionArrowsStyle -> FunctionArrowsStyle
Enum, FunctionArrowsStyle
forall a. a -> a -> Bounded a
maxBound :: FunctionArrowsStyle
$cmaxBound :: FunctionArrowsStyle
minBound :: FunctionArrowsStyle
$cminBound :: FunctionArrowsStyle
Bounded)

data HaddockPrintStyle
  = HaddockSingleLine
  | HaddockMultiLine
  | HaddockMultiLineCompact
  deriving (HaddockPrintStyle -> HaddockPrintStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
$c/= :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
== :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
$c== :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
Eq, Int -> HaddockPrintStyle -> ShowS
[HaddockPrintStyle] -> ShowS
HaddockPrintStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HaddockPrintStyle] -> ShowS
$cshowList :: [HaddockPrintStyle] -> ShowS
show :: HaddockPrintStyle -> String
$cshow :: HaddockPrintStyle -> String
showsPrec :: Int -> HaddockPrintStyle -> ShowS
$cshowsPrec :: Int -> HaddockPrintStyle -> ShowS
Show, Int -> HaddockPrintStyle
HaddockPrintStyle -> Int
HaddockPrintStyle -> [HaddockPrintStyle]
HaddockPrintStyle -> HaddockPrintStyle
HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
HaddockPrintStyle
-> HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HaddockPrintStyle
-> HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFromThenTo :: HaddockPrintStyle
-> HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
enumFromTo :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFromTo :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
enumFromThen :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFromThen :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
enumFrom :: HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFrom :: HaddockPrintStyle -> [HaddockPrintStyle]
fromEnum :: HaddockPrintStyle -> Int
$cfromEnum :: HaddockPrintStyle -> Int
toEnum :: Int -> HaddockPrintStyle
$ctoEnum :: Int -> HaddockPrintStyle
pred :: HaddockPrintStyle -> HaddockPrintStyle
$cpred :: HaddockPrintStyle -> HaddockPrintStyle
succ :: HaddockPrintStyle -> HaddockPrintStyle
$csucc :: HaddockPrintStyle -> HaddockPrintStyle
Enum, HaddockPrintStyle
forall a. a -> a -> Bounded a
maxBound :: HaddockPrintStyle
$cmaxBound :: HaddockPrintStyle
minBound :: HaddockPrintStyle
$cminBound :: HaddockPrintStyle
Bounded)

data HaddockPrintStyleModule
  = PrintStyleInherit
  | PrintStyleOverride HaddockPrintStyle
  deriving (HaddockPrintStyleModule -> HaddockPrintStyleModule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HaddockPrintStyleModule -> HaddockPrintStyleModule -> Bool
$c/= :: HaddockPrintStyleModule -> HaddockPrintStyleModule -> Bool
== :: HaddockPrintStyleModule -> HaddockPrintStyleModule -> Bool
$c== :: HaddockPrintStyleModule -> HaddockPrintStyleModule -> Bool
Eq, Int -> HaddockPrintStyleModule -> ShowS
[HaddockPrintStyleModule] -> ShowS
HaddockPrintStyleModule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HaddockPrintStyleModule] -> ShowS
$cshowList :: [HaddockPrintStyleModule] -> ShowS
show :: HaddockPrintStyleModule -> String
$cshow :: HaddockPrintStyleModule -> String
showsPrec :: Int -> HaddockPrintStyleModule -> ShowS
$cshowsPrec :: Int -> HaddockPrintStyleModule -> ShowS
Show)

data ImportExportStyle
  = ImportExportLeading
  | ImportExportTrailing
  | ImportExportDiffFriendly
  deriving (ImportExportStyle -> ImportExportStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportExportStyle -> ImportExportStyle -> Bool
$c/= :: ImportExportStyle -> ImportExportStyle -> Bool
== :: ImportExportStyle -> ImportExportStyle -> Bool
$c== :: ImportExportStyle -> ImportExportStyle -> Bool
Eq, Int -> ImportExportStyle -> ShowS
[ImportExportStyle] -> ShowS
ImportExportStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportExportStyle] -> ShowS
$cshowList :: [ImportExportStyle] -> ShowS
show :: ImportExportStyle -> String
$cshow :: ImportExportStyle -> String
showsPrec :: Int -> ImportExportStyle -> ShowS
$cshowsPrec :: Int -> ImportExportStyle -> ShowS
Show, Int -> ImportExportStyle
ImportExportStyle -> Int
ImportExportStyle -> [ImportExportStyle]
ImportExportStyle -> ImportExportStyle
ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
ImportExportStyle
-> ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ImportExportStyle
-> ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
$cenumFromThenTo :: ImportExportStyle
-> ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
enumFromTo :: ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
$cenumFromTo :: ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
enumFromThen :: ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
$cenumFromThen :: ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
enumFrom :: ImportExportStyle -> [ImportExportStyle]
$cenumFrom :: ImportExportStyle -> [ImportExportStyle]
fromEnum :: ImportExportStyle -> Int
$cfromEnum :: ImportExportStyle -> Int
toEnum :: Int -> ImportExportStyle
$ctoEnum :: Int -> ImportExportStyle
pred :: ImportExportStyle -> ImportExportStyle
$cpred :: ImportExportStyle -> ImportExportStyle
succ :: ImportExportStyle -> ImportExportStyle
$csucc :: ImportExportStyle -> ImportExportStyle
Enum, ImportExportStyle
forall a. a -> a -> Bounded a
maxBound :: ImportExportStyle
$cmaxBound :: ImportExportStyle
minBound :: ImportExportStyle
$cminBound :: ImportExportStyle
Bounded)

data LetStyle
  = LetAuto
  | LetInline
  | LetNewline
  | LetMixed
  deriving (LetStyle -> LetStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LetStyle -> LetStyle -> Bool
$c/= :: LetStyle -> LetStyle -> Bool
== :: LetStyle -> LetStyle -> Bool
$c== :: LetStyle -> LetStyle -> Bool
Eq, Int -> LetStyle -> ShowS
[LetStyle] -> ShowS
LetStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LetStyle] -> ShowS
$cshowList :: [LetStyle] -> ShowS
show :: LetStyle -> String
$cshow :: LetStyle -> String
showsPrec :: Int -> LetStyle -> ShowS
$cshowsPrec :: Int -> LetStyle -> ShowS
Show, Int -> LetStyle
LetStyle -> Int
LetStyle -> [LetStyle]
LetStyle -> LetStyle
LetStyle -> LetStyle -> [LetStyle]
LetStyle -> LetStyle -> LetStyle -> [LetStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LetStyle -> LetStyle -> LetStyle -> [LetStyle]
$cenumFromThenTo :: LetStyle -> LetStyle -> LetStyle -> [LetStyle]
enumFromTo :: LetStyle -> LetStyle -> [LetStyle]
$cenumFromTo :: LetStyle -> LetStyle -> [LetStyle]
enumFromThen :: LetStyle -> LetStyle -> [LetStyle]
$cenumFromThen :: LetStyle -> LetStyle -> [LetStyle]
enumFrom :: LetStyle -> [LetStyle]
$cenumFrom :: LetStyle -> [LetStyle]
fromEnum :: LetStyle -> Int
$cfromEnum :: LetStyle -> Int
toEnum :: Int -> LetStyle
$ctoEnum :: Int -> LetStyle
pred :: LetStyle -> LetStyle
$cpred :: LetStyle -> LetStyle
succ :: LetStyle -> LetStyle
$csucc :: LetStyle -> LetStyle
Enum, LetStyle
forall a. a -> a -> Bounded a
maxBound :: LetStyle
$cmaxBound :: LetStyle
minBound :: LetStyle
$cminBound :: LetStyle
Bounded)

data InStyle
  = InLeftAlign
  | InRightAlign
  | InNoSpace
  deriving (InStyle -> InStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InStyle -> InStyle -> Bool
$c/= :: InStyle -> InStyle -> Bool
== :: InStyle -> InStyle -> Bool
$c== :: InStyle -> InStyle -> Bool
Eq, Int -> InStyle -> ShowS
[InStyle] -> ShowS
InStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InStyle] -> ShowS
$cshowList :: [InStyle] -> ShowS
show :: InStyle -> String
$cshow :: InStyle -> String
showsPrec :: Int -> InStyle -> ShowS
$cshowsPrec :: Int -> InStyle -> ShowS
Show, Int -> InStyle
InStyle -> Int
InStyle -> [InStyle]
InStyle -> InStyle
InStyle -> InStyle -> [InStyle]
InStyle -> InStyle -> InStyle -> [InStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InStyle -> InStyle -> InStyle -> [InStyle]
$cenumFromThenTo :: InStyle -> InStyle -> InStyle -> [InStyle]
enumFromTo :: InStyle -> InStyle -> [InStyle]
$cenumFromTo :: InStyle -> InStyle -> [InStyle]
enumFromThen :: InStyle -> InStyle -> [InStyle]
$cenumFromThen :: InStyle -> InStyle -> [InStyle]
enumFrom :: InStyle -> [InStyle]
$cenumFrom :: InStyle -> [InStyle]
fromEnum :: InStyle -> Int
$cfromEnum :: InStyle -> Int
toEnum :: Int -> InStyle
$ctoEnum :: Int -> InStyle
pred :: InStyle -> InStyle
$cpred :: InStyle -> InStyle
succ :: InStyle -> InStyle
$csucc :: InStyle -> InStyle
Enum, InStyle
forall a. a -> a -> Bounded a
maxBound :: InStyle
$cmaxBound :: InStyle
minBound :: InStyle
$cminBound :: InStyle
Bounded)

data Unicode
  = UnicodeDetect
  | UnicodeAlways
  | UnicodeNever
  deriving (Unicode -> Unicode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unicode -> Unicode -> Bool
$c/= :: Unicode -> Unicode -> Bool
== :: Unicode -> Unicode -> Bool
$c== :: Unicode -> Unicode -> Bool
Eq, Int -> Unicode -> ShowS
[Unicode] -> ShowS
Unicode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unicode] -> ShowS
$cshowList :: [Unicode] -> ShowS
show :: Unicode -> String
$cshow :: Unicode -> String
showsPrec :: Int -> Unicode -> ShowS
$cshowsPrec :: Int -> Unicode -> ShowS
Show, Int -> Unicode
Unicode -> Int
Unicode -> [Unicode]
Unicode -> Unicode
Unicode -> Unicode -> [Unicode]
Unicode -> Unicode -> Unicode -> [Unicode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Unicode -> Unicode -> Unicode -> [Unicode]
$cenumFromThenTo :: Unicode -> Unicode -> Unicode -> [Unicode]
enumFromTo :: Unicode -> Unicode -> [Unicode]
$cenumFromTo :: Unicode -> Unicode -> [Unicode]
enumFromThen :: Unicode -> Unicode -> [Unicode]
$cenumFromThen :: Unicode -> Unicode -> [Unicode]
enumFrom :: Unicode -> [Unicode]
$cenumFrom :: Unicode -> [Unicode]
fromEnum :: Unicode -> Int
$cfromEnum :: Unicode -> Int
toEnum :: Int -> Unicode
$ctoEnum :: Int -> Unicode
pred :: Unicode -> Unicode
$cpred :: Unicode -> Unicode
succ :: Unicode -> Unicode
$csucc :: Unicode -> Unicode
Enum, Unicode
forall a. a -> a -> Bounded a
maxBound :: Unicode
$cmaxBound :: Unicode
minBound :: Unicode
$cminBound :: Unicode
Bounded)

data SingleConstraintParens
  = ConstraintAuto
  | ConstraintAlways
  | ConstraintNever
  deriving (SingleConstraintParens -> SingleConstraintParens -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SingleConstraintParens -> SingleConstraintParens -> Bool
$c/= :: SingleConstraintParens -> SingleConstraintParens -> Bool
== :: SingleConstraintParens -> SingleConstraintParens -> Bool
$c== :: SingleConstraintParens -> SingleConstraintParens -> Bool
Eq, Int -> SingleConstraintParens -> ShowS
[SingleConstraintParens] -> ShowS
SingleConstraintParens -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SingleConstraintParens] -> ShowS
$cshowList :: [SingleConstraintParens] -> ShowS
show :: SingleConstraintParens -> String
$cshow :: SingleConstraintParens -> String
showsPrec :: Int -> SingleConstraintParens -> ShowS
$cshowsPrec :: Int -> SingleConstraintParens -> ShowS
Show, Int -> SingleConstraintParens
SingleConstraintParens -> Int
SingleConstraintParens -> [SingleConstraintParens]
SingleConstraintParens -> SingleConstraintParens
SingleConstraintParens
-> SingleConstraintParens -> [SingleConstraintParens]
SingleConstraintParens
-> SingleConstraintParens
-> SingleConstraintParens
-> [SingleConstraintParens]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SingleConstraintParens
-> SingleConstraintParens
-> SingleConstraintParens
-> [SingleConstraintParens]
$cenumFromThenTo :: SingleConstraintParens
-> SingleConstraintParens
-> SingleConstraintParens
-> [SingleConstraintParens]
enumFromTo :: SingleConstraintParens
-> SingleConstraintParens -> [SingleConstraintParens]
$cenumFromTo :: SingleConstraintParens
-> SingleConstraintParens -> [SingleConstraintParens]
enumFromThen :: SingleConstraintParens
-> SingleConstraintParens -> [SingleConstraintParens]
$cenumFromThen :: SingleConstraintParens
-> SingleConstraintParens -> [SingleConstraintParens]
enumFrom :: SingleConstraintParens -> [SingleConstraintParens]
$cenumFrom :: SingleConstraintParens -> [SingleConstraintParens]
fromEnum :: SingleConstraintParens -> Int
$cfromEnum :: SingleConstraintParens -> Int
toEnum :: Int -> SingleConstraintParens
$ctoEnum :: Int -> SingleConstraintParens
pred :: SingleConstraintParens -> SingleConstraintParens
$cpred :: SingleConstraintParens -> SingleConstraintParens
succ :: SingleConstraintParens -> SingleConstraintParens
$csucc :: SingleConstraintParens -> SingleConstraintParens
Enum, SingleConstraintParens
forall a. a -> a -> Bounded a
maxBound :: SingleConstraintParens
$cmaxBound :: SingleConstraintParens
minBound :: SingleConstraintParens
$cminBound :: SingleConstraintParens
Bounded)

data ColumnLimit
  = NoLimit
  | ColumnLimit Int
  deriving (ColumnLimit -> ColumnLimit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnLimit -> ColumnLimit -> Bool
$c/= :: ColumnLimit -> ColumnLimit -> Bool
== :: ColumnLimit -> ColumnLimit -> Bool
$c== :: ColumnLimit -> ColumnLimit -> Bool
Eq, Int -> ColumnLimit -> ShowS
[ColumnLimit] -> ShowS
ColumnLimit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnLimit] -> ShowS
$cshowList :: [ColumnLimit] -> ShowS
show :: ColumnLimit -> String
$cshow :: ColumnLimit -> String
showsPrec :: Int -> ColumnLimit -> ShowS
$cshowsPrec :: Int -> ColumnLimit -> ShowS
Show)

instance Aeson.FromJSON CommaStyle where
  parseJSON :: Value -> Parser CommaStyle
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"CommaStyle" forall a b. (a -> b) -> a -> b
$ \Text
s ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> Parser a
Aeson.parseFail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall a. PrinterOptsFieldType a => String -> Either String a
parsePrinterOptType (Text -> String
Text.unpack Text
s)

instance PrinterOptsFieldType CommaStyle where
  parsePrinterOptType :: String -> Either String CommaStyle
parsePrinterOptType String
s =
    case String
s of
      String
"leading" -> forall a b. b -> Either a b
Right CommaStyle
Leading
      String
"trailing" -> forall a b. b -> Either a b
Right CommaStyle
Trailing
      String
_ ->
        forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s
          , String
"Valid values are: \"leading\" or \"trailing\""
          ]

instance Aeson.FromJSON FunctionArrowsStyle where
  parseJSON :: Value -> Parser FunctionArrowsStyle
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"FunctionArrowsStyle" forall a b. (a -> b) -> a -> b
$ \Text
s ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> Parser a
Aeson.parseFail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall a. PrinterOptsFieldType a => String -> Either String a
parsePrinterOptType (Text -> String
Text.unpack Text
s)

instance PrinterOptsFieldType FunctionArrowsStyle where
  parsePrinterOptType :: String -> Either String FunctionArrowsStyle
parsePrinterOptType String
s =
    case String
s of
      String
"trailing" -> forall a b. b -> Either a b
Right FunctionArrowsStyle
TrailingArrows
      String
"leading" -> forall a b. b -> Either a b
Right FunctionArrowsStyle
LeadingArrows
      String
"leading-args" -> forall a b. b -> Either a b
Right FunctionArrowsStyle
LeadingArgsArrows
      String
_ ->
        forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s
          , String
"Valid values are: \"trailing\", \"leading\", or \"leading-args\""
          ]

instance Aeson.FromJSON HaddockPrintStyle where
  parseJSON :: Value -> Parser HaddockPrintStyle
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"HaddockPrintStyle" forall a b. (a -> b) -> a -> b
$ \Text
s ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> Parser a
Aeson.parseFail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall a. PrinterOptsFieldType a => String -> Either String a
parsePrinterOptType (Text -> String
Text.unpack Text
s)

instance PrinterOptsFieldType HaddockPrintStyle where
  parsePrinterOptType :: String -> Either String HaddockPrintStyle
parsePrinterOptType String
s =
    case String
s of
      String
"single-line" -> forall a b. b -> Either a b
Right HaddockPrintStyle
HaddockSingleLine
      String
"multi-line" -> forall a b. b -> Either a b
Right HaddockPrintStyle
HaddockMultiLine
      String
"multi-line-compact" -> forall a b. b -> Either a b
Right HaddockPrintStyle
HaddockMultiLineCompact
      String
_ ->
        forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s
          , String
"Valid values are: \"single-line\", \"multi-line\", or \"multi-line-compact\""
          ]

instance Aeson.FromJSON HaddockPrintStyleModule where
  parseJSON :: Value -> Parser HaddockPrintStyleModule
parseJSON =
    \Value
v -> case Value
v of
      Value
Aeson.Null -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyleModule
PrintStyleInherit
      Aeson.String Text
"" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyleModule
PrintStyleInherit
      Value
_ -> HaddockPrintStyle -> HaddockPrintStyleModule
PrintStyleOverride forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v

instance PrinterOptsFieldType HaddockPrintStyleModule where
  parsePrinterOptType :: String -> Either String HaddockPrintStyleModule
parsePrinterOptType =
    \String
s -> case String
s of
      String
"" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyleModule
PrintStyleInherit
      String
_ -> HaddockPrintStyle -> HaddockPrintStyleModule
PrintStyleOverride forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. PrinterOptsFieldType a => String -> Either String a
parsePrinterOptType String
s

instance Aeson.FromJSON ImportExportStyle where
  parseJSON :: Value -> Parser ImportExportStyle
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"ImportExportStyle" forall a b. (a -> b) -> a -> b
$ \Text
s ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> Parser a
Aeson.parseFail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall a. PrinterOptsFieldType a => String -> Either String a
parsePrinterOptType (Text -> String
Text.unpack Text
s)

instance PrinterOptsFieldType ImportExportStyle where
  parsePrinterOptType :: String -> Either String ImportExportStyle
parsePrinterOptType String
s =
    case String
s of
      String
"leading" -> forall a b. b -> Either a b
Right ImportExportStyle
ImportExportLeading
      String
"trailing" -> forall a b. b -> Either a b
Right ImportExportStyle
ImportExportTrailing
      String
"diff-friendly" -> forall a b. b -> Either a b
Right ImportExportStyle
ImportExportDiffFriendly
      String
_ ->
        forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s
          , String
"Valid values are: \"leading\", \"trailing\", or \"diff-friendly\""
          ]

instance Aeson.FromJSON LetStyle where
  parseJSON :: Value -> Parser LetStyle
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"LetStyle" forall a b. (a -> b) -> a -> b
$ \Text
s ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> Parser a
Aeson.parseFail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall a. PrinterOptsFieldType a => String -> Either String a
parsePrinterOptType (Text -> String
Text.unpack Text
s)

instance PrinterOptsFieldType LetStyle where
  parsePrinterOptType :: String -> Either String LetStyle
parsePrinterOptType String
s =
    case String
s of
      String
"auto" -> forall a b. b -> Either a b
Right LetStyle
LetAuto
      String
"inline" -> forall a b. b -> Either a b
Right LetStyle
LetInline
      String
"newline" -> forall a b. b -> Either a b
Right LetStyle
LetNewline
      String
"mixed" -> forall a b. b -> Either a b
Right LetStyle
LetMixed
      String
_ ->
        forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s
          , String
"Valid values are: \"auto\", \"inline\", \"newline\", or \"mixed\""
          ]

instance Aeson.FromJSON InStyle where
  parseJSON :: Value -> Parser InStyle
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"InStyle" forall a b. (a -> b) -> a -> b
$ \Text
s ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> Parser a
Aeson.parseFail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall a. PrinterOptsFieldType a => String -> Either String a
parsePrinterOptType (Text -> String
Text.unpack Text
s)

instance PrinterOptsFieldType InStyle where
  parsePrinterOptType :: String -> Either String InStyle
parsePrinterOptType String
s =
    case String
s of
      String
"left-align" -> forall a b. b -> Either a b
Right InStyle
InLeftAlign
      String
"right-align" -> forall a b. b -> Either a b
Right InStyle
InRightAlign
      String
"no-space" -> forall a b. b -> Either a b
Right InStyle
InNoSpace
      String
_ ->
        forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s
          , String
"Valid values are: \"left-align\", \"right-align\", or \"no-space\""
          ]

instance Aeson.FromJSON Unicode where
  parseJSON :: Value -> Parser Unicode
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Unicode" forall a b. (a -> b) -> a -> b
$ \Text
s ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> Parser a
Aeson.parseFail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall a. PrinterOptsFieldType a => String -> Either String a
parsePrinterOptType (Text -> String
Text.unpack Text
s)

instance PrinterOptsFieldType Unicode where
  parsePrinterOptType :: String -> Either String Unicode
parsePrinterOptType String
s =
    case String
s of
      String
"detect" -> forall a b. b -> Either a b
Right Unicode
UnicodeDetect
      String
"always" -> forall a b. b -> Either a b
Right Unicode
UnicodeAlways
      String
"never" -> forall a b. b -> Either a b
Right Unicode
UnicodeNever
      String
_ ->
        forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s
          , String
"Valid values are: \"detect\", \"always\", or \"never\""
          ]

instance Aeson.FromJSON SingleConstraintParens where
  parseJSON :: Value -> Parser SingleConstraintParens
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"SingleConstraintParens" forall a b. (a -> b) -> a -> b
$ \Text
s ->
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> Parser a
Aeson.parseFail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall a. PrinterOptsFieldType a => String -> Either String a
parsePrinterOptType (Text -> String
Text.unpack Text
s)

instance PrinterOptsFieldType SingleConstraintParens where
  parsePrinterOptType :: String -> Either String SingleConstraintParens
parsePrinterOptType String
s =
    case String
s of
      String
"auto" -> forall a b. b -> Either a b
Right SingleConstraintParens
ConstraintAuto
      String
"always" -> forall a b. b -> Either a b
Right SingleConstraintParens
ConstraintAlways
      String
"never" -> forall a b. b -> Either a b
Right SingleConstraintParens
ConstraintNever
      String
_ ->
        forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s
          , String
"Valid values are: \"auto\", \"always\", or \"never\""
          ]

instance Aeson.FromJSON ColumnLimit where
  parseJSON :: Value -> Parser ColumnLimit
parseJSON =
    \case
       Aeson.String Text
"none" ->
         forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnLimit
NoLimit
       Aeson.Number Scientific
x
         | Right Int
x' <- (forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
x :: Either Double Int) ->
             forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> ColumnLimit
ColumnLimit Int
x'
       Value
s ->
         forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
           [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Value
s,
             String
"Valid values are: \"none\", or an integer"
           ]

instance PrinterOptsFieldType ColumnLimit where
  parsePrinterOptType :: String -> Either String ColumnLimit
parsePrinterOptType =
    \String
s ->
      case String
s of
        String
"none" -> forall a b. b -> Either a b
Right ColumnLimit
NoLimit
        String
_
          | Just Int
someInt <- forall a. Read a => String -> Maybe a
readMaybe String
s ->
              forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ColumnLimit
ColumnLimit forall a b. (a -> b) -> a -> b
$ Int
someInt
        String
_ ->
          forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
            [ String
"unknown value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s,
              String
"Valid values are: \"none\", or an integer"
            ]

defaultPrinterOptsYaml :: String
defaultPrinterOptsYaml :: String
defaultPrinterOptsYaml =
  [String] -> String
unlines
    [ String
"# Number of spaces per indentation step"
    , String
"indentation: 4"
    , String
""
    , String
"# Max line length for automatic line breaking"
    , String
"column-limit: none"
    , String
""
    , String
"# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)"
    , String
"function-arrows: trailing"
    , String
""
    , String
"# How to place commas in multi-line lists, records, etc. (choices: leading or trailing)"
    , String
"comma-style: leading"
    , String
""
    , String
"# Styling of import/export lists (choices: leading, trailing, or diff-friendly)"
    , String
"import-export-style: diff-friendly"
    , String
""
    , String
"# Whether to full-indent or half-indent 'where' bindings past the preceding body"
    , String
"indent-wheres: false"
    , String
""
    , String
"# Whether to leave a space before an opening record brace"
    , String
"record-brace-space: false"
    , String
""
    , String
"# Number of spaces between top-level declarations"
    , String
"newlines-between-decls: 1"
    , String
""
    , String
"# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)"
    , String
"haddock-style: multi-line"
    , String
""
    , String
"# How to print module docstring"
    , String
"haddock-style-module: null"
    , String
""
    , String
"# Styling of let blocks (choices: auto, inline, newline, or mixed)"
    , String
"let-style: auto"
    , String
""
    , String
"# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)"
    , String
"in-style: right-align"
    , String
""
    , String
"# Whether to put parentheses around a single constraint (choices: auto, always, or never)"
    , String
"single-constraint-parens: always"
    , String
""
    , String
"# Output Unicode syntax (choices: detect, always, or never)"
    , String
"unicode: never"
    , String
""
    , String
"# Give the programmer more choice on where to insert blank lines"
    , String
"respectful: true"
    , String
""
    , String
"# Fixity information for operators"
    , String
"fixities: []"
    , String
""
    , String
"# Module reexports Fourmolu should know about"
    , String
"reexports: []"
    ]