{- 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 (..)
  , SingleDerivingParens (..)
  , 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
    , -- | Whether to put parentheses around a single deriving class
      forall (f :: * -> *). PrinterOpts f -> f SingleDerivingParens
poSingleDerivingParens :: f SingleDerivingParens
    , -- | 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 x. PrinterOpts f -> Rep (PrinterOpts f) x)
-> (forall x. Rep (PrinterOpts f) x -> PrinterOpts f)
-> Generic (PrinterOpts f)
forall x. Rep (PrinterOpts f) x -> PrinterOpts f
forall x. PrinterOpts f -> Rep (PrinterOpts f) x
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
$cfrom :: forall (f :: * -> *) x. PrinterOpts f -> Rep (PrinterOpts f) x
from :: forall x. PrinterOpts f -> Rep (PrinterOpts f) x
$cto :: forall (f :: * -> *) x. Rep (PrinterOpts f) x -> PrinterOpts f
to :: forall x. Rep (PrinterOpts f) x -> PrinterOpts f
Generic)

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

defaultPrinterOpts :: PrinterOpts Identity
defaultPrinterOpts :: PrinterOpts Identity
defaultPrinterOpts =
  PrinterOpts
    { poIndentation :: Identity Int
poIndentation = Int -> Identity Int
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
4
    , poColumnLimit :: Identity ColumnLimit
poColumnLimit = ColumnLimit -> Identity ColumnLimit
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnLimit
NoLimit
    , poFunctionArrows :: Identity FunctionArrowsStyle
poFunctionArrows = FunctionArrowsStyle -> Identity FunctionArrowsStyle
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunctionArrowsStyle
TrailingArrows
    , poCommaStyle :: Identity CommaStyle
poCommaStyle = CommaStyle -> Identity CommaStyle
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CommaStyle
Leading
    , poImportExportStyle :: Identity ImportExportStyle
poImportExportStyle = ImportExportStyle -> Identity ImportExportStyle
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportExportStyle
ImportExportDiffFriendly
    , poIndentWheres :: Identity Bool
poIndentWheres = Bool -> Identity Bool
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    , poRecordBraceSpace :: Identity Bool
poRecordBraceSpace = Bool -> Identity Bool
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    , poNewlinesBetweenDecls :: Identity Int
poNewlinesBetweenDecls = Int -> Identity Int
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1
    , poHaddockStyle :: Identity HaddockPrintStyle
poHaddockStyle = HaddockPrintStyle -> Identity HaddockPrintStyle
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyle
HaddockMultiLine
    , poHaddockStyleModule :: Identity HaddockPrintStyleModule
poHaddockStyleModule = HaddockPrintStyleModule -> Identity HaddockPrintStyleModule
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyleModule
PrintStyleInherit
    , poLetStyle :: Identity LetStyle
poLetStyle = LetStyle -> Identity LetStyle
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LetStyle
LetAuto
    , poInStyle :: Identity InStyle
poInStyle = InStyle -> Identity InStyle
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InStyle
InRightAlign
    , poSingleConstraintParens :: Identity SingleConstraintParens
poSingleConstraintParens = SingleConstraintParens -> Identity SingleConstraintParens
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleConstraintParens
ConstraintAlways
    , poSingleDerivingParens :: Identity SingleDerivingParens
poSingleDerivingParens = SingleDerivingParens -> Identity SingleDerivingParens
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleDerivingParens
DerivingAlways
    , poUnicode :: Identity Unicode
poUnicode = Unicode -> Identity Unicode
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unicode
UnicodeNever
    , poRespectful :: Identity Bool
poRespectful = Bool -> Identity Bool
forall a. a -> Identity a
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 = f Int -> (Int -> f Int) -> Maybe Int -> f Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f Int
forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation PrinterOpts f
p2) Int -> f Int
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe Int
forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation PrinterOpts Maybe
p1)
    , poColumnLimit :: f ColumnLimit
poColumnLimit = f ColumnLimit
-> (ColumnLimit -> f ColumnLimit)
-> Maybe ColumnLimit
-> f ColumnLimit
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f ColumnLimit
forall (f :: * -> *). PrinterOpts f -> f ColumnLimit
poColumnLimit PrinterOpts f
p2) ColumnLimit -> f ColumnLimit
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe ColumnLimit
forall (f :: * -> *). PrinterOpts f -> f ColumnLimit
poColumnLimit PrinterOpts Maybe
p1)
    , poFunctionArrows :: f FunctionArrowsStyle
