Gen.hs

{- 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 (..)
  , HaddockLocSignature (..)
  , ImportExportStyle (..)
  , LetStyle (..)
  , InStyle (..)
  , IfStyle (..)
  , Unicode (..)
  , SingleConstraintParens (..)
  , ColumnLimit (..)
  , SingleDerivingParens (..)
  , ImportGrouping (..)
  , emptyPrinterOpts
  , defaultPrinterOpts
  , defaultPrinterOptsYaml
  , fillMissingPrinterOpts
  , parsePrinterOptsCLI
  , parsePrinterOptsJSON
  , parsePrinterOptType
  , renderPrinterOpt
  )
where

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

-- | Options controlling formatting output.
data PrinterOpts f =
  PrinterOpts
    { -- | Number of spaces per indentation step
      poIndentation :: f Int
    , -- | Max line length for automatic line breaking
      poColumnLimit :: f ColumnLimit
    , -- | Styling of arrows in type signatures
      poFunctionArrows :: f FunctionArrowsStyle
    , -- | How to place commas in multi-line lists, records, etc.
      poCommaStyle :: f CommaStyle
    , -- | Styling of import/export lists
      poImportExportStyle :: f ImportExportStyle
    , -- | Rules for grouping import declarations
      poImportGrouping :: f ImportGrouping
    , -- | Whether to full-indent or half-indent 'where' bindings past the preceding body
      poIndentWheres :: f Bool
    , -- | Whether to leave a space before an opening record brace
      poRecordBraceSpace :: f Bool
    , -- | Number of spaces between top-level declarations
      poNewlinesBetweenDecls :: f Int
    , -- | How to print Haddock comments
      poHaddockStyle :: f HaddockPrintStyle
    , -- | How to print module docstring
      poHaddockStyleModule :: f HaddockPrintStyleModule
    , -- | Where to put docstring comments in function signatures
      poHaddockLocSignature :: f HaddockLocSignature
    , -- | Styling of let blocks
      poLetStyle :: f LetStyle
    , -- | How to align the 'in' keyword with respect to the 'let' keyword
      poInStyle :: f InStyle
    , -- | Styling of if-statements
      poIfStyle :: f IfStyle
    , -- | Whether to put parentheses around a single constraint
      poSingleConstraintParens :: f SingleConstraintParens
    , -- | Whether to put parentheses around a single deriving class
      poSingleDerivingParens :: f SingleDerivingParens
    , -- | Whether to sort constraints
      poSortConstraints :: f Bool
    , -- | Whether to sort derived classes
      poSortDerivedClasses :: f Bool
    , -- | Whether to sort deriving clauses
      poSortDerivingClauses :: f Bool
    , -- | Whether to place section operators (those that are infixr 0, such as $) in trailing position, continuing the expression indented below
      poTrailingSectionOperators :: f Bool
    , -- | Output Unicode syntax
      poUnicode :: f Unicode
    , -- | Give the programmer more choice on where to insert blank lines
      poRespectful :: f Bool
    }
  deriving (Generic)

emptyPrinterOpts :: PrinterOpts Maybe
emptyPrinterOpts =
  PrinterOpts
    { poIndentation = Nothing
    , poColumnLimit = Nothing
    , poFunctionArrows = Nothing
    , poCommaStyle = Nothing
    , poImportExportStyle = Nothing
    , poImportGrouping = Nothing
    , poIndentWheres = Nothing
    , poRecordBraceSpace = Nothing
    , poNewlinesBetweenDecls = Nothing
    , poHaddockStyle = Nothing
    , poHaddockStyleModule = Nothing
    , poHaddockLocSignature = Nothing
    , poLetStyle = Nothing
    , poInStyle = Nothing
    , poIfStyle = Nothing
    , poSingleConstraintParens = Nothing
    , poSingleDerivingParens = Nothing
    , poSortConstraints = Nothing
    , poSortDerivedClasses = Nothing
    , poSortDerivingClauses = Nothing
    , poTrailingSectionOperators = Nothing
    , poUnicode = Nothing
    , poRespectful = Nothing
    }

