{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveDataTypeable #-}

module Language.Haskell.Brittany.Internal.Config.Types
  ( module Language.Haskell.Brittany.Internal.Config.Types
  , cMap
  )
where



#include "prelude.inc"

import Data.Yaml
import qualified Data.Aeson.Types as Aeson
import GHC.Generics

import Data.Data ( Data )

import Data.Coerce ( Coercible, coerce )

import Data.Semigroup.Generic
import Data.Semigroup ( Last, Option )

import Data.CZipWith



confUnpack :: Coercible a b => Identity a -> b
confUnpack :: Identity a -> b
confUnpack (Identity a
x) = a -> b
coerce a
x

data CDebugConfig f = DebugConfig
  { CDebugConfig f -> f (Last Bool)
_dconf_dump_config                :: f (Semigroup.Last Bool)
  , CDebugConfig f -> f (Last Bool)
_dconf_dump_annotations           :: f (Semigroup.Last Bool)
  , CDebugConfig f -> f (Last Bool)
_dconf_dump_ast_unknown           :: f (Semigroup.Last Bool)
  , CDebugConfig f -> f (Last Bool)
_dconf_dump_ast_full              :: f (Semigroup.Last Bool)
  , CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_raw            :: f (Semigroup.Last Bool)
  , CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_simpl_alt      :: f (Semigroup.Last Bool)
  , CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_simpl_floating :: f (Semigroup.Last Bool)
  , CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_simpl_par      :: f (Semigroup.Last Bool)
  , CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_simpl_columns  :: f (Semigroup.Last Bool)
  , CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_simpl_indent   :: f (Semigroup.Last Bool)
  , CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_final          :: f (Semigroup.Last Bool)
  , CDebugConfig f -> f (Last Bool)
_dconf_roundtrip_exactprint_only  :: f (Semigroup.Last Bool)
  }
  deriving ((forall x. CDebugConfig f -> Rep (CDebugConfig f) x)
-> (forall x. Rep (CDebugConfig f) x -> CDebugConfig f)
-> Generic (CDebugConfig f)
forall x. Rep (CDebugConfig f) x -> CDebugConfig f
forall x. CDebugConfig f -> Rep (CDebugConfig f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (CDebugConfig f) x -> CDebugConfig f
forall (f :: * -> *) x. CDebugConfig f -> Rep (CDebugConfig f) x
$cto :: forall (f :: * -> *) x. Rep (CDebugConfig f) x -> CDebugConfig f
$cfrom :: forall (f :: * -> *) x. CDebugConfig f -> Rep (CDebugConfig f) x
Generic)

data CLayoutConfig f = LayoutConfig
  { CLayoutConfig f -> f (Last Int)
_lconfig_cols         :: f (Last Int) -- the thing that has default 80.
  , CLayoutConfig f -> f (Last IndentPolicy)
_lconfig_indentPolicy :: f (Last IndentPolicy)
  , CLayoutConfig f -> f (Last Int)
_lconfig_indentAmount :: f (Last Int)
  , CLayoutConfig f -> f (Last Bool)
_lconfig_indentWhereSpecial :: f (Last Bool) -- indent where only 1 sometimes (TODO).
  , CLayoutConfig f -> f (Last Bool)
_lconfig_indentListSpecial  :: f (Last Bool) -- use some special indentation for ","
                                                 -- when creating zero-indentation
                                                 -- multi-line list literals.
  , CLayoutConfig f -> f (Last Int)
_lconfig_importColumn    :: f (Last Int)
    -- ^ for import statement layouting, column at which to align the
    -- elements to be imported from a module.
    -- It is expected that importAsColumn >= importCol.
  , CLayoutConfig f -> f (Last Int)
_lconfig_importAsColumn  :: f (Last Int)
    -- ^ for import statement layouting, column at which put the module's
    -- "as" name (which also affects the positioning of the "as" keyword).
    -- It is expected that importAsColumn >= importCol.
  , CLayoutConfig f -> f (Last AltChooser)
_lconfig_altChooser      :: f (Last AltChooser)
  , CLayoutConfig f -> f (Last ColumnAlignMode)
_lconfig_columnAlignMode :: f (Last ColumnAlignMode)
  , CLayoutConfig f -> f (Last Int)
_lconfig_alignmentLimit  :: f (Last Int)
    -- roughly speaking, this sets an upper bound to the number of spaces
    -- inserted to create horizontal alignment.
    -- More specifically, if 'xs' are the widths of the columns in some
    -- alignment-block, then the block will be aligned with the width
    -- maximum [ x | x <- xs, x < minimum xs + alignmentLimit ].
  , CLayoutConfig f -> f (Last Bool)
_lconfig_alignmentBreakOnMultiline :: f (Last Bool)
    -- stops alignment between items that are not layouted as a single line.
    -- e.g. for single-line alignment, things remain unchanged:
    --   do
    --     short       <- stuff
    --     loooooooong <- stuff
    -- but not in cases such as:
    --   do
    --     short <- some more stuff
    --       that requires two lines
    --     loooooooong <- stuff
  , CLayoutConfig f -> f (Last Bool)
_lconfig_hangingTypeSignature :: f (Last Bool)
    -- Do not put "::" in a new line, and use hanging indentation for the
    -- signature, i.e.:
    -- func :: SomeLongStuff
    --      -> SomeLongStuff
    -- instead of the usual
    -- func
    --   :: SomeLongStuff
    --   -> SomeLongStuff
    -- As usual for hanging indentation, the result will be
    -- context-sensitive (in the function name).
  , CLayoutConfig f -> f (Last Bool)
_lconfig_reformatModulePreamble :: f (Last Bool)
    -- whether the module preamble/header (module keyword, name, export list,
    -- import statements) are reformatted. If false, only the elements of the
    -- module (everything past the "where") are reformatted.
  , CLayoutConfig f -> f (Last Bool)
_lconfig_allowSingleLineExportList :: f (Last Bool)
    -- if true, and it fits in a single line, and there are no comments in the
    -- export list, the following layout will be used:
    -- > module MyModule (abc, def) where
    -- > [stuff]
    -- otherwise, the multi-line version is used:
    -- > module MyModule
    -- >   ( abc
    -- >   , def
    -- >   )
    -- > where
  , CLayoutConfig f -> f (Last Bool)
_lconfig_allowHangingQuasiQuotes :: f (Last Bool)
    -- if false, the layouter sees any splices as infinitely big and places
    -- them accordingly (in newlines, most likely); This also influences
    -- parent nodes.
    -- if true, the layouter is free to start a quasi-quotation at the end
    -- of a line.
    --
    -- false:
    -- > let
    -- >   body =
    -- >     [json|
    -- >     hello
    -- >     |]
    --
    -- true:
    -- > let body = [json|
    -- >     hello
    -- >     |]
  , CLayoutConfig f -> f (Last Bool)
_lconfig_experimentalSemicolonNewlines :: f (Last Bool)
    -- enables an experimental feature to turn semicolons in brace notation
    -- into newlines when using layout:
    --
    -- > do { a ;; b }
    --
    -- turns into
    -- > do
    -- >   a
    -- >
    -- >   b
    --
    -- The implementation for this is a bit hacky and not tested; it might
    -- break output syntax or not work properly for every kind of brace. So
    -- far I have considered `do` and `case-of`.
  -- , _lconfig_allowSinglelineRecord :: f (Last Bool)
  --   -- if true, layouts record data decls as a single line when possible, e.g.
  --   -- > MyPoint { x :: Double, y :: Double }
  --   -- if false, always use the multi-line layout
  --   -- > MyPoint
  --   -- >   { x :: Double
  --   -- >   , y :: Double
  --   -- >   }
  }
  deriving ((forall x. CLayoutConfig f -> Rep (CLayoutConfig f) x)
-> (forall x. Rep (CLayoutConfig f) x -> CLayoutConfig f)
-> Generic (CLayoutConfig f)
forall x. Rep (CLayoutConfig f) x -> CLayoutConfig f
forall x. CLayoutConfig f -> Rep (CLayoutConfig f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (CLayoutConfig f) x -> CLayoutConfig f
forall (f :: * -> *) x. CLayoutConfig f -> Rep (CLayoutConfig f) x
$cto :: forall (f :: * -> *) x. Rep (CLayoutConfig f) x -> CLayoutConfig f
$cfrom :: forall (f :: * -> *) x. CLayoutConfig f -> Rep (CLayoutConfig f) x
Generic)

data CForwardOptions f = ForwardOptions
  { CForwardOptions f -> f [String]
_options_ghc :: f [String]
  }
  deriving ((forall x. CForwardOptions f -> Rep (CForwardOptions f) x)
-> (forall x. Rep (CForwardOptions f) x -> CForwardOptions f)
-> Generic (CForwardOptions f)
forall x. Rep (CForwardOptions f) x -> CForwardOptions f
forall x. CForwardOptions f -> Rep (CForwardOptions f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (CForwardOptions f) x -> CForwardOptions f
forall (f :: * -> *) x.
CForwardOptions f -> Rep (CForwardOptions f) x
$cto :: forall (f :: * -> *) x.
Rep (CForwardOptions f) x -> CForwardOptions f
$cfrom :: forall (f :: * -> *) x.
CForwardOptions f -> Rep (CForwardOptions f) x
Generic)

data CErrorHandlingConfig f = ErrorHandlingConfig
  { CErrorHandlingConfig f -> f (Last Bool)
_econf_produceOutputOnErrors   :: f (Semigroup.Last Bool)
  , CErrorHandlingConfig f -> f (Last Bool)
_econf_Werror                  :: f (Semigroup.Last Bool)
  , CErrorHandlingConfig f -> f (Last ExactPrintFallbackMode)
_econf_ExactPrintFallback      :: f (Semigroup.Last ExactPrintFallbackMode)
    -- ^ Determines when to fall back on the exactprint'ed output when
    -- syntactical constructs are encountered which are not yet handled by
    -- brittany.
    -- Note that the "risky" setting is risky because even with the check of
    -- the syntactic validity of the brittany output, at least in theory there
    -- may be cases where the output is syntactically/semantically valid but
    -- has different semantics than the code pre-transformation.
  , CErrorHandlingConfig f -> f (Last Bool)
_econf_omit_output_valid_check :: f (Semigroup.Last Bool)
  }
  deriving ((forall x.
 CErrorHandlingConfig f -> Rep (CErrorHandlingConfig f) x)
-> (forall x.
    Rep (CErrorHandlingConfig f) x -> CErrorHandlingConfig f)
-> Generic (CErrorHandlingConfig f)
forall x. Rep (CErrorHandlingConfig f) x -> CErrorHandlingConfig f
forall x. CErrorHandlingConfig f -> Rep (CErrorHandlingConfig f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (CErrorHandlingConfig f) x -> CErrorHandlingConfig f
forall (f :: * -> *) x.
CErrorHandlingConfig f -> Rep (CErrorHandlingConfig f) x
$cto :: forall (f :: * -> *) x.
Rep (CErrorHandlingConfig f) x -> CErrorHandlingConfig f
$cfrom :: forall (f :: * -> *) x.
CErrorHandlingConfig f -> Rep (CErrorHandlingConfig f) x
Generic)

data CPreProcessorConfig f = PreProcessorConfig
  { CPreProcessorConfig f -> f (Last CPPMode)
_ppconf_CPPMode :: f (Semigroup.Last CPPMode)
  , CPreProcessorConfig f -> f (Last Bool)
_ppconf_hackAroundIncludes :: f (Semigroup.Last Bool)
  }
  deriving ((forall x. CPreProcessorConfig f -> Rep (CPreProcessorConfig f) x)
-> (forall x.
    Rep (CPreProcessorConfig f) x -> CPreProcessorConfig f)
-> Generic (CPreProcessorConfig f)
forall x. Rep (CPreProcessorConfig f) x -> CPreProcessorConfig f
forall x. CPreProcessorConfig f -> Rep (CPreProcessorConfig f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (CPreProcessorConfig f) x -> CPreProcessorConfig f
forall (f :: * -> *) x.
CPreProcessorConfig f -> Rep (CPreProcessorConfig f) x
$cto :: forall (f :: * -> *) x.
Rep (CPreProcessorConfig f) x -> CPreProcessorConfig f
$cfrom :: forall (f :: * -> *) x.
CPreProcessorConfig f -> Rep (CPreProcessorConfig f) x
Generic)

data CConfig f = Config
  { CConfig f -> f (Last Int)
_conf_version       :: f (Semigroup.Last Int)
  , CConfig f -> CDebugConfig f
_conf_debug         :: CDebugConfig f
  , CConfig f -> CLayoutConfig f
_conf_layout        :: CLayoutConfig f
  , CConfig f -> CErrorHandlingConfig f
_conf_errorHandling :: CErrorHandlingConfig f
  , CConfig f -> CForwardOptions f
_conf_forward       :: CForwardOptions f
  , CConfig f -> CPreProcessorConfig f
_conf_preprocessor  :: CPreProcessorConfig f
  , CConfig f -> f (Last Bool)
_conf_roundtrip_exactprint_only :: f (Semigroup.Last Bool)
    -- ^ this field is somewhat of a duplicate of the one in DebugConfig.
    -- It is used for per-declaration disabling by the inline config
    -- implementation. Could have re-used the existing field, but felt risky
    -- to use a "debug" labeled field for non-debug functionality.
  , CConfig f -> f (Last Bool)
_conf_disable_formatting :: f (Semigroup.Last Bool)
    -- ^ Used for inline config that disables brittany entirely for this
    -- module. Useful for wildcard application
    -- (`find -name "*.hs" | xargs brittany --write-mode inplace` or something
    -- in that direction).
  , CConfig f -> f (Last Bool)
_conf_obfuscate     :: f (Semigroup.Last Bool)

  }
  deriving ((forall x. CConfig f -> Rep (CConfig f) x)
-> (forall x. Rep (CConfig f) x -> CConfig f)
-> Generic (CConfig f)
forall x. Rep (CConfig f) x -> CConfig f
forall x. CConfig f -> Rep (CConfig f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (CConfig f) x -> CConfig f
forall (f :: * -> *) x. CConfig f -> Rep (CConfig f) x
$cto :: forall (f :: * -> *) x. Rep (CConfig f) x -> CConfig f
$cfrom :: forall (f :: * -> *) x. CConfig f -> Rep (CConfig f) x
Generic)

type DebugConfig = CDebugConfig Identity
type LayoutConfig = CLayoutConfig Identity
type ForwardOptions = CForwardOptions Identity
type ErrorHandlingConfig = CErrorHandlingConfig Identity
type Config = CConfig Identity

-- i wonder if any Show1 stuff could be leveraged.
deriving instance Show (CDebugConfig Identity)
deriving instance Show (CLayoutConfig Identity)
deriving instance Show (CErrorHandlingConfig Identity)
deriving instance Show (CForwardOptions Identity)
deriving instance Show (CPreProcessorConfig Identity)
deriving instance Show (CConfig Identity)

deriving instance Show (CDebugConfig Option)
deriving instance Show (CLayoutConfig Option)
deriving instance Show (CErrorHandlingConfig Option)
deriving instance Show (CForwardOptions Option)
deriving instance Show (CPreProcessorConfig Option)
deriving instance Show (CConfig Option)

deriving instance Data (CDebugConfig Identity)
deriving instance Data (CLayoutConfig Identity)
deriving instance Data (CErrorHandlingConfig Identity)
deriving instance Data (CForwardOptions Identity)
deriving instance Data (CPreProcessorConfig Identity)
deriving instance Data (CConfig Identity)

deriving instance Data (CDebugConfig Option)
deriving instance Data (CLayoutConfig Option)
deriving instance Data (CErrorHandlingConfig Option)
deriving instance Data (CForwardOptions Option)
deriving instance Data (CPreProcessorConfig Option)
deriving instance Data (CConfig Option)

instance Semigroup.Semigroup (CDebugConfig Option) where
  <> :: CDebugConfig Option -> CDebugConfig Option -> CDebugConfig Option
(<>) = CDebugConfig Option -> CDebugConfig Option -> CDebugConfig Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Semigroup.Semigroup (CLayoutConfig Option) where
  <> :: CLayoutConfig Option
-> CLayoutConfig Option -> CLayoutConfig Option
(<>) = CLayoutConfig Option
-> CLayoutConfig Option -> CLayoutConfig Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Semigroup.Semigroup (CErrorHandlingConfig Option) where
  <> :: CErrorHandlingConfig Option
-> CErrorHandlingConfig Option -> CErrorHandlingConfig Option
(<>) = CErrorHandlingConfig Option
-> CErrorHandlingConfig Option -> CErrorHandlingConfig Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Semigroup.Semigroup (CForwardOptions Option) where
  <> :: CForwardOptions Option
-> CForwardOptions Option -> CForwardOptions Option
(<>) = CForwardOptions Option
-> CForwardOptions Option -> CForwardOptions Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Semigroup.Semigroup (CPreProcessorConfig Option) where
  <> :: CPreProcessorConfig Option
-> CPreProcessorConfig Option -> CPreProcessorConfig Option
(<>) = CPreProcessorConfig Option
-> CPreProcessorConfig Option -> CPreProcessorConfig Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Semigroup.Semigroup (CConfig Option) where
  <> :: CConfig Option -> CConfig Option -> CConfig Option
(<>) = CConfig Option -> CConfig Option -> CConfig Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend

instance Semigroup.Semigroup (CDebugConfig Identity) where
  <> :: CDebugConfig Identity
-> CDebugConfig Identity -> CDebugConfig Identity
(<>) = CDebugConfig Identity
-> CDebugConfig Identity -> CDebugConfig Identity
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Semigroup.Semigroup (CLayoutConfig Identity) where
  <> :: CLayoutConfig Identity
-> CLayoutConfig Identity -> CLayoutConfig Identity
(<>) = CLayoutConfig Identity
-> CLayoutConfig Identity -> CLayoutConfig Identity
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Semigroup.Semigroup (CErrorHandlingConfig Identity) where
  <> :: CErrorHandlingConfig Identity
-> CErrorHandlingConfig Identity -> CErrorHandlingConfig Identity
(<>) = CErrorHandlingConfig Identity
-> CErrorHandlingConfig Identity -> CErrorHandlingConfig Identity
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Semigroup.Semigroup (CForwardOptions Identity) where
  <> :: CForwardOptions Identity
-> CForwardOptions Identity -> CForwardOptions Identity
(<>) = CForwardOptions Identity
-> CForwardOptions Identity -> CForwardOptions Identity
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Semigroup.Semigroup (CPreProcessorConfig Identity) where
  <> :: CPreProcessorConfig Identity
-> CPreProcessorConfig Identity -> CPreProcessorConfig Identity
(<>) = CPreProcessorConfig Identity
-> CPreProcessorConfig Identity -> CPreProcessorConfig Identity
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Semigroup.Semigroup (CConfig Identity) where
  <> :: CConfig Identity -> CConfig Identity -> CConfig Identity
(<>) = CConfig Identity -> CConfig Identity -> CConfig Identity
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend

instance Monoid (CDebugConfig Option) where
  mempty :: CDebugConfig Option
mempty = CDebugConfig Option
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: CDebugConfig Option -> CDebugConfig Option -> CDebugConfig Option
mappend = CDebugConfig Option -> CDebugConfig Option -> CDebugConfig Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Monoid (CLayoutConfig Option) where
  mempty :: CLayoutConfig Option
mempty = CLayoutConfig Option
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: CLayoutConfig Option
-> CLayoutConfig Option -> CLayoutConfig Option
mappend = CLayoutConfig Option
-> CLayoutConfig Option -> CLayoutConfig Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Monoid (CErrorHandlingConfig Option) where
  mempty :: CErrorHandlingConfig Option
mempty = CErrorHandlingConfig Option
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: CErrorHandlingConfig Option
-> CErrorHandlingConfig Option -> CErrorHandlingConfig Option
mappend = CErrorHandlingConfig Option
-> CErrorHandlingConfig Option -> CErrorHandlingConfig Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Monoid (CForwardOptions Option) where
  mempty :: CForwardOptions Option
mempty = CForwardOptions Option
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: CForwardOptions Option
-> CForwardOptions Option -> CForwardOptions Option
mappend = CForwardOptions Option
-> CForwardOptions Option -> CForwardOptions Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Monoid (CPreProcessorConfig Option) where
  mempty :: CPreProcessorConfig Option
mempty = CPreProcessorConfig Option
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: CPreProcessorConfig Option
-> CPreProcessorConfig Option -> CPreProcessorConfig Option
mappend = CPreProcessorConfig Option
-> CPreProcessorConfig Option -> CPreProcessorConfig Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
instance Monoid (CConfig Option) where
  mempty :: CConfig Option
mempty = CConfig Option
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: CConfig Option -> CConfig Option -> CConfig Option
mappend = CConfig Option -> CConfig Option -> CConfig Option
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend


data IndentPolicy = IndentPolicyLeft -- never create a new indentation at more
                                     -- than old indentation + amount
                  | IndentPolicyFree -- can create new indentations whereever
                  | IndentPolicyMultiple -- can create indentations only
                                         -- at any n * amount.
  deriving (IndentPolicy -> IndentPolicy -> Bool
(IndentPolicy -> IndentPolicy -> Bool)
-> (IndentPolicy -> IndentPolicy -> Bool) -> Eq IndentPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndentPolicy -> IndentPolicy -> Bool
$c/= :: IndentPolicy -> IndentPolicy -> Bool
== :: IndentPolicy -> IndentPolicy -> Bool
$c== :: IndentPolicy -> IndentPolicy -> Bool
Eq, Int -> IndentPolicy -> ShowS
[IndentPolicy] -> ShowS
IndentPolicy -> String
(Int -> IndentPolicy -> ShowS)
-> (IndentPolicy -> String)
-> ([IndentPolicy] -> ShowS)
-> Show IndentPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndentPolicy] -> ShowS
$cshowList :: [IndentPolicy] -> ShowS
show :: IndentPolicy -> String
$cshow :: IndentPolicy -> String
showsPrec :: Int -> IndentPolicy -> ShowS
$cshowsPrec :: Int -> IndentPolicy -> ShowS
Show, (forall x. IndentPolicy -> Rep IndentPolicy x)
-> (forall x. Rep IndentPolicy x -> IndentPolicy)
-> Generic IndentPolicy
forall x. Rep IndentPolicy x -> IndentPolicy
forall x. IndentPolicy -> Rep IndentPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IndentPolicy x -> IndentPolicy
$cfrom :: forall x. IndentPolicy -> Rep IndentPolicy x
Generic, Typeable IndentPolicy
DataType
Constr
Typeable IndentPolicy
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> IndentPolicy -> c IndentPolicy)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IndentPolicy)
-> (IndentPolicy -> Constr)
-> (IndentPolicy -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IndentPolicy))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c IndentPolicy))
-> ((forall b. Data b => b -> b) -> IndentPolicy -> IndentPolicy)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IndentPolicy -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IndentPolicy -> r)
-> (forall u. (forall d. Data d => d -> u) -> IndentPolicy -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IndentPolicy -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IndentPolicy -> m IndentPolicy)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IndentPolicy -> m IndentPolicy)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IndentPolicy -> m IndentPolicy)
-> Data IndentPolicy
IndentPolicy -> DataType
IndentPolicy -> Constr
(forall b. Data b => b -> b) -> IndentPolicy -> IndentPolicy
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IndentPolicy -> c IndentPolicy
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IndentPolicy
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IndentPolicy -> u
forall u. (forall d. Data d => d -> u) -> IndentPolicy -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IndentPolicy -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IndentPolicy -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IndentPolicy -> m IndentPolicy
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IndentPolicy -> m IndentPolicy
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IndentPolicy
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IndentPolicy -> c IndentPolicy
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IndentPolicy)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IndentPolicy)
$cIndentPolicyMultiple :: Constr
$cIndentPolicyFree :: Constr
$cIndentPolicyLeft :: Constr
$tIndentPolicy :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> IndentPolicy -> m IndentPolicy
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IndentPolicy -> m IndentPolicy
gmapMp :: (forall d. Data d => d -> m d) -> IndentPolicy -> m IndentPolicy
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IndentPolicy -> m IndentPolicy
gmapM :: (forall d. Data d => d -> m d) -> IndentPolicy -> m IndentPolicy
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IndentPolicy -> m IndentPolicy
gmapQi :: Int -> (forall d. Data d => d -> u) -> IndentPolicy -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IndentPolicy -> u
gmapQ :: (forall d. Data d => d -> u) -> IndentPolicy -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IndentPolicy -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IndentPolicy -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IndentPolicy -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IndentPolicy -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IndentPolicy -> r
gmapT :: (forall b. Data b => b -> b) -> IndentPolicy -> IndentPolicy
$cgmapT :: (forall b. Data b => b -> b) -> IndentPolicy -> IndentPolicy
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IndentPolicy)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IndentPolicy)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c IndentPolicy)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IndentPolicy)
dataTypeOf :: IndentPolicy -> DataType
$cdataTypeOf :: IndentPolicy -> DataType
toConstr :: IndentPolicy -> Constr
$ctoConstr :: IndentPolicy -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IndentPolicy
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IndentPolicy
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IndentPolicy -> c IndentPolicy
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IndentPolicy -> c IndentPolicy
$cp1Data :: Typeable IndentPolicy
Data)