poFunctionArrows = f FunctionArrowsStyle
-> (FunctionArrowsStyle -> f FunctionArrowsStyle)
-> Maybe FunctionArrowsStyle
-> f FunctionArrowsStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f FunctionArrowsStyle
forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle
poFunctionArrows PrinterOpts f
p2) FunctionArrowsStyle -> f FunctionArrowsStyle
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe FunctionArrowsStyle
forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle
poFunctionArrows PrinterOpts Maybe
p1)
    , poCommaStyle :: f CommaStyle
poCommaStyle = f CommaStyle
-> (CommaStyle -> f CommaStyle) -> Maybe CommaStyle -> f CommaStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f CommaStyle
forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle PrinterOpts f
p2) CommaStyle -> f CommaStyle
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe CommaStyle
forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle PrinterOpts Maybe
p1)
    , poImportExportStyle :: f ImportExportStyle
poImportExportStyle = f ImportExportStyle
-> (ImportExportStyle -> f ImportExportStyle)
-> Maybe ImportExportStyle
-> f ImportExportStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f ImportExportStyle
forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle PrinterOpts f
p2) ImportExportStyle -> f ImportExportStyle
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe ImportExportStyle
forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle PrinterOpts Maybe
p1)
    , poIndentWheres :: f Bool
poIndentWheres = f Bool -> (Bool -> f Bool) -> Maybe Bool -> f Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f Bool
forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres PrinterOpts f
p2) Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe Bool
forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres PrinterOpts Maybe
p1)
    , poRecordBraceSpace :: f Bool
poRecordBraceSpace = f Bool -> (Bool -> f Bool) -> Maybe Bool -> f Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f Bool
forall (f :: * -> *). PrinterOpts f -> f Bool
poRecordBraceSpace PrinterOpts f
p2) Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe Bool
forall (f :: * -> *). PrinterOpts f -> f Bool
poRecordBraceSpace PrinterOpts Maybe
p1)
    , poNewlinesBetweenDecls :: f Int
poNewlinesBetweenDecls = f Int -> (Int -> f Int) -> Maybe Int -> f Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f Int
forall (f :: * -> *). PrinterOpts f -> f Int
poNewlinesBetweenDecls PrinterOpts f
p2) Int -> f Int
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe Int
forall (f :: * -> *). PrinterOpts f -> f Int
poNewlinesBetweenDecls PrinterOpts Maybe
p1)
    , poHaddockStyle :: f HaddockPrintStyle
poHaddockStyle = f HaddockPrintStyle
-> (HaddockPrintStyle -> f HaddockPrintStyle)
-> Maybe HaddockPrintStyle
-> f HaddockPrintStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f HaddockPrintStyle
forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyle
poHaddockStyle PrinterOpts f
p2) HaddockPrintStyle -> f HaddockPrintStyle
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe HaddockPrintStyle
forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyle
poHaddockStyle PrinterOpts Maybe
p1)
    , poHaddockStyleModule :: f HaddockPrintStyleModule
poHaddockStyleModule = f HaddockPrintStyleModule
-> (HaddockPrintStyleModule -> f HaddockPrintStyleModule)
-> Maybe HaddockPrintStyleModule
-> f HaddockPrintStyleModule
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f HaddockPrintStyleModule
forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyleModule
poHaddockStyleModule PrinterOpts f
p2) HaddockPrintStyleModule -> f HaddockPrintStyleModule
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe HaddockPrintStyleModule
forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyleModule
poHaddockStyleModule PrinterOpts Maybe
p1)
    , poLetStyle :: f LetStyle
poLetStyle = f LetStyle
-> (LetStyle -> f LetStyle) -> Maybe LetStyle -> f LetStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f LetStyle
forall (f :: * -> *). PrinterOpts f -> f LetStyle
poLetStyle PrinterOpts f
p2) LetStyle -> f LetStyle
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe LetStyle
forall (f :: * -> *). PrinterOpts f -> f LetStyle
poLetStyle PrinterOpts Maybe
p1)
    , poInStyle :: f InStyle
poInStyle = f InStyle -> (InStyle -> f InStyle) -> Maybe InStyle -> f InStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f InStyle
forall (f :: * -> *). PrinterOpts f -> f InStyle
poInStyle PrinterOpts f
p2) InStyle -> f InStyle
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe InStyle
forall (f :: * -> *). PrinterOpts f -> f InStyle
poInStyle PrinterOpts Maybe
p1)
    , poSingleConstraintParens :: f SingleConstraintParens