defaultPrinterOpts :: PrinterOpts Identity
defaultPrinterOpts =
  PrinterOpts
    { poIndentation = pure 4
    , poColumnLimit = pure NoLimit
    , poFunctionArrows = pure TrailingArrows
    , poCommaStyle = pure Leading
    , poImportExportStyle = pure ImportExportDiffFriendly
    , poImportGrouping = pure ImportGroupLegacy
    , poIndentWheres = pure False
    , poRecordBraceSpace = pure False
    , poNewlinesBetweenDecls = pure 1
    , poHaddockStyle = pure HaddockMultiLine
    , poHaddockStyleModule = pure PrintStyleInherit
    , poHaddockLocSignature = pure HaddockLocSigAuto
    , poLetStyle = pure LetAuto
    , poInStyle = pure InRightAlign
    , poIfStyle = pure IfIndented
    , poSingleConstraintParens = pure ConstraintAlways
    , poSingleDerivingParens = pure DerivingAlways
    , poSortConstraints = pure False
    , poSortDerivedClasses = pure False
    , poSortDerivingClauses = pure False
    , poTrailingSectionOperators = pure True
    , poUnicode = pure UnicodeNever
    , poRespectful = pure 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 p1 p2 =
  PrinterOpts
    { poIndentation = maybe (poIndentation p2) pure (poIndentation p1)
    , poColumnLimit = maybe (poColumnLimit p2) pure (poColumnLimit p1)
    , poFunctionArrows = maybe (poFunctionArrows p2) pure (poFunctionArrows p1)
    , poCommaStyle = maybe (poCommaStyle p2) pure (poCommaStyle p1)
    , poImportExportStyle = maybe (poImportExportStyle p2) pure (poImportExportStyle p1)
    , poImportGrouping = maybe (poImportGrouping p2) pure (poImportGrouping p1)
    , poIndentWheres = maybe (poIndentWheres p2) pure (poIndentWheres p1)
    , poRecordBraceSpace = maybe (poRecordBraceSpace p2) pure (poRecordBraceSpace p1)
    , poNewlinesBetweenDecls = maybe (poNewlinesBetweenDecls p2) pure (poNewlinesBetweenDecls p1)
    , poHaddockStyle = maybe (poHaddockStyle p2) pure (poHaddockStyle p1)
    , poHaddockStyleModule = maybe (poHaddockStyleModule p2) pure (poHaddockStyleModule p1)
    , poHaddockLocSignature = maybe (poHaddockLocSignature p2) pure (poHaddockLocSignature p1)
    , poLetStyle = maybe (poLetStyle p2) pure (poLetStyle p1)
    , poInStyle = maybe (poInStyle p2) pure (poInStyle p1)
    , poIfStyle = maybe (poIfStyle p2) pure (poIfStyle p1)
    , poSingleConstraintParens = maybe (poSingleConstraintParens p2) pure (poSingleConstraintParens p1)
    , poSingleDerivingParens = maybe (poSingleDerivingParens p2) pure (poSingleDerivingParens p1)
    , poSortConstraints = maybe (poSortConstraints p2) pure (poSortConstraints p1)
    , poSortDerivedClasses = maybe (poSortDerivedClasses p2) pure (poSortDerivedClasses p1)
    , poSortDerivingClauses = maybe (poSortDerivingClauses p2) pure (poSortDerivingClauses p1)
    , poTrailingSectionOperators = maybe (poTrailingSectionOperators p2) pure (poTrailingSectionOperators p1)
    , poUnicode = maybe (poUnicode p2) pure (poUnicode p1)
    , poRespectful = maybe (poRespectful p2) pure (poRespectful p1)
    }

parsePrinterOptsCLI ::
  Applicative f =>
  (forall a. PrinterOptsFieldType a => String -> String -> String -> f (Maybe a)) ->
  f (PrinterOpts Maybe)
parsePrinterOptsCLI f =
  pure PrinterOpts
    <*> f
      "indentation"
      "Number of spaces per indentation step (default: 4)"
      "INT"
    <*> f
      "column-limit"
      "Max line length for automatic line breaking (default: none)"
      "OPTION"
    <*> f
      "function-arrows"
      "Styling of arrows in type signatures (choices: \"trailing\", \"leading\", or \"leading-args\") (default: trailing)"
      "OPTION"
    <*> f
      "comma-style"
      "How to place commas in multi-line lists, records, etc. (choices: \"leading\" or \"trailing\") (default: leading)"
      "OPTION"
    <*> f
      "import-export-style"
      "Styling of import/export lists (choices: \"leading\", \"trailing\", or \"diff-friendly\") (default: diff-friendly)"
      "OPTION"
    <*> f
      "import-grouping"
      "Rules for grouping import declarations (default: legacy)"
      "OPTION"
    <*> f
      "indent-wheres"
      "Whether to full-indent or half-indent 'where' bindings past the preceding body (default: false)"
      "BOOL"
    <*> f
      "record-brace-space"
      "Whether to leave a space before an opening record brace (default: false)"
      "BOOL"
    <*> f
      "newlines-between-decls"
      "Number of spaces between top-level declarations (default: 1)"
      "INT"
    <*> f
      "haddock-style"
      "How to print Haddock comments (choices: \"single-line\", \"multi-line\", or \"multi-line-compact\") (default: multi-line)"
      "OPTION"
    <*> f
      "haddock-style-module"
      "How to print module docstring (default: same as 'haddock-style')"
      "OPTION"
    <*> f
      "haddock-location-signature"
      "Where to put docstring comments in function signatures (choices: \"auto\", \"leading\", or \"trailing\") (default: leading if function-arrows is trailing, or vice-versa)"
      "OPTION"
    <*> f
      "let-style"
      "Styling of let blocks (choices: \"auto\", \"inline\", \"newline\", or \"mixed\") (default: auto)"
      "OPTION"
    <*> f
      "in-style"
      "How to align the 'in' keyword with respect to the 'let' keyword (choices: \"left-align\", \"right-align\", or \"no-space\") (default: right-align)"
      "OPTION"
    <*> f
      "if-style"
      "Styling of if-statements (choices: \"indented\" or \"hanging\") (default: indented)"
      "OPTION"
    <*> f
      "single-constraint-parens"
      "Whether to put parentheses around a single constraint (choices: \"auto\", \"always\", or \"never\") (default: always)"
      "OPTION"
    <*> f
      "single-deriving-parens"
      "Whether to put parentheses around a single deriving class (choices: \"auto\", \"always\", or \"never\") (default: always)"
      "OPTION"
    <*> f
      "sort-constraints"
      "Whether to sort constraints (default: false)"
      "BOOL"
    <*> f
      "sort-derived-classes"
      "Whether to sort derived classes (default: false)"
      "BOOL"
    <*> f
      "sort-deriving-clauses"
      "Whether to sort deriving clauses (default: false)"
      "BOOL"
    <*> f
      "trailing-section-operators"
      "Whether to place section operators (those that are infixr 0, such as $) in trailing position, continuing the expression indented below (default: true)"
      "BOOL"
    <*> f
      "unicode"
      "Output Unicode syntax (choices: \"detect\", \"always\", or \"never\") (default: never)"
      "OPTION"
    <*> f
      "respectful"
      "Give the programmer more choice on where to insert blank lines (default: true)"
      "BOOL"

parsePrinterOptsJSON ::
  Applicative f =>
  (forall a. PrinterOptsFieldType a => String -> f (Maybe a)) ->
  f (PrinterOpts Maybe)
parsePrinterOptsJSON f =
  pure PrinterOpts
    <*> f "indentation"
    <*> f "column-limit"
    <*> f "function-arrows"
    <*> f "comma-style"
    <*> f "import-export-style"
    <*> f "import-grouping"
    <*> f "indent-wheres"
    <*> f "record-brace-space"
    <*> f "newlines-between-decls"
    <*> f "haddock-style"
    <*> f "haddock-style-module"
    <*> f "haddock-location-signature"
    <*> f "let-style"
    <*> f "in-style"
    <*> f "if-style"
    <*> f "single-constraint-parens"
    <*> f "single-deriving-parens"
    <*> f "sort-constraints"
    <*> f "sort-derived-classes"
    <*> f "sort-deriving-clauses"
    <*> f "trailing-section-operators"
    <*> f "unicode"
    <*> f "respectful"

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

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

instance PrinterOptsFieldType Int where
  parsePrinterOptType = readEither

instance PrinterOptsFieldType Bool where
  parsePrinterOptType s =
    case s of
      "false" -> Right False
      "true" -> Right True
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s,
            "Valid values are: \"false\" or \"true\""
          ]