data AltChooser = AltChooserSimpleQuick -- always choose last alternative.
                                        -- leads to tons of sparsely filled
                                        -- lines.
                | AltChooserShallowBest -- choose the first matching alternative
                                        -- using the simplest spacing
                                        -- information for the children.
                | AltChooserBoundedSearch Int
                                        -- choose the first matching alternative
                                        -- using a bounded list of recursive
                                        -- options having sufficient space.
  deriving (Int -> AltChooser -> ShowS
[AltChooser] -> ShowS
AltChooser -> String
(Int -> AltChooser -> ShowS)
-> (AltChooser -> String)
-> ([AltChooser] -> ShowS)
-> Show AltChooser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AltChooser] -> ShowS
$cshowList :: [AltChooser] -> ShowS
show :: AltChooser -> String
$cshow :: AltChooser -> String
showsPrec :: Int -> AltChooser -> ShowS
$cshowsPrec :: Int -> AltChooser -> ShowS
Show, (forall x. AltChooser -> Rep AltChooser x)
-> (forall x. Rep AltChooser x -> AltChooser) -> Generic AltChooser
forall x. Rep AltChooser x -> AltChooser
forall x. AltChooser -> Rep AltChooser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AltChooser x -> AltChooser
$cfrom :: forall x. AltChooser -> Rep AltChooser x
Generic, Typeable AltChooser
DataType
Constr
Typeable AltChooser
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AltChooser -> c AltChooser)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AltChooser)
-> (AltChooser -> Constr)
-> (AltChooser -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AltChooser))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AltChooser))
-> ((forall b. Data b => b -> b) -> AltChooser -> AltChooser)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AltChooser -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AltChooser -> r)
-> (forall u. (forall d. Data d => d -> u) -> AltChooser -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AltChooser -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AltChooser -> m AltChooser)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AltChooser -> m AltChooser)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AltChooser -> m AltChooser)
-> Data AltChooser
AltChooser -> DataType
AltChooser -> Constr
(forall b. Data b => b -> b) -> AltChooser -> AltChooser
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltChooser -> c AltChooser
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AltChooser
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AltChooser -> u
forall u. (forall d. Data d => d -> u) -> AltChooser -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AltChooser -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AltChooser -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AltChooser -> m AltChooser
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AltChooser -> m AltChooser
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AltChooser
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltChooser -> c AltChooser
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AltChooser)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AltChooser)
$cAltChooserBoundedSearch :: Constr
$cAltChooserShallowBest :: Constr
$cAltChooserSimpleQuick :: Constr
$tAltChooser :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AltChooser -> m AltChooser
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AltChooser -> m AltChooser
gmapMp :: (forall d. Data d => d -> m d) -> AltChooser -> m AltChooser
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AltChooser -> m AltChooser
gmapM :: (forall d. Data d => d -> m d) -> AltChooser -> m AltChooser
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AltChooser -> m AltChooser
gmapQi :: Int -> (forall d. Data d => d -> u) -> AltChooser -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AltChooser -> u
gmapQ :: (forall d. Data d => d -> u) -> AltChooser -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AltChooser -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AltChooser -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AltChooser -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AltChooser -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AltChooser -> r
gmapT :: (forall b. Data b => b -> b) -> AltChooser -> AltChooser
$cgmapT :: (forall b. Data b => b -> b) -> AltChooser -> AltChooser
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AltChooser)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AltChooser)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AltChooser)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AltChooser)
dataTypeOf :: AltChooser -> DataType
$cdataTypeOf :: AltChooser -> DataType
toConstr :: AltChooser -> Constr
$ctoConstr :: AltChooser -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AltChooser
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AltChooser
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltChooser -> c AltChooser
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltChooser -> c AltChooser
$cp1Data :: Typeable AltChooser
Data)