poSingleConstraintParens = f SingleConstraintParens
-> (SingleConstraintParens -> f SingleConstraintParens)
-> Maybe SingleConstraintParens
-> f SingleConstraintParens
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f SingleConstraintParens
forall (f :: * -> *). PrinterOpts f -> f SingleConstraintParens
poSingleConstraintParens PrinterOpts f
p2) SingleConstraintParens -> f SingleConstraintParens
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe SingleConstraintParens
forall (f :: * -> *). PrinterOpts f -> f SingleConstraintParens
poSingleConstraintParens PrinterOpts Maybe
p1)
    , poSingleDerivingParens :: f SingleDerivingParens
poSingleDerivingParens = f SingleDerivingParens
-> (SingleDerivingParens -> f SingleDerivingParens)
-> Maybe SingleDerivingParens
-> f SingleDerivingParens
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f SingleDerivingParens
forall (f :: * -> *). PrinterOpts f -> f SingleDerivingParens
poSingleDerivingParens PrinterOpts f
p2) SingleDerivingParens -> f SingleDerivingParens
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe SingleDerivingParens
forall (f :: * -> *). PrinterOpts f -> f SingleDerivingParens
poSingleDerivingParens PrinterOpts Maybe
p1)
    , poUnicode :: f Unicode
poUnicode = f Unicode -> (Unicode -> f Unicode) -> Maybe Unicode -> f Unicode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f Unicode
forall (f :: * -> *). PrinterOpts f -> f Unicode
poUnicode PrinterOpts f
p2) Unicode -> f Unicode
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe Unicode
forall (f :: * -> *). PrinterOpts f -> f Unicode
poUnicode PrinterOpts Maybe
p1)
    , poRespectful :: f Bool
poRespectful = f Bool -> (Bool -> f Bool) -> Maybe Bool -> f Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrinterOpts f -> f Bool
forall (f :: * -> *). PrinterOpts f -> f Bool
poRespectful PrinterOpts f
p2) Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrinterOpts Maybe -> Maybe Bool
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 =
  (Maybe Int
 -> Maybe ColumnLimit
 -> Maybe FunctionArrowsStyle
 -> Maybe CommaStyle
 -> Maybe ImportExportStyle
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Int
 -> Maybe HaddockPrintStyle
 -> Maybe HaddockPrintStyleModule
 -> Maybe LetStyle
 -> Maybe InStyle
 -> Maybe SingleConstraintParens
 -> Maybe SingleDerivingParens
 -> Maybe Unicode
 -> Maybe Bool
 -> PrinterOpts Maybe)