class RenderPrinterOpt a where
  renderPrinterOpt :: a -> String

instance RenderPrinterOpt Int where
  renderPrinterOpt = show

instance RenderPrinterOpt Bool where
  renderPrinterOpt = show

data CommaStyle
  = Leading
  | Trailing
  deriving (Eq, Show, Enum, Bounded)

data FunctionArrowsStyle
  = TrailingArrows
  | LeadingArrows
  | LeadingArgsArrows
  deriving (Eq, Show, Enum, Bounded)

data HaddockPrintStyle
  = HaddockSingleLine
  | HaddockMultiLine
  | HaddockMultiLineCompact
  deriving (Eq, Show, Enum, Bounded)

data HaddockPrintStyleModule
  = PrintStyleInherit
  | PrintStyleOverride HaddockPrintStyle
  deriving (Eq, Show)

data HaddockLocSignature
  = HaddockLocSigAuto
  | HaddockLocSigLeading
  | HaddockLocSigTrailing
  deriving (Eq, Show, Enum, Bounded)

data ImportExportStyle
  = ImportExportLeading
  | ImportExportTrailing
  | ImportExportDiffFriendly
  deriving (Eq, Show, Enum, Bounded)

data LetStyle
  = LetAuto
  | LetInline
  | LetNewline
  | LetMixed
  deriving (Eq, Show, Enum, Bounded)