data ColumnAlignMode
  = ColumnAlignModeDisabled
    -- ^ Make no column alignments whatsoever
  | ColumnAlignModeUnanimously
    -- ^ Make column alignments only if it does not cause overflow for any of
    -- the affected lines.
  | ColumnAlignModeMajority Float
    -- ^ If at least (ratio::Float) of the aligned elements have sufficient
    -- space for the alignment, act like ColumnAlignModeAnimously; otherwise
    -- act like ColumnAlignModeDisabled.
  | ColumnAlignModeAnimouslyScale Int
    -- ^ Scale back columns to some degree if their sum leads to overflow.
    -- This is done in a linear fashion.
    -- The Int specifies additional columns to be added to column maximum for
    -- scaling calculation purposes.
  | ColumnAlignModeAnimously
    -- ^ Decide on a case-by-case basis if alignment would cause overflow.
    -- If it does, cancel all alignments for this (nested) column description.
  -- ColumnAlignModeAnimouslySome -- potentially to implement
  | ColumnAlignModeAlways
    -- ^ Always respect column alignments, even if it makes stuff overflow.
  deriving (Int -> ColumnAlignMode -> ShowS
[ColumnAlignMode] -> ShowS
ColumnAlignMode -> String
(Int -> ColumnAlignMode -> ShowS)
-> (ColumnAlignMode -> String)
-> ([ColumnAlignMode] -> ShowS)
-> Show ColumnAlignMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnAlignMode] -> ShowS
$cshowList :: [ColumnAlignMode] -> ShowS
show :: ColumnAlignMode -> String
$cshow :: ColumnAlignMode -> String
showsPrec :: Int -> ColumnAlignMode -> ShowS
$cshowsPrec :: Int -> ColumnAlignMode -> ShowS
Show, (forall x. ColumnAlignMode -> Rep ColumnAlignMode x)
-> (forall x. Rep ColumnAlignMode x -> ColumnAlignMode)
-> Generic ColumnAlignMode
forall x. Rep ColumnAlignMode x -> ColumnAlignMode
forall x. ColumnAlignMode -> Rep ColumnAlignMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColumnAlignMode x -> ColumnAlignMode
$cfrom :: forall x. ColumnAlignMode -> Rep ColumnAlignMode x
Generic, Typeable ColumnAlignMode
DataType
Constr
Typeable ColumnAlignMode
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ColumnAlignMode -> c ColumnAlignMode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ColumnAlignMode)
-> (ColumnAlignMode -> Constr)
-> (ColumnAlignMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ColumnAlignMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ColumnAlignMode))
-> ((forall b. Data b => b -> b)
    -> ColumnAlignMode -> ColumnAlignMode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ColumnAlignMode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ColumnAlignMode -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ColumnAlignMode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ColumnAlignMode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ColumnAlignMode -> m ColumnAlignMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ColumnAlignMode -> m ColumnAlignMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ColumnAlignMode -> m ColumnAlignMode)