-> f (Maybe Int
      -> Maybe ColumnLimit
      -> Maybe FunctionArrowsStyle
      -> Maybe CommaStyle
      -> Maybe ImportExportStyle
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
-> Maybe ColumnLimit
-> Maybe FunctionArrowsStyle
-> Maybe CommaStyle
-> Maybe ImportExportStyle
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe HaddockPrintStyle
-> Maybe HaddockPrintStyleModule
-> Maybe LetStyle
-> Maybe InStyle
-> Maybe SingleConstraintParens
-> Maybe SingleDerivingParens
-> Maybe Unicode
-> Maybe Bool
-> PrinterOpts Maybe
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 SingleDerivingParens
-> f Unicode
-> f Bool
-> PrinterOpts f
PrinterOpts
    f (Maybe Int
   -> Maybe ColumnLimit
   -> Maybe FunctionArrowsStyle
   -> Maybe CommaStyle
   -> Maybe ImportExportStyle
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe Int)
-> f (Maybe ColumnLimit
      -> Maybe FunctionArrowsStyle
      -> Maybe CommaStyle
      -> Maybe ImportExportStyle
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe Int)
forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"indentation"
      String
"Number of spaces per indentation step (default: 4)"
      String
"INT"
    f (Maybe ColumnLimit
   -> Maybe FunctionArrowsStyle
   -> Maybe CommaStyle
   -> Maybe ImportExportStyle
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe ColumnLimit)
-> f (Maybe FunctionArrowsStyle
      -> Maybe CommaStyle
      -> Maybe ImportExportStyle
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe ColumnLimit)
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"
    f (Maybe FunctionArrowsStyle
   -> Maybe CommaStyle
   -> Maybe ImportExportStyle
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe FunctionArrowsStyle)
-> f (Maybe CommaStyle
      -> Maybe ImportExportStyle
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe FunctionArrowsStyle)
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"
    f (Maybe CommaStyle
   -> Maybe ImportExportStyle
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe CommaStyle)
-> f (Maybe ImportExportStyle
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe CommaStyle)
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"
    f (Maybe ImportExportStyle
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe ImportExportStyle)
-> f (Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe ImportExportStyle)
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"
    f (Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe Bool)
-> f (Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe Bool)
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"
    f (Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe Bool)
-> f (Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe Bool)
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"
    f (Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe Int)
-> f (Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe Int)
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"
    f (Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe HaddockPrintStyle)
-> f (Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe HaddockPrintStyle)
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"
    f (Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe HaddockPrintStyleModule)
-> f (Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe HaddockPrintStyleModule)
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"
    f (Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe LetStyle)
-> f (Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe LetStyle)
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"
    f (Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe InStyle)
-> f (Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe InStyle)
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"
    f (Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe SingleConstraintParens)
-> f (Maybe SingleDerivingParens
      -> Maybe Unicode -> Maybe Bool -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe SingleConstraintParens)
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"
    f (Maybe SingleDerivingParens
   -> Maybe Unicode -> Maybe Bool -> PrinterOpts Maybe)
-> f (Maybe SingleDerivingParens)
-> f (Maybe Unicode -> Maybe Bool -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe SingleDerivingParens)
forall a.
PrinterOptsFieldType a =>
String -> String -> String -> f (Maybe a)
f
      String
"single-deriving-parens"
      String
"Whether to put parentheses around a single deriving class (choices: \"auto\", \"always\", or \"never\") (default: always)"
      String
"OPTION"
    f (Maybe Unicode -> Maybe Bool -> PrinterOpts Maybe)
-> f (Maybe Unicode) -> f (Maybe Bool -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe Unicode)
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"
    f (Maybe Bool -> PrinterOpts Maybe)
-> f (Maybe Bool) -> f (PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> String -> f (Maybe Bool)
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 =
  (Maybe Int
 -> Maybe ColumnLimit
 -> Maybe FunctionArrowsStyle
 -> Maybe CommaStyle
 -> Maybe ImportExportStyle
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Int
 -> Maybe HaddockPrintStyle
 -> Maybe HaddockPrintStyleModule
 -> Maybe LetStyle
 -> Maybe InStyle
 -> Maybe SingleConstraintParens
 -> Maybe SingleDerivingParens
 -> Maybe Unicode
 -> Maybe Bool
 -> PrinterOpts Maybe)
-> f (Maybe Int
      -> Maybe ColumnLimit
      -> Maybe FunctionArrowsStyle
      -> Maybe CommaStyle
      -> Maybe ImportExportStyle
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
-> Maybe ColumnLimit
-> Maybe FunctionArrowsStyle
-> Maybe CommaStyle
-> Maybe ImportExportStyle
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe HaddockPrintStyle
-> Maybe HaddockPrintStyleModule
-> Maybe LetStyle
-> Maybe InStyle
-> Maybe SingleConstraintParens
-> Maybe SingleDerivingParens
-> Maybe Unicode
-> Maybe Bool
-> PrinterOpts Maybe
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 SingleDerivingParens
-> f Unicode
-> f Bool
-> PrinterOpts f
PrinterOpts
    f (Maybe Int
   -> Maybe ColumnLimit
   -> Maybe FunctionArrowsStyle
   -> Maybe CommaStyle
   -> Maybe ImportExportStyle
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe Int)
-> f (Maybe ColumnLimit
      -> Maybe FunctionArrowsStyle
      -> Maybe CommaStyle
      -> Maybe ImportExportStyle
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe Int)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"indentation"
    f (Maybe ColumnLimit
   -> Maybe FunctionArrowsStyle
   -> Maybe CommaStyle
   -> Maybe ImportExportStyle
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe ColumnLimit)
-> f (Maybe FunctionArrowsStyle
      -> Maybe CommaStyle
      -> Maybe ImportExportStyle
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe ColumnLimit)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"column-limit"
    f (Maybe FunctionArrowsStyle
   -> Maybe CommaStyle
   -> Maybe ImportExportStyle
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe FunctionArrowsStyle)
-> f (Maybe CommaStyle
      -> Maybe ImportExportStyle
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe FunctionArrowsStyle)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"function-arrows"
    f (Maybe CommaStyle
   -> Maybe ImportExportStyle
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe CommaStyle)
-> f (Maybe ImportExportStyle
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe CommaStyle)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"comma-style"
    f (Maybe ImportExportStyle
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe ImportExportStyle)
-> f (Maybe Bool
      -> Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe ImportExportStyle)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"import-export-style"
    f (Maybe Bool
   -> Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe Bool)
-> f (Maybe Bool
      -> Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe Bool)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"indent-wheres"
    f (Maybe Bool
   -> Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe Bool)
-> f (Maybe Int
      -> Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe Bool)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"record-brace-space"
    f (Maybe Int
   -> Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe Int)
-> f (Maybe HaddockPrintStyle
      -> Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe Int)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"newlines-between-decls"
    f (Maybe HaddockPrintStyle
   -> Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe HaddockPrintStyle)
-> f (Maybe HaddockPrintStyleModule
      -> Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe HaddockPrintStyle)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"haddock-style"
    f (Maybe HaddockPrintStyleModule
   -> Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe HaddockPrintStyleModule)
-> f (Maybe LetStyle
      -> Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe HaddockPrintStyleModule)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"haddock-style-module"
    f (Maybe LetStyle
   -> Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe LetStyle)
-> f (Maybe InStyle
      -> Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe LetStyle)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"let-style"
    f (Maybe InStyle
   -> Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe InStyle)
-> f (Maybe SingleConstraintParens
      -> Maybe SingleDerivingParens
      -> Maybe Unicode
      -> Maybe Bool
      -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe InStyle)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"in-style"
    f (Maybe SingleConstraintParens
   -> Maybe SingleDerivingParens
   -> Maybe Unicode
   -> Maybe Bool
   -> PrinterOpts Maybe)
-> f (Maybe SingleConstraintParens)
-> f (Maybe SingleDerivingParens
      -> Maybe Unicode -> Maybe Bool -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe SingleConstraintParens)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"single-constraint-parens"
    f (Maybe SingleDerivingParens
   -> Maybe Unicode -> Maybe Bool -> PrinterOpts Maybe)
-> f (Maybe SingleDerivingParens)
-> f (Maybe Unicode -> Maybe Bool -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe SingleDerivingParens)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"single-deriving-parens"
    f (Maybe Unicode -> Maybe Bool -> PrinterOpts Maybe)
-> f (Maybe Unicode) -> f (Maybe Bool -> PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe Unicode)
forall a. PrinterOptsFieldType a => String -> f (Maybe a)
f String
"unicode"
    f (Maybe Bool -> PrinterOpts Maybe)
-> f (Maybe Bool) -> f (PrinterOpts Maybe)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> f (Maybe Bool)
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 = String -> Either String Int
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" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
      String
"true" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
      String
_ ->
        String -> Either String Bool
forall a b. a -> Either a b
Left (String -> Either String Bool)
-> ([String] -> String) -> [String] -> Either String Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Either String Bool) -> [String] -> Either String Bool
forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
s,
            String
"Valid values are: \"false\" or \"true\""
          ]

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

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

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

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

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

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

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

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

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

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

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

instance Aeson.FromJSON CommaStyle where
  parseJSON :: Value -> Parser CommaStyle
parseJSON =
    String -> (Text -> Parser CommaStyle) -> Value -> Parser CommaStyle
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"CommaStyle" ((Text -> Parser CommaStyle) -> Value -> Parser CommaStyle)
-> (Text -> Parser CommaStyle) -> Value -> Parser CommaStyle
forall a b. (a -> b) -> a -> b
$ \Text
s ->
      (String -> Parser CommaStyle)
-> (CommaStyle -> Parser CommaStyle)
-> Either String CommaStyle
-> Parser CommaStyle
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser CommaStyle
forall a. String -> Parser a
Aeson.parseFail CommaStyle -> Parser CommaStyle
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String CommaStyle -> Parser CommaStyle)
-> Either String CommaStyle -> Parser CommaStyle
forall a b. (a -> b) -> a -> b
$
        String -> Either String CommaStyle
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" -> CommaStyle -> Either String CommaStyle
forall a b. b -> Either a b
Right CommaStyle
Leading
      String