data InStyle
  = InLeftAlign
  | InRightAlign
  | InNoSpace
  deriving (Eq, Show, Enum, Bounded)

data IfStyle
  = IfIndented
  | IfHanging
  deriving (Eq, Show, Enum, Bounded)

data Unicode
  = UnicodeDetect
  | UnicodeAlways
  | UnicodeNever
  deriving (Eq, Show, Enum, Bounded)

data SingleConstraintParens
  = ConstraintAuto
  | ConstraintAlways
  | ConstraintNever
  deriving (Eq, Show, Enum, Bounded)

data ColumnLimit
  = NoLimit
  | ColumnLimit Int
  deriving (Eq, Show)

data SingleDerivingParens
  = DerivingAuto
  | DerivingAlways
  | DerivingNever
  deriving (Eq, Show, Enum, Bounded)

data ImportGrouping
  = ImportGroupLegacy
  | ImportGroupPreserve
  | ImportGroupSingle
  | ImportGroupByScope
  | ImportGroupByQualified
  | ImportGroupByScopeThenQualified
  | ImportGroupCustom (NonEmpty CT.ImportGroup)
  deriving (Eq, Show)

instance Aeson.FromJSON CommaStyle where
  parseJSON =
    Aeson.withText "CommaStyle" $ \s ->
      either Aeson.parseFail pure $
        parsePrinterOptType (Text.unpack s)

instance PrinterOptsFieldType CommaStyle where
  parsePrinterOptType s =
    case s of
      "leading" -> Right Leading
      "trailing" -> Right Trailing
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"leading\" or \"trailing\""
          ]

instance RenderPrinterOpt CommaStyle where
  renderPrinterOpt = \case
    Leading -> "leading"
    Trailing -> "trailing"

instance Aeson.FromJSON FunctionArrowsStyle where
  parseJSON =
    Aeson.withText "FunctionArrowsStyle" $ \s ->
      either Aeson.parseFail pure $
        parsePrinterOptType (Text.unpack s)

instance PrinterOptsFieldType FunctionArrowsStyle where
  parsePrinterOptType s =
    case s of
      "trailing" -> Right TrailingArrows
      "leading" -> Right LeadingArrows
      "leading-args" -> Right LeadingArgsArrows
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"trailing\", \"leading\", or \"leading-args\""
          ]

instance RenderPrinterOpt FunctionArrowsStyle where
  renderPrinterOpt = \case
    TrailingArrows -> "trailing"
    LeadingArrows -> "leading"
    LeadingArgsArrows -> "leading-args"