-> Data ColumnAlignMode
ColumnAlignMode -> DataType
ColumnAlignMode -> Constr
(forall b. Data b => b -> b) -> ColumnAlignMode -> ColumnAlignMode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnAlignMode -> c ColumnAlignMode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnAlignMode
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ColumnAlignMode -> u
forall u. (forall d. Data d => d -> u) -> ColumnAlignMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ColumnAlignMode -> m ColumnAlignMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnAlignMode -> m ColumnAlignMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnAlignMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnAlignMode -> c ColumnAlignMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColumnAlignMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColumnAlignMode)
$cColumnAlignModeAlways :: Constr
$cColumnAlignModeAnimously :: Constr
$cColumnAlignModeAnimouslyScale :: Constr
$cColumnAlignModeMajority :: Constr
$cColumnAlignModeUnanimously :: Constr
$cColumnAlignModeDisabled :: Constr
$tColumnAlignMode :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ColumnAlignMode -> m ColumnAlignMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnAlignMode -> m ColumnAlignMode
gmapMp :: (forall d. Data d => d -> m d)
-> ColumnAlignMode -> m ColumnAlignMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ColumnAlignMode -> m ColumnAlignMode
gmapM :: (forall d. Data d => d -> m d)
-> ColumnAlignMode -> m ColumnAlignMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ColumnAlignMode -> m ColumnAlignMode
gmapQi :: Int -> (forall d. Data d => d -> u) -> ColumnAlignMode -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ColumnAlignMode -> u
gmapQ :: (forall d. Data d => d -> u) -> ColumnAlignMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColumnAlignMode -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignMode -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColumnAlignMode -> r
gmapT :: (forall b. Data b => b -> b) -> ColumnAlignMode -> ColumnAlignMode
$cgmapT :: (forall b. Data b => b -> b) -> ColumnAlignMode -> ColumnAlignMode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColumnAlignMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColumnAlignMode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ColumnAlignMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColumnAlignMode)
dataTypeOf :: ColumnAlignMode -> DataType
$cdataTypeOf :: ColumnAlignMode -> DataType
toConstr :: ColumnAlignMode -> Constr
$ctoConstr :: ColumnAlignMode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnAlignMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColumnAlignMode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnAlignMode -> c ColumnAlignMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColumnAlignMode -> c ColumnAlignMode
$cp1Data :: Typeable ColumnAlignMode
Data)