"trailing" -> CommaStyle -> Either String CommaStyle
forall a b. b -> Either a b
Right CommaStyle
Trailing
      String
_ ->
        String -> Either String CommaStyle
forall a b. a -> Either a b
Left (String -> Either String CommaStyle)
-> ([String] -> String) -> [String] -> Either String CommaStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Either String CommaStyle)
-> [String] -> Either String CommaStyle
forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
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 =
    String
-> (Text -> Parser FunctionArrowsStyle)
-> Value
-> Parser FunctionArrowsStyle
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"FunctionArrowsStyle" ((Text -> Parser FunctionArrowsStyle)
 -> Value -> Parser FunctionArrowsStyle)
-> (Text -> Parser FunctionArrowsStyle)
-> Value
-> Parser FunctionArrowsStyle
forall a b. (a -> b) -> a -> b
$ \Text
s ->
      (String -> Parser FunctionArrowsStyle)
-> (FunctionArrowsStyle -> Parser FunctionArrowsStyle)
-> Either String FunctionArrowsStyle
-> Parser FunctionArrowsStyle
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser FunctionArrowsStyle
forall a. String -> Parser a
Aeson.parseFail FunctionArrowsStyle -> Parser FunctionArrowsStyle
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String FunctionArrowsStyle -> Parser FunctionArrowsStyle)
-> Either String FunctionArrowsStyle -> Parser FunctionArrowsStyle
forall a b. (a -> b) -> a -> b
$
        String -> Either String FunctionArrowsStyle
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" -> FunctionArrowsStyle -> Either String FunctionArrowsStyle
forall a b. b -> Either a b
Right FunctionArrowsStyle
TrailingArrows
      String