instance Aeson.FromJSON HaddockPrintStyle where
  parseJSON =
    Aeson.withText "HaddockPrintStyle" $ \s ->
      either Aeson.parseFail pure $
        parsePrinterOptType (Text.unpack s)

instance PrinterOptsFieldType HaddockPrintStyle where
  parsePrinterOptType s =
    case s of
      "single-line" -> Right HaddockSingleLine
      "multi-line" -> Right HaddockMultiLine
      "multi-line-compact" -> Right HaddockMultiLineCompact
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"single-line\", \"multi-line\", or \"multi-line-compact\""
          ]

instance RenderPrinterOpt HaddockPrintStyle where
  renderPrinterOpt = \case
    HaddockSingleLine -> "single-line"
    HaddockMultiLine -> "multi-line"
    HaddockMultiLineCompact -> "multi-line-compact"

instance Aeson.FromJSON HaddockPrintStyleModule where
  parseJSON =
    \v -> case v of
      Aeson.Null -> pure PrintStyleInherit
      Aeson.String "" -> pure PrintStyleInherit
      _ -> PrintStyleOverride <$> Aeson.parseJSON v

instance PrinterOptsFieldType HaddockPrintStyleModule where
  parsePrinterOptType =
    \s -> case s of
      "" -> pure PrintStyleInherit
      _ -> PrintStyleOverride <$> parsePrinterOptType s

instance Aeson.FromJSON HaddockLocSignature where
  parseJSON =
    Aeson.withText "HaddockLocSignature" $ \s ->
      either Aeson.parseFail pure $
        parsePrinterOptType (Text.unpack s)

instance PrinterOptsFieldType HaddockLocSignature where
  parsePrinterOptType s =
    case s of
      "auto" -> Right HaddockLocSigAuto
      "leading" -> Right HaddockLocSigLeading
      "trailing" -> Right HaddockLocSigTrailing
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"auto\", \"leading\", or \"trailing\""
          ]

instance RenderPrinterOpt HaddockLocSignature where
  renderPrinterOpt = \case
    HaddockLocSigAuto -> "auto"
    HaddockLocSigLeading -> "leading"
    HaddockLocSigTrailing -> "trailing"

instance Aeson.FromJSON ImportExportStyle where
  parseJSON =
    Aeson.withText "ImportExportStyle" $ \s ->
      either Aeson.parseFail pure $
        parsePrinterOptType (Text.unpack s)

instance PrinterOptsFieldType ImportExportStyle where
  parsePrinterOptType s =
    case s of
      "leading" -> Right ImportExportLeading
      "trailing" -> Right ImportExportTrailing
      "diff-friendly" -> Right ImportExportDiffFriendly
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"leading\", \"trailing\", or \"diff-friendly\""
          ]

instance RenderPrinterOpt ImportExportStyle where
  renderPrinterOpt = \case
    ImportExportLeading -> "leading"
    ImportExportTrailing -> "trailing"
    ImportExportDiffFriendly -> "diff-friendly"

instance Aeson.FromJSON LetStyle where
  parseJSON =
    Aeson.withText "LetStyle" $ \s ->
      either Aeson.parseFail pure $
        parsePrinterOptType (Text.unpack s)

instance PrinterOptsFieldType LetStyle where
  parsePrinterOptType s =
    case s of
      "auto" -> Right LetAuto
      "inline" -> Right LetInline
      "newline" -> Right LetNewline
      "mixed" -> Right LetMixed
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"auto\", \"inline\", \"newline\", or \"mixed\""
          ]

instance RenderPrinterOpt LetStyle where
  renderPrinterOpt = \case
    LetAuto -> "auto"
    LetInline -> "inline"
    LetNewline -> "newline"
    LetMixed -> "mixed"

instance Aeson.FromJSON InStyle where
  parseJSON =
    Aeson.withText "InStyle" $ \s ->
      either Aeson.parseFail pure $
        parsePrinterOptType (Text.unpack s)