data CPPMode = CPPModeAbort  -- abort program on seeing -XCPP
             | CPPModeWarn   -- warn about CPP and non-roundtripping in its
                             -- presence.
             | CPPModeNowarn -- silently allow CPP, if possible (i.e. input is
                             -- file.)
  deriving (Int -> CPPMode -> ShowS
[CPPMode] -> ShowS
CPPMode -> String
(Int -> CPPMode -> ShowS)
-> (CPPMode -> String) -> ([CPPMode] -> ShowS) -> Show CPPMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CPPMode] -> ShowS
$cshowList :: [CPPMode] -> ShowS
show :: CPPMode -> String
$cshow :: CPPMode -> String
showsPrec :: Int -> CPPMode -> ShowS
$cshowsPrec :: Int -> CPPMode -> ShowS
Show, (forall x. CPPMode -> Rep CPPMode x)
-> (forall x. Rep CPPMode x -> CPPMode) -> Generic CPPMode
forall x. Rep CPPMode x -> CPPMode
forall x. CPPMode -> Rep CPPMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CPPMode x -> CPPMode
$cfrom :: forall x. CPPMode -> Rep CPPMode x
Generic, Typeable CPPMode
DataType
Constr
Typeable CPPMode
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CPPMode -> c CPPMode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CPPMode)
-> (CPPMode -> Constr)
-> (CPPMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CPPMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CPPMode))
-> ((forall b. Data b => b -> b) -> CPPMode -> CPPMode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CPPMode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CPPMode -> r)
-> (forall u. (forall d. Data d => d -> u) -> CPPMode -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> CPPMode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CPPMode -> m CPPMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CPPMode -> m CPPMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CPPMode -> m CPPMode)
-> Data CPPMode
CPPMode -> DataType
CPPMode -> Constr
(forall b. Data b => b -> b) -> CPPMode -> CPPMode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CPPMode -> c CPPMode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CPPMode
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CPPMode -> u
forall u. (forall d. Data d => d -> u) -> CPPMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CPPMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CPPMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CPPMode -> m CPPMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CPPMode -> m CPPMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CPPMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CPPMode -> c CPPMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CPPMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CPPMode)
$cCPPModeNowarn :: Constr
$cCPPModeWarn :: Constr
$cCPPModeAbort :: Constr
$tCPPMode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CPPMode -> m CPPMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CPPMode -> m CPPMode
gmapMp :: (forall d. Data d => d -> m d) -> CPPMode -> m CPPMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CPPMode -> m CPPMode
gmapM :: (forall d. Data d => d -> m d) -> CPPMode -> m CPPMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CPPMode -> m CPPMode
gmapQi :: Int -> (forall d. Data d => d -> u) -> CPPMode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CPPMode -> u
gmapQ :: (forall d. Data d => d -> u) -> CPPMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CPPMode -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CPPMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CPPMode -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CPPMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CPPMode -> r
gmapT :: (forall b. Data b => b -> b) -> CPPMode -> CPPMode
$cgmapT :: (forall b. Data b => b -> b) -> CPPMode -> CPPMode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CPPMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CPPMode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CPPMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CPPMode)
dataTypeOf :: CPPMode -> DataType
$cdataTypeOf :: CPPMode -> DataType
toConstr :: CPPMode -> Constr
$ctoConstr :: CPPMode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CPPMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CPPMode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CPPMode -> c CPPMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CPPMode -> c CPPMode
$cp1Data :: Typeable CPPMode
Data)