"leading" -> FunctionArrowsStyle -> Either String FunctionArrowsStyle
forall a b. b -> Either a b
Right FunctionArrowsStyle
LeadingArrows
      String
"leading-args" -> FunctionArrowsStyle -> Either String FunctionArrowsStyle
forall a b. b -> Either a b
Right FunctionArrowsStyle
LeadingArgsArrows
      String
_ ->
        String -> Either String FunctionArrowsStyle
forall a b. a -> Either a b
Left (String -> Either String FunctionArrowsStyle)
-> ([String] -> String)
-> [String]
-> Either String FunctionArrowsStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Either String FunctionArrowsStyle)
-> [String] -> Either String FunctionArrowsStyle
forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
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 =
    String
-> (Text -> Parser HaddockPrintStyle)
-> Value
-> Parser HaddockPrintStyle
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"HaddockPrintStyle" ((Text -> Parser HaddockPrintStyle)
 -> Value -> Parser HaddockPrintStyle)
-> (Text -> Parser HaddockPrintStyle)
-> Value
-> Parser HaddockPrintStyle
forall a b. (a -> b) -> a -> b
$ \Text
s ->
      (String -> Parser HaddockPrintStyle)
-> (HaddockPrintStyle -> Parser HaddockPrintStyle)
-> Either String HaddockPrintStyle
-> Parser HaddockPrintStyle
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser HaddockPrintStyle
forall a. String -> Parser a
Aeson.parseFail HaddockPrintStyle -> Parser HaddockPrintStyle
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String HaddockPrintStyle -> Parser HaddockPrintStyle)
-> Either String HaddockPrintStyle -> Parser HaddockPrintStyle
forall a b. (a -> b) -> a -> b
$
        String -> Either String HaddockPrintStyle
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" -> HaddockPrintStyle -> Either String HaddockPrintStyle
forall a b. b -> Either a b
Right HaddockPrintStyle
HaddockSingleLine
      String
"multi-line" -> HaddockPrintStyle -> Either String HaddockPrintStyle
forall a b. b -> Either a b
Right HaddockPrintStyle
HaddockMultiLine
      String
"multi-line-compact" -> HaddockPrintStyle -> Either String HaddockPrintStyle
forall a b. b -> Either a b
Right HaddockPrintStyle
HaddockMultiLineCompact
      String
_ ->
        String -> Either String HaddockPrintStyle
forall a b. a -> Either a b
Left (String -> Either String HaddockPrintStyle)
-> ([String] -> String)
-> [String]
-> Either String HaddockPrintStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Either String HaddockPrintStyle)
-> [String] -> Either String HaddockPrintStyle
forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
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 -> HaddockPrintStyleModule -> Parser HaddockPrintStyleModule
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyleModule
PrintStyleInherit
      Aeson.String Text
"" -> HaddockPrintStyleModule -> Parser HaddockPrintStyleModule
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyleModule
PrintStyleInherit
      Value
_ -> HaddockPrintStyle -> HaddockPrintStyleModule
PrintStyleOverride (HaddockPrintStyle -> HaddockPrintStyleModule)
-> Parser HaddockPrintStyle -> Parser HaddockPrintStyleModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser HaddockPrintStyle
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
"" -> HaddockPrintStyleModule -> Either String HaddockPrintStyleModule
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HaddockPrintStyleModule
PrintStyleInherit
      String
_ -> HaddockPrintStyle -> HaddockPrintStyleModule
PrintStyleOverride (HaddockPrintStyle -> HaddockPrintStyleModule)
-> Either String HaddockPrintStyle
-> Either String HaddockPrintStyleModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String HaddockPrintStyle
forall a. PrinterOptsFieldType a => String -> Either String a
parsePrinterOptType String
s

instance Aeson.FromJSON ImportExportStyle where
  parseJSON :: Value -> Parser ImportExportStyle
parseJSON =
    String
-> (Text -> Parser ImportExportStyle)
-> Value
-> Parser ImportExportStyle
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"ImportExportStyle" ((Text -> Parser ImportExportStyle)
 -> Value -> Parser ImportExportStyle)
-> (Text -> Parser ImportExportStyle)
-> Value
-> Parser ImportExportStyle
forall a b. (a -> b) -> a -> b
$ \Text
s ->
      (String -> Parser ImportExportStyle)