instance PrinterOptsFieldType InStyle where
  parsePrinterOptType s =
    case s of
      "left-align" -> Right InLeftAlign
      "right-align" -> Right InRightAlign
      "no-space" -> Right InNoSpace
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"left-align\", \"right-align\", or \"no-space\""
          ]

instance RenderPrinterOpt InStyle where
  renderPrinterOpt = \case
    InLeftAlign -> "left-align"
    InRightAlign -> "right-align"
    InNoSpace -> "no-space"

instance Aeson.FromJSON IfStyle where
  parseJSON =
    Aeson.withText "IfStyle" $ \s ->
      either Aeson.parseFail pure $
        parsePrinterOptType (Text.unpack s)

instance PrinterOptsFieldType IfStyle where
  parsePrinterOptType s =
    case s of
      "indented" -> Right IfIndented
      "hanging" -> Right IfHanging
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"indented\" or \"hanging\""
          ]

instance RenderPrinterOpt IfStyle where
  renderPrinterOpt = \case
    IfIndented -> "indented"
    IfHanging -> "hanging"

instance Aeson.FromJSON Unicode where
  parseJSON =
    Aeson.withText "Unicode" $ \s ->
      either Aeson.parseFail pure $
        parsePrinterOptType (Text.unpack s)

instance PrinterOptsFieldType Unicode where
  parsePrinterOptType s =
    case s of
      "detect" -> Right UnicodeDetect
      "always" -> Right UnicodeAlways
      "never" -> Right UnicodeNever
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"detect\", \"always\", or \"never\""
          ]

instance RenderPrinterOpt Unicode where
  renderPrinterOpt = \case
    UnicodeDetect -> "detect"
    UnicodeAlways -> "always"
    UnicodeNever -> "never"

instance Aeson.FromJSON SingleConstraintParens where
  parseJSON =
    Aeson.withText "SingleConstraintParens" $ \s ->
      either Aeson.parseFail pure $
        parsePrinterOptType (Text.unpack s)

instance PrinterOptsFieldType SingleConstraintParens where
  parsePrinterOptType s =
    case s of
      "auto" -> Right ConstraintAuto
      "always" -> Right ConstraintAlways
      "never" -> Right ConstraintNever
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"auto\", \"always\", or \"never\""
          ]

instance RenderPrinterOpt SingleConstraintParens where
  renderPrinterOpt = \case
    ConstraintAuto -> "auto"
    ConstraintAlways -> "always"
    ConstraintNever -> "never"

instance Aeson.FromJSON ColumnLimit where
  parseJSON =
    \case
       Aeson.String "none" ->
         pure NoLimit
       Aeson.Number x
         | Right x' <- (floatingOrInteger x :: Either Double Int) ->
             pure $ ColumnLimit x'
       s ->
         fail . unlines $
           [ "unknown value: " <> show s,
             "Valid values are: \"none\", or an integer"
           ]

instance PrinterOptsFieldType ColumnLimit where
  parsePrinterOptType =
    \s ->
      case s of
        "none" -> Right NoLimit
        _
          | Just someInt <- readMaybe s ->
              Right . ColumnLimit $ someInt
        _ ->
          Left . unlines $
            [ "unknown value: " <> show s,
              "Valid values are: \"none\", or an integer"
            ]

instance Aeson.FromJSON SingleDerivingParens where
  parseJSON =
    Aeson.withText "SingleDerivingParens" $ \s ->
      either Aeson.parseFail pure $
        parsePrinterOptType (Text.unpack s)

instance PrinterOptsFieldType SingleDerivingParens where
  parsePrinterOptType s =
    case s of
      "auto" -> Right DerivingAuto
      "always" -> Right DerivingAlways
      "never" -> Right DerivingNever
      _ ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"auto\", \"always\", or \"never\""
          ]

instance RenderPrinterOpt SingleDerivingParens where
  renderPrinterOpt = \case
    DerivingAuto -> "auto"
    DerivingAlways -> "always"
    DerivingNever -> "never"