data ExactPrintFallbackMode
  = ExactPrintFallbackModeNever  -- never fall back on exactprinting
  | ExactPrintFallbackModeInline -- fall back only if there are no newlines in
                                 -- the exactprint'ed output.
  | ExactPrintFallbackModeRisky  -- fall back even in the presence of newlines.
                                 -- THIS MAY THEORETICALLY CHANGE SEMANTICS OF
                                 -- A PROGRAM BY TRANSFORMING IT.
  deriving (Int -> ExactPrintFallbackMode -> ShowS
[ExactPrintFallbackMode] -> ShowS
ExactPrintFallbackMode -> String
(Int -> ExactPrintFallbackMode -> ShowS)
-> (ExactPrintFallbackMode -> String)
-> ([ExactPrintFallbackMode] -> ShowS)
-> Show ExactPrintFallbackMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExactPrintFallbackMode] -> ShowS
$cshowList :: [ExactPrintFallbackMode] -> ShowS
show :: ExactPrintFallbackMode -> String
$cshow :: ExactPrintFallbackMode -> String
showsPrec :: Int -> ExactPrintFallbackMode -> ShowS
$cshowsPrec :: Int -> ExactPrintFallbackMode -> ShowS
Show, (forall x. ExactPrintFallbackMode -> Rep ExactPrintFallbackMode x)
-> (forall x.
    Rep ExactPrintFallbackMode x -> ExactPrintFallbackMode)