-> (ImportExportStyle -> Parser ImportExportStyle)
-> Either String ImportExportStyle
-> Parser ImportExportStyle
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ImportExportStyle
forall a. String -> Parser a
Aeson.parseFail ImportExportStyle -> Parser ImportExportStyle
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ImportExportStyle -> Parser ImportExportStyle)
-> Either String ImportExportStyle -> Parser ImportExportStyle
forall a b. (a -> b) -> a -> b
$
        String -> Either String ImportExportStyle
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" -> ImportExportStyle -> Either String ImportExportStyle
forall a b. b -> Either a b
Right ImportExportStyle
ImportExportLeading
      String
"trailing" -> ImportExportStyle -> Either String ImportExportStyle
forall a b. b -> Either a b
Right ImportExportStyle
ImportExportTrailing
      String
"diff-friendly" -> ImportExportStyle -> Either String ImportExportStyle
forall a b. b -> Either a b
Right ImportExportStyle
ImportExportDiffFriendly
      String
_ ->
        String -> Either String ImportExportStyle
forall a b. a -> Either a b
Left (String -> Either String ImportExportStyle)
-> ([String] -> String)
-> [String]
-> Either String ImportExportStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Either String ImportExportStyle)
-> [String] -> Either String ImportExportStyle
forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
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 =
    String -> (Text -> Parser LetStyle) -> Value -> Parser LetStyle
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"LetStyle" ((Text -> Parser LetStyle) -> Value -> Parser LetStyle)
-> (Text -> Parser LetStyle) -> Value -> Parser LetStyle
forall a b. (a -> b) -> a -> b
$ \Text
s ->
      (String -> Parser LetStyle)
-> (LetStyle -> Parser LetStyle)
-> Either String LetStyle
-> Parser LetStyle
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser LetStyle
forall a. String -> Parser a
Aeson.parseFail LetStyle -> Parser LetStyle
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String LetStyle -> Parser LetStyle)
-> Either String LetStyle -> Parser LetStyle
forall a b. (a -> b) -> a -> b
$
        String -> Either String LetStyle
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" -> LetStyle -> Either String LetStyle
forall a b. b -> Either a b
Right LetStyle
LetAuto
      String
"inline" -> LetStyle -> Either String LetStyle
forall a b. b -> Either a b
Right LetStyle
LetInline
      String
"newline" -> LetStyle -> Either String LetStyle
forall a b. b -> Either a b
Right LetStyle
LetNewline
      String
"mixed" -> LetStyle -> Either String LetStyle
forall a b. b -> Either a b
Right LetStyle
LetMixed
      String
_ ->
        String -> Either String LetStyle
forall a b. a -> Either a b
Left (String -> Either String LetStyle)
-> ([String] -> String) -> [String] -> Either String LetStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Either String LetStyle)
-> [String] -> Either String LetStyle
forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
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 =
    String -> (Text -> Parser InStyle) -> Value -> Parser InStyle
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"InStyle" ((Text -> Parser InStyle) -> Value -> Parser InStyle)
-> (Text -> Parser InStyle) -> Value -> Parser InStyle
forall a b. (a -> b) -> a -> b
$ \Text
s ->
      (String -> Parser InStyle)
-> (InStyle -> Parser InStyle)
-> Either String InStyle
-> Parser InStyle
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser InStyle
forall a. String -> Parser a
Aeson.parseFail InStyle -> Parser InStyle
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String InStyle -> Parser InStyle)
-> Either String InStyle -> Parser InStyle
forall a b. (a -> b) -> a -> b
$
        String -> Either String InStyle
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" -> InStyle -> Either String InStyle
forall a b. b -> Either a b
Right InStyle
InLeftAlign
      String
"right-align" -> InStyle -> Either String InStyle
forall a b. b -> Either a b
Right InStyle
InRightAlign
      String
"no-space" -> InStyle -> Either String InStyle
forall a b. b -> Either a b
Right InStyle
InNoSpace
      String
_ ->
        String -> Either String InStyle
forall a b. a -> Either a b
Left (String -> Either String InStyle)
-> ([String] -> String) -> [String] -> Either String InStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Either String InStyle)
-> [String] -> Either String InStyle
forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
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 =
    String -> (Text -> Parser Unicode) -> Value -> Parser Unicode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Unicode" ((Text -> Parser Unicode) -> Value -> Parser Unicode)
-> (Text -> Parser Unicode) -> Value -> Parser Unicode
forall a b. (a -> b) -> a -> b
$ \Text
s ->
      (String -> Parser Unicode)