instance Aeson.FromJSON ImportGrouping where
  parseJSON =
    \case
      Aeson.String "legacy" -> pure ImportGroupLegacy
      Aeson.String "preserve" -> pure ImportGroupPreserve
      Aeson.String "single" -> pure ImportGroupSingle
      Aeson.String "by-qualified" -> pure ImportGroupByQualified
      Aeson.String "by-scope" -> pure ImportGroupByScope
      Aeson.String "by-scope-then-qualified" -> pure ImportGroupByScopeThenQualified
      arr@(Aeson.Array _) -> ImportGroupCustom <$> Aeson.parseJSON arr
      other ->
        fail . unlines $
          [ "unknown strategy value: " <> show other,
            "Valid values are: \"legacy\", \"preserve\", \"single\", \"by-qualified\", \"by-scope\", \"by-scope-then-qualified\" or a valid YAML configuration for import groups"
          ]

instance PrinterOptsFieldType ImportGrouping where
  parsePrinterOptType =
    \case
      "legacy" -> Right ImportGroupLegacy
      "preserve" -> Right ImportGroupPreserve
      "single" -> Right ImportGroupSingle
      "by-qualified" -> Right ImportGroupByQualified
      "by-scope" -> Right ImportGroupByScope
      "by-scope-then-qualified" -> Right ImportGroupByScopeThenQualified
      s ->
        Left . unlines $
          [ "unknown value: " <> show s
          , "Valid values are: \"legacy\", \"preserve\", \"single\", \"by-qualified\", \"by-scope\", \"by-scope-then-qualified\" or a valid YAML configuration for import groups (see fourmolu.yaml)"
          ]

defaultPrinterOptsYaml :: String
defaultPrinterOptsYaml =
  unlines
    [ "# Number of spaces per indentation step"
    , "indentation: 4"
    , ""
    , "# Max line length for automatic line breaking"
    , "column-limit: none"
    , ""
    , "# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)"
    , "function-arrows: trailing"
    , ""
    , "# How to place commas in multi-line lists, records, etc. (choices: leading or trailing)"
    , "comma-style: leading"
    , ""
    , "# Styling of import/export lists (choices: leading, trailing, or diff-friendly)"
    , "import-export-style: diff-friendly"
    , ""
    , "# Rules for grouping import declarations"
    , "import-grouping: legacy"
    , ""
    , "# Whether to full-indent or half-indent 'where' bindings past the preceding body"
    , "indent-wheres: false"
    , ""
    , "# Whether to leave a space before an opening record brace"
    , "record-brace-space: false"
    , ""
    , "# Number of spaces between top-level declarations"
    , "newlines-between-decls: 1"
    , ""
    , "# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)"
    , "haddock-style: multi-line"
    , ""
    , "# How to print module docstring"
    , "haddock-style-module: null"
    , ""
    , "# Where to put docstring comments in function signatures (choices: auto, leading, or trailing)"
    , "haddock-location-signature: auto"
    , ""
    , "# Styling of let blocks (choices: auto, inline, newline, or mixed)"
    , "let-style: auto"
    , ""
    , "# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)"
    , "in-style: right-align"
    , ""
    , "# Styling of if-statements (choices: indented or hanging)"
    , "if-style: indented"
    , ""
    , "# Whether to put parentheses around a single constraint (choices: auto, always, or never)"
    , "single-constraint-parens: always"
    , ""
    , "# Whether to put parentheses around a single deriving class (choices: auto, always, or never)"
    , "single-deriving-parens: always"
    , ""
    , "# Whether to sort constraints"
    , "sort-constraints: false"
    , ""
    , "# Whether to sort derived classes"
    , "sort-derived-classes: false"
    , ""
    , "# Whether to sort deriving clauses"
    , "sort-deriving-clauses: false"
    , ""
    , "# Whether to place section operators (those that are infixr 0, such as $) in trailing position, continuing the expression indented below"
    , "trailing-section-operators: true"
    , ""
    , "# Output Unicode syntax (choices: detect, always, or never)"
    , "unicode: never"
    , ""
    , "# Give the programmer more choice on where to insert blank lines"
    , "respectful: true"
    , ""
    , "# Fixity information for operators"
    , "fixities: []"
    , ""
    , "# Module reexports Fourmolu should know about"
    , "reexports: []"
    , ""
    , "# Modules defined by the current Cabal package for import grouping"
    , "local-modules: []"
    ]