-> Generic ExactPrintFallbackMode
forall x. Rep ExactPrintFallbackMode x -> ExactPrintFallbackMode
forall x. ExactPrintFallbackMode -> Rep ExactPrintFallbackMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExactPrintFallbackMode x -> ExactPrintFallbackMode
$cfrom :: forall x. ExactPrintFallbackMode -> Rep ExactPrintFallbackMode x
Generic, Typeable ExactPrintFallbackMode
DataType
Constr
Typeable ExactPrintFallbackMode
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ExactPrintFallbackMode
    -> c ExactPrintFallbackMode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ExactPrintFallbackMode)
-> (ExactPrintFallbackMode -> Constr)
-> (ExactPrintFallbackMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ExactPrintFallbackMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ExactPrintFallbackMode))
-> ((forall b. Data b => b -> b)
    -> ExactPrintFallbackMode -> ExactPrintFallbackMode)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ExactPrintFallbackMode
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> ExactPrintFallbackMode
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ExactPrintFallbackMode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ExactPrintFallbackMode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ExactPrintFallbackMode -> m ExactPrintFallbackMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ExactPrintFallbackMode -> m ExactPrintFallbackMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ExactPrintFallbackMode -> m ExactPrintFallbackMode)
-> Data ExactPrintFallbackMode
ExactPrintFallbackMode -> DataType
ExactPrintFallbackMode -> Constr
(forall b. Data b => b -> b)
-> ExactPrintFallbackMode -> ExactPrintFallbackMode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExactPrintFallbackMode
-> c ExactPrintFallbackMode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExactPrintFallbackMode
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ExactPrintFallbackMode -> u
forall u.
(forall d. Data d => d -> u) -> ExactPrintFallbackMode -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ExactPrintFallbackMode
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ExactPrintFallbackMode
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExactPrintFallbackMode -> m ExactPrintFallbackMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExactPrintFallbackMode -> m ExactPrintFallbackMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExactPrintFallbackMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExactPrintFallbackMode
-> c ExactPrintFallbackMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExactPrintFallbackMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExactPrintFallbackMode)
$cExactPrintFallbackModeRisky :: Constr
$cExactPrintFallbackModeInline :: Constr
$cExactPrintFallbackModeNever :: Constr
$tExactPrintFallbackMode :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ExactPrintFallbackMode -> m ExactPrintFallbackMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExactPrintFallbackMode -> m ExactPrintFallbackMode
gmapMp :: (forall d. Data d => d -> m d)
-> ExactPrintFallbackMode -> m ExactPrintFallbackMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExactPrintFallbackMode -> m ExactPrintFallbackMode
gmapM :: (forall d. Data d => d -> m d)
-> ExactPrintFallbackMode -> m ExactPrintFallbackMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExactPrintFallbackMode -> m ExactPrintFallbackMode
gmapQi :: Int -> (forall d. Data d => d -> u) -> ExactPrintFallbackMode -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ExactPrintFallbackMode -> u
gmapQ :: (forall d. Data d => d -> u) -> ExactPrintFallbackMode -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ExactPrintFallbackMode -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ExactPrintFallbackMode
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ExactPrintFallbackMode
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ExactPrintFallbackMode
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ExactPrintFallbackMode
-> r
gmapT :: (forall b. Data b => b -> b)
-> ExactPrintFallbackMode -> ExactPrintFallbackMode
$cgmapT :: (forall b. Data b => b -> b)
-> ExactPrintFallbackMode -> ExactPrintFallbackMode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExactPrintFallbackMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExactPrintFallbackMode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ExactPrintFallbackMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExactPrintFallbackMode)
dataTypeOf :: ExactPrintFallbackMode -> DataType
$cdataTypeOf :: ExactPrintFallbackMode -> DataType
toConstr :: ExactPrintFallbackMode -> Constr
$ctoConstr :: ExactPrintFallbackMode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExactPrintFallbackMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExactPrintFallbackMode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExactPrintFallbackMode
-> c ExactPrintFallbackMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ExactPrintFallbackMode
-> c ExactPrintFallbackMode
$cp1Data :: Typeable ExactPrintFallbackMode
Data)

instance CFunctor CDebugConfig
instance CFunctor CLayoutConfig
instance CFunctor CErrorHandlingConfig
instance CFunctor CForwardOptions
instance CFunctor CPreProcessorConfig
instance CFunctor CConfig

deriveCZipWith ''CDebugConfig
deriveCZipWith ''CLayoutConfig
deriveCZipWith ''CErrorHandlingConfig
deriveCZipWith ''CForwardOptions
deriveCZipWith ''CPreProcessorConfig
deriveCZipWith ''CConfig