-> (Unicode -> Parser Unicode)
-> Either String Unicode
-> Parser Unicode
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Unicode
forall a. String -> Parser a
Aeson.parseFail Unicode -> Parser Unicode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Unicode -> Parser Unicode)
-> Either String Unicode -> Parser Unicode
forall a b. (a -> b) -> a -> b
$
        String -> Either String Unicode
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" -> Unicode -> Either String Unicode
forall a b. b -> Either a b
Right Unicode
UnicodeDetect
      String
"always" -> Unicode -> Either String Unicode
forall a b. b -> Either a b
Right Unicode
UnicodeAlways
      String
"never" -> Unicode -> Either String Unicode
forall a b. b -> Either a b
Right Unicode
UnicodeNever
      String
_ ->
        String -> Either String Unicode
forall a b. a -> Either a b
Left (String -> Either String Unicode)
-> ([String] -> String) -> [String] -> Either String Unicode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Either String Unicode)
-> [String] -> Either String Unicode
forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
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 =
    String
-> (Text -> Parser SingleConstraintParens)
-> Value
-> Parser SingleConstraintParens
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"SingleConstraintParens" ((Text -> Parser SingleConstraintParens)
 -> Value -> Parser SingleConstraintParens)
-> (Text -> Parser SingleConstraintParens)
-> Value
-> Parser SingleConstraintParens
forall a b. (a -> b) -> a -> b
$ \Text
s ->
      (String -> Parser SingleConstraintParens)
-> (SingleConstraintParens -> Parser SingleConstraintParens)
-> Either String SingleConstraintParens
-> Parser SingleConstraintParens
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser SingleConstraintParens
forall a. String -> Parser a
Aeson.parseFail SingleConstraintParens -> Parser SingleConstraintParens
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String SingleConstraintParens
 -> Parser SingleConstraintParens)
-> Either String SingleConstraintParens
-> Parser SingleConstraintParens
forall a b. (a -> b) -> a -> b
$
        String -> Either String SingleConstraintParens
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" -> SingleConstraintParens -> Either String SingleConstraintParens
forall a b. b -> Either a b
Right SingleConstraintParens
ConstraintAuto
      String
"always" -> SingleConstraintParens -> Either String SingleConstraintParens
forall a b. b -> Either a b
Right SingleConstraintParens
ConstraintAlways
      String
"never" -> SingleConstraintParens -> Either String SingleConstraintParens
forall a b. b -> Either a b
Right SingleConstraintParens
ConstraintNever
      String
_ ->
        String -> Either String SingleConstraintParens
forall a b. a -> Either a b
Left (String -> Either String SingleConstraintParens)
-> ([String] -> String)
-> [String]
-> Either String SingleConstraintParens
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Either String SingleConstraintParens)
-> [String] -> Either String SingleConstraintParens
forall a b. (a -> b) -> a -> b
$
          [ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
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" ->
         ColumnLimit -> Parser ColumnLimit
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnLimit
NoLimit
       Aeson.Number Scientific
x
         | Right Int
x' <- (Scientific -> Either Double Int
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
x :: Either Double Int) ->
             ColumnLimit -> Parser ColumnLimit
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColumnLimit -> Parser ColumnLimit)
-> ColumnLimit -> Parser ColumnLimit
forall a b. (a -> b) -> a -> b
$ Int -> ColumnLimit
ColumnLimit Int
x'
       Value
s ->
         String -> Parser ColumnLimit
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ColumnLimit)
-> ([String] -> String) -> [String] -> Parser ColumnLimit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Parser ColumnLimit) -> [String] -> Parser ColumnLimit
forall a b. (a -> b) -> a -> b
$
           [ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
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" -> ColumnLimit -> Either String ColumnLimit
forall a b. b -> Either a b
Right ColumnLimit
NoLimit
        String
_
          | Just Int
someInt <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
s ->
              ColumnLimit -> Either String ColumnLimit
forall a b. b -> Either a b
Right (ColumnLimit -> Either String ColumnLimit)
-> (Int -> ColumnLimit) -> Int -> Either String ColumnLimit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ColumnLimit
ColumnLimit (Int -> Either String ColumnLimit)
-> Int -> Either String ColumnLimit
forall a b. (a -> b) -> a -> b
$ Int
someInt
        String
_ ->
          String -> Either String ColumnLimit
forall a b. a -> Either a b
Left (String -> Either String ColumnLimit)
-> ([String] -> String) -> [String] -> Either String ColumnLimit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Either String ColumnLimit)
-> [String] -> Either String ColumnLimit
forall a b. (a -> b) -> a -> b
$
            [ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
s,
              String
"Valid values are: \"none\", or an integer"
            ]

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

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

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
"# Whether to put parentheses around a single deriving class (choices: auto, always, or never)"
    , String
"single-deriving-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: []"
    ]