{-# LANGUAGE DataKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE BangPatterns #-}

module Language.Haskell.Brittany.Internal.Types
where



#include "prelude.inc"

import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types

import qualified Data.Text.Lazy.Builder as Text.Builder

import           GHC ( Located, runGhc, GenLocated(L), moduleNameString, AnnKeywordId, SrcSpan )

import           Language.Haskell.GHC.ExactPrint ( AnnKey, Comment )
import           Language.Haskell.GHC.ExactPrint.Types ( KeywordId, Anns, DeltaPos, mkAnnKey )

import           Language.Haskell.Brittany.Internal.Config.Types

import           Data.Generics.Uniplate.Direct as Uniplate



data PerItemConfig = PerItemConfig
  { PerItemConfig -> Map String (CConfig Option)
_icd_perBinding :: Map String (CConfig Option)
  , PerItemConfig -> Map AnnKey (CConfig Option)
_icd_perKey :: Map ExactPrint.Types.AnnKey (CConfig Option)
  }
  deriving Typeable PerItemConfig
DataType
Constr
Typeable PerItemConfig
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PerItemConfig -> c PerItemConfig)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PerItemConfig)
-> (PerItemConfig -> Constr)
-> (PerItemConfig -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PerItemConfig))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PerItemConfig))
-> ((forall b. Data b => b -> b) -> PerItemConfig -> PerItemConfig)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PerItemConfig -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PerItemConfig -> r)
-> (forall u. (forall d. Data d => d -> u) -> PerItemConfig -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PerItemConfig -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PerItemConfig -> m PerItemConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PerItemConfig -> m PerItemConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PerItemConfig -> m PerItemConfig)
-> Data PerItemConfig
PerItemConfig -> DataType
PerItemConfig -> Constr
(forall b. Data b => b -> b) -> PerItemConfig -> PerItemConfig
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PerItemConfig -> c PerItemConfig
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PerItemConfig
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) -> PerItemConfig -> u
forall u. (forall d. Data d => d -> u) -> PerItemConfig -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PerItemConfig -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PerItemConfig -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PerItemConfig -> m PerItemConfig
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PerItemConfig -> m PerItemConfig
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PerItemConfig
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PerItemConfig -> c PerItemConfig
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PerItemConfig)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PerItemConfig)
$cPerItemConfig :: Constr
$tPerItemConfig :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PerItemConfig -> m PerItemConfig
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PerItemConfig -> m PerItemConfig
gmapMp :: (forall d. Data d => d -> m d) -> PerItemConfig -> m PerItemConfig
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PerItemConfig -> m PerItemConfig
gmapM :: (forall d. Data d => d -> m d) -> PerItemConfig -> m PerItemConfig
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PerItemConfig -> m PerItemConfig
gmapQi :: Int -> (forall d. Data d => d -> u) -> PerItemConfig -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PerItemConfig -> u
gmapQ :: (forall d. Data d => d -> u) -> PerItemConfig -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PerItemConfig -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PerItemConfig -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PerItemConfig -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PerItemConfig -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PerItemConfig -> r
gmapT :: (forall b. Data b => b -> b) -> PerItemConfig -> PerItemConfig
$cgmapT :: (forall b. Data b => b -> b) -> PerItemConfig -> PerItemConfig
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PerItemConfig)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PerItemConfig)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PerItemConfig)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PerItemConfig)
dataTypeOf :: PerItemConfig -> DataType
$cdataTypeOf :: PerItemConfig -> DataType
toConstr :: PerItemConfig -> Constr
$ctoConstr :: PerItemConfig -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PerItemConfig
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PerItemConfig
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PerItemConfig -> c PerItemConfig
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PerItemConfig -> c PerItemConfig
$cp1Data :: Typeable PerItemConfig
Data.Data.Data

type PPM = MultiRWSS.MultiRWS
  '[Map ExactPrint.AnnKey ExactPrint.Anns, PerItemConfig, Config, ExactPrint.Anns]
  '[Text.Builder.Builder, [BrittanyError], Seq String]
  '[]

type PPMLocal = MultiRWSS.MultiRWS
  '[Config, ExactPrint.Anns]
  '[Text.Builder.Builder, [BrittanyError], Seq String]
  '[]

newtype TopLevelDeclNameMap = TopLevelDeclNameMap (Map ExactPrint.AnnKey String)

data LayoutState = LayoutState
  { LayoutState -> [Int]
_lstate_baseYs         :: [Int]
     -- ^ stack of number of current indentation columns
     -- (not number of indentations).
  , LayoutState -> Either Int Int
_lstate_curYOrAddNewline :: Either Int Int
             -- ^ Either:
             -- 1) number of chars in the current line.
             -- 2) number of newlines to be inserted before inserting any
             --    non-space elements.
  , LayoutState -> [Int]
_lstate_indLevels      :: [Int]
    -- ^ stack of current indentation levels. set for
    -- any layout-affected elements such as
    -- let/do/case/where elements.
    -- The main purpose of this member is to
    -- properly align comments, as their
    -- annotation positions are relative to the
    -- current layout indentation level.
  , LayoutState -> Int
_lstate_indLevelLinger :: Int -- like a "last" of indLevel. Used for
                                  -- properly treating cases where comments
                                  -- on the first indented element have an
                                  -- annotation offset relative to the last
                                  -- non-indented element, which is confusing.
  , LayoutState -> Anns
_lstate_comments      :: Anns
  , LayoutState -> Maybe Int
_lstate_commentCol    :: Maybe Int -- this communicates two things:
                                       -- firstly, that cursor is currently
                                       -- at the end of a comment (so needs
                                       -- newline before any actual content).
                                       -- secondly, the column at which
                                       -- insertion of comments started.
  , LayoutState -> Maybe Int
_lstate_addSepSpace   :: Maybe Int -- number of spaces to insert if anyone
                                       -- writes (any non-spaces) in the
                                       -- current line.
  -- , _lstate_isNewline     :: NewLineState
  --     -- captures if the layouter currently is in a new line, i.e. if the
  --     -- current line only contains (indentation) spaces.
  -- this is mostly superseeded by curYOrAddNewline, iirc.
  , LayoutState -> Int
_lstate_commentNewlines :: Int -- number of newlines inserted due to
                                   -- move-to-DP at a start of a comment.
                                   -- Necessary because some keyword DPs
                                   -- are relative to the last non-comment
                                   -- entity (for some reason).
                                   -- This is not very strictly reset to 0,
                                   -- so we might in some cases get "artifacts"
                                   -- from previous document elements.
                                   -- But the worst effect at the moment would
                                   -- be that we introduce less newlines on
                                   -- moveToKWDP, which seems harmless enough.
  }

lstate_baseY :: LayoutState -> Int
lstate_baseY :: LayoutState -> Int
lstate_baseY = String -> [Int] -> Int
forall a. Partial => String -> [a] -> a
Safe.headNote String
"lstate_baseY" ([Int] -> Int) -> (LayoutState -> [Int]) -> LayoutState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutState -> [Int]
_lstate_baseYs

lstate_indLevel :: LayoutState -> Int
lstate_indLevel :: LayoutState -> Int
lstate_indLevel = String -> [Int] -> Int
forall a. Partial => String -> [a] -> a
Safe.headNote String
"lstate_baseY" ([Int] -> Int) -> (LayoutState -> [Int]) -> LayoutState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutState -> [Int]
_lstate_indLevels

-- evil, incomplete Show instance; only for debugging.
instance Show LayoutState where
  show :: LayoutState -> String
show LayoutState
state =
    String
"LayoutState"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"{baseYs=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (LayoutState -> [Int]
_lstate_baseYs LayoutState
state)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",curYOrAddNewline=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Either Int Int -> String
forall a. Show a => a -> String
show (LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",indLevels=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (LayoutState -> [Int]
_lstate_indLevels LayoutState
state)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",indLevelLinger=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (LayoutState -> Int
_lstate_indLevelLinger LayoutState
state)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",commentCol=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> String
forall a. Show a => a -> String
show (LayoutState -> Maybe Int
_lstate_commentCol LayoutState
state)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",addSepSpace=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> String
forall a. Show a => a -> String
show (LayoutState -> Maybe Int
_lstate_addSepSpace LayoutState
state)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",commentNewlines=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (LayoutState -> Int
_lstate_commentNewlines LayoutState
state)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

-- data NewLineState = NewLineStateInit -- initial state. we do not know if in a
--                                      -- newline, really. by special-casing
--                                      -- this we can appropriately handle it
--                                      -- differently at use-site.
--                   | NewLineStateYes
--                   | NewLineStateNo
--   deriving Eq

-- data LayoutSettings = LayoutSettings
--   { _lsettings_cols :: Int -- the thing that has default 80.
--   , _lsettings_indentPolicy :: IndentPolicy
--   , _lsettings_indentAmount :: Int
--   , _lsettings_indentWhereSpecial :: Bool -- indent where only 1 sometimes (TODO).
--   , _lsettings_indentListSpecial  :: Bool -- use some special indentation for ","
--                                           -- when creating zero-indentation
--                                           -- multi-line list literals.
--   , _lsettings_importColumn :: Int
--   , _lsettings_initialAnns :: ExactPrint.Anns
--   }

data BrittanyError
  = ErrorInput String
    -- ^ parsing failed
  | ErrorUnusedComment String
    -- ^ internal error: some comment went missing
  | ErrorMacroConfig String String
    -- ^ in-source config string parsing error; first argument is the parser
    --   output and second the corresponding, ill-formed input.
  | LayoutWarning String
    -- ^ some warning
  | forall ast . Data.Data.Data ast => ErrorUnknownNode String (GenLocated SrcSpan ast)
    -- ^ internal error: pretty-printing is not implemented for type of node
    --   in the syntax-tree
  | ErrorOutputCheck
    -- ^ checking the output for syntactic validity failed

data BriSpacing = BriSpacing
  { BriSpacing -> Int
_bs_spacePastLineIndent :: Int -- space in the current,
                                   -- potentially somewhat filled
                                   -- line.
  , BriSpacing -> Int
_bs_spacePastIndent :: Int     -- space required in properly
                                   -- indented blocks below the
                                   -- current line.
  }

data ColSig
  = ColTyOpPrefix
    -- any prefixed operator/paren/"::"/..
    -- expected to have exactly two colums.
    -- e.g. ":: foo"
    --       111222
    --      "-> bar asd asd"
    --       11122222222222
  | ColPatternsFuncPrefix
    -- pattern-part of the lhs, e.g. "func (foo a b) c _".
    -- Has variable number of columns depending on the number of patterns.
  | ColPatternsFuncInfix
    -- pattern-part of the lhs, e.g. "Foo a <> Foo b".
    -- Has variable number of columns depending on the number of patterns.
  | ColPatterns
  | ColCasePattern
  | ColBindingLine (Maybe Text)
    -- e.g. "func pat pat = expr"
    --       1111111111111222222
    -- or   "pat | stmt -> expr"
    --       111111111112222222
    -- expected to have exactly two columns.
  | ColGuard
    -- e.g. "func pat pat | cond = ..."
    --       11111111111112222222
    -- or   "pat | cond1, cond2 -> ..."
    --       1111222222222222222
    -- expected to have exactly two columns
  | ColGuardedBody
    -- e.g. | foofoo = 1
    --      | bar    = 2
    --      111111111222
    -- expected to have exactly two columns
  | ColBindStmt
  | ColDoLet -- the non-indented variant
  | ColRec
  | ColRecUpdate -- used for both RecCon and RecUpd. TODO: refactor to reflect?
  | ColRecDecl
  | ColListComp
  | ColList
  | ColApp Text
  | ColTuple
  | ColTuples
  | ColOpPrefix -- merge with ColList ? other stuff?
  | ColImport

  -- TODO
  deriving (ColSig -> ColSig -> Bool
(ColSig -> ColSig -> Bool)
-> (ColSig -> ColSig -> Bool) -> Eq ColSig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColSig -> ColSig -> Bool
$c/= :: ColSig -> ColSig -> Bool
== :: ColSig -> ColSig -> Bool
$c== :: ColSig -> ColSig -> Bool
Eq, Eq ColSig
Eq ColSig
-> (ColSig -> ColSig -> Ordering)
-> (ColSig -> ColSig -> Bool)
-> (ColSig -> ColSig -> Bool)
-> (ColSig -> ColSig -> Bool)
-> (ColSig -> ColSig -> Bool)
-> (ColSig -> ColSig -> ColSig)
-> (ColSig -> ColSig -> ColSig)
-> Ord ColSig
ColSig -> ColSig -> Bool
ColSig -> ColSig -> Ordering
ColSig -> ColSig -> ColSig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColSig -> ColSig -> ColSig
$cmin :: ColSig -> ColSig -> ColSig
max :: ColSig -> ColSig -> ColSig
$cmax :: ColSig -> ColSig -> ColSig
>= :: ColSig -> ColSig -> Bool
$c>= :: ColSig -> ColSig -> Bool
> :: ColSig -> ColSig -> Bool
$c> :: ColSig -> ColSig -> Bool
<= :: ColSig -> ColSig -> Bool
$c<= :: ColSig -> ColSig -> Bool
< :: ColSig -> ColSig -> Bool
$c< :: ColSig -> ColSig -> Bool
compare :: ColSig -> ColSig -> Ordering
$ccompare :: ColSig -> ColSig -> Ordering
$cp1Ord :: Eq ColSig
Ord, Typeable ColSig
DataType
Constr
Typeable ColSig
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ColSig -> c ColSig)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ColSig)
-> (ColSig -> Constr)
-> (ColSig -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ColSig))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColSig))
-> ((forall b. Data b => b -> b) -> ColSig -> ColSig)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ColSig -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ColSig -> r)
-> (forall u. (forall d. Data d => d -> u) -> ColSig -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ColSig -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ColSig -> m ColSig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ColSig -> m ColSig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ColSig -> m ColSig)
-> Data ColSig
ColSig -> DataType
ColSig -> Constr
(forall b. Data b => b -> b) -> ColSig -> ColSig
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColSig -> c ColSig
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColSig
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) -> ColSig -> u
forall u. (forall d. Data d => d -> u) -> ColSig -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ColSig -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ColSig -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColSig -> m ColSig
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColSig -> m ColSig
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColSig
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColSig -> c ColSig
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColSig)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColSig)
$cColImport :: Constr
$cColOpPrefix :: Constr
$cColTuples :: Constr
$cColTuple :: Constr
$cColApp :: Constr
$cColList :: Constr
$cColListComp :: Constr
$cColRecDecl :: Constr
$cColRecUpdate :: Constr
$cColRec :: Constr
$cColDoLet :: Constr
$cColBindStmt :: Constr
$cColGuardedBody :: Constr
$cColGuard :: Constr
$cColBindingLine :: Constr
$cColCasePattern :: Constr
$cColPatterns :: Constr
$cColPatternsFuncInfix :: Constr
$cColPatternsFuncPrefix :: Constr
$cColTyOpPrefix :: Constr
$tColSig :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ColSig -> m ColSig
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColSig -> m ColSig
gmapMp :: (forall d. Data d => d -> m d) -> ColSig -> m ColSig
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColSig -> m ColSig
gmapM :: (forall d. Data d => d -> m d) -> ColSig -> m ColSig
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColSig -> m ColSig
gmapQi :: Int -> (forall d. Data d => d -> u) -> ColSig -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColSig -> u
gmapQ :: (forall d. Data d => d -> u) -> ColSig -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColSig -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ColSig -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ColSig -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ColSig -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ColSig -> r
gmapT :: (forall b. Data b => b -> b) -> ColSig -> ColSig
$cgmapT :: (forall b. Data b => b -> b) -> ColSig -> ColSig
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColSig)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColSig)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ColSig)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColSig)
dataTypeOf :: ColSig -> DataType
$cdataTypeOf :: ColSig -> DataType
toConstr :: ColSig -> Constr
$ctoConstr :: ColSig -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColSig
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColSig
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColSig -> c ColSig
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColSig -> c ColSig
$cp1Data :: Typeable ColSig
Data.Data.Data, Int -> ColSig -> ShowS
[ColSig] -> ShowS
ColSig -> String
(Int -> ColSig -> ShowS)
-> (ColSig -> String) -> ([ColSig] -> ShowS) -> Show ColSig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColSig] -> ShowS
$cshowList :: [ColSig] -> ShowS
show :: ColSig -> String
$cshow :: ColSig -> String
showsPrec :: Int -> ColSig -> ShowS
$cshowsPrec :: Int -> ColSig -> ShowS
Show)

data BrIndent = BrIndentNone
              | BrIndentRegular
              | BrIndentSpecial Int
  deriving (BrIndent -> BrIndent -> Bool
(BrIndent -> BrIndent -> Bool)
-> (BrIndent -> BrIndent -> Bool) -> Eq BrIndent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrIndent -> BrIndent -> Bool
$c/= :: BrIndent -> BrIndent -> Bool
== :: BrIndent -> BrIndent -> Bool
$c== :: BrIndent -> BrIndent -> Bool
Eq, Eq BrIndent
Eq BrIndent
-> (BrIndent -> BrIndent -> Ordering)
-> (BrIndent -> BrIndent -> Bool)
-> (BrIndent -> BrIndent -> Bool)
-> (BrIndent -> BrIndent -> Bool)
-> (BrIndent -> BrIndent -> Bool)
-> (BrIndent -> BrIndent -> BrIndent)
-> (BrIndent -> BrIndent -> BrIndent)
-> Ord BrIndent
BrIndent -> BrIndent -> Bool
BrIndent -> BrIndent -> Ordering
BrIndent -> BrIndent -> BrIndent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BrIndent -> BrIndent -> BrIndent
$cmin :: BrIndent -> BrIndent -> BrIndent
max :: BrIndent -> BrIndent -> BrIndent
$cmax :: BrIndent -> BrIndent -> BrIndent
>= :: BrIndent -> BrIndent -> Bool
$c>= :: BrIndent -> BrIndent -> Bool
> :: BrIndent -> BrIndent -> Bool
$c> :: BrIndent -> BrIndent -> Bool
<= :: BrIndent -> BrIndent -> Bool
$c<= :: BrIndent -> BrIndent -> Bool
< :: BrIndent -> BrIndent -> Bool
$c< :: BrIndent -> BrIndent -> Bool
compare :: BrIndent -> BrIndent -> Ordering
$ccompare :: BrIndent -> BrIndent -> Ordering
$cp1Ord :: Eq BrIndent
Ord, Typeable, Typeable BrIndent
DataType
Constr
Typeable BrIndent
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BrIndent -> c BrIndent)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BrIndent)
-> (BrIndent -> Constr)
-> (BrIndent -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BrIndent))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BrIndent))
-> ((forall b. Data b => b -> b) -> BrIndent -> BrIndent)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BrIndent -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BrIndent -> r)
-> (forall u. (forall d. Data d => d -> u) -> BrIndent -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> BrIndent -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BrIndent -> m BrIndent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BrIndent -> m BrIndent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BrIndent -> m BrIndent)
-> Data BrIndent
BrIndent -> DataType
BrIndent -> Constr
(forall b. Data b => b -> b) -> BrIndent -> BrIndent
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BrIndent -> c BrIndent
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BrIndent
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) -> BrIndent -> u
forall u. (forall d. Data d => d -> u) -> BrIndent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BrIndent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BrIndent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BrIndent -> m BrIndent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BrIndent -> m BrIndent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BrIndent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BrIndent -> c BrIndent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BrIndent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BrIndent)
$cBrIndentSpecial :: Constr
$cBrIndentRegular :: Constr
$cBrIndentNone :: Constr
$tBrIndent :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BrIndent -> m BrIndent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BrIndent -> m BrIndent
gmapMp :: (forall d. Data d => d -> m d) -> BrIndent -> m BrIndent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BrIndent -> m BrIndent
gmapM :: (forall d. Data d => d -> m d) -> BrIndent -> m BrIndent
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BrIndent -> m BrIndent
gmapQi :: Int -> (forall d. Data d => d -> u) -> BrIndent -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BrIndent -> u
gmapQ :: (forall d. Data d => d -> u) -> BrIndent -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BrIndent -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BrIndent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BrIndent -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BrIndent -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BrIndent -> r
gmapT :: (forall b. Data b => b -> b) -> BrIndent -> BrIndent
$cgmapT :: (forall b. Data b => b -> b) -> BrIndent -> BrIndent
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BrIndent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BrIndent)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c BrIndent)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BrIndent)
dataTypeOf :: BrIndent -> DataType
$cdataTypeOf :: BrIndent -> DataType
toConstr :: BrIndent -> Constr
$ctoConstr :: BrIndent -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BrIndent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BrIndent
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BrIndent -> c BrIndent
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BrIndent -> c BrIndent
$cp1Data :: Typeable BrIndent
Data.Data.Data, Int -> BrIndent -> ShowS
[BrIndent] -> ShowS
BrIndent -> String
(Int -> BrIndent -> ShowS)
-> (BrIndent -> String) -> ([BrIndent] -> ShowS) -> Show BrIndent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrIndent] -> ShowS
$cshowList :: [BrIndent] -> ShowS
show :: BrIndent -> String
$cshow :: BrIndent -> String
showsPrec :: Int -> BrIndent -> ShowS
$cshowsPrec :: Int -> BrIndent -> ShowS
Show)

type ToBriDocM = MultiRWSS.MultiRWS
                   '[Config, Anns] -- reader
                   '[[BrittanyError], Seq String] -- writer
                   '[NodeAllocIndex] -- state

type ToBriDoc (sym :: * -> *) = Located (sym GhcPs) -> ToBriDocM BriDocNumbered
type ToBriDoc' sym            = Located sym         -> ToBriDocM BriDocNumbered
type ToBriDocC sym c          = Located sym         -> ToBriDocM c

data DocMultiLine
  = MultiLineNo
  | MultiLinePossible
  deriving (DocMultiLine -> DocMultiLine -> Bool
(DocMultiLine -> DocMultiLine -> Bool)
-> (DocMultiLine -> DocMultiLine -> Bool) -> Eq DocMultiLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocMultiLine -> DocMultiLine -> Bool
$c/= :: DocMultiLine -> DocMultiLine -> Bool
== :: DocMultiLine -> DocMultiLine -> Bool
$c== :: DocMultiLine -> DocMultiLine -> Bool
Eq, Typeable)

-- isomorphic to BriDocF Identity. Provided for ease of use, as we do a lot
-- of transformations on `BriDocF Identity`s and it is really annoying to
-- `Identity`/`runIdentity` everywhere.
data BriDoc
  = -- BDWrapAnnKey AnnKey BriDoc
    BDEmpty
  | BDLit !Text
  | BDSeq [BriDoc] -- elements other than the last should
                   -- not contains BDPars.
  | BDCols ColSig [BriDoc] -- elements other than the last
                         -- should not contains BDPars
  | BDSeparator -- semantically, space-unless-at-end-of-line.
  | BDAddBaseY BrIndent BriDoc
  | BDBaseYPushCur BriDoc
  | BDBaseYPop BriDoc
  | BDIndentLevelPushCur BriDoc
  | BDIndentLevelPop BriDoc
  | BDPar
    { BriDoc -> BrIndent
_bdpar_indent :: BrIndent
    , BriDoc -> BriDoc
_bdpar_restOfLine :: BriDoc -- should not contain other BDPars
    , BriDoc -> BriDoc
_bdpar_indented :: BriDoc
    }
  -- | BDAddIndent BrIndent (BriDocF f)
  -- | BDNewline
  | BDAlt [BriDoc]
  | BDForwardLineMode BriDoc
  | BDExternal AnnKey
               (Set AnnKey) -- set of annkeys contained within the node
                            -- to be printed via exactprint
               Bool -- should print extra comment ?
               Text
  | BDPlain !Text -- used for QuasiQuotes, content can be multi-line
                  -- (contrast to BDLit)
  | BDAnnotationPrior AnnKey BriDoc
  | BDAnnotationKW AnnKey (Maybe AnnKeywordId) BriDoc
  | BDAnnotationRest  AnnKey BriDoc
  | BDMoveToKWDP AnnKey AnnKeywordId Bool BriDoc -- True if should respect x offset
  | BDLines [BriDoc]
  | BDEnsureIndent BrIndent BriDoc
  -- the following constructors are only relevant for the alt transformation
  -- and are removed afterwards. They should never occur in any BriDoc
  -- after the alt transformation.
  | BDForceMultiline BriDoc
  | BDForceSingleline BriDoc
  | BDNonBottomSpacing Bool BriDoc
  | BDSetParSpacing BriDoc
  | BDForceParSpacing BriDoc
  -- pseudo-deprecated
  | BDDebug String BriDoc
  deriving (Typeable BriDoc
DataType
Constr
Typeable BriDoc
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BriDoc -> c BriDoc)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BriDoc)
-> (BriDoc -> Constr)
-> (BriDoc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BriDoc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BriDoc))
-> ((forall b. Data b => b -> b) -> BriDoc -> BriDoc)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BriDoc -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BriDoc -> r)
-> (forall u. (forall d. Data d => d -> u) -> BriDoc -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> BriDoc -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BriDoc -> m BriDoc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BriDoc -> m BriDoc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BriDoc -> m BriDoc)
-> Data BriDoc
BriDoc -> DataType
BriDoc -> Constr
(forall b. Data b => b -> b) -> BriDoc -> BriDoc
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BriDoc -> c BriDoc
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BriDoc
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) -> BriDoc -> u
forall u. (forall d. Data d => d -> u) -> BriDoc -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BriDoc -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BriDoc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BriDoc -> m BriDoc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BriDoc -> m BriDoc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BriDoc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BriDoc -> c BriDoc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BriDoc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BriDoc)
$cBDDebug :: Constr
$cBDForceParSpacing :: Constr
$cBDSetParSpacing :: Constr
$cBDNonBottomSpacing :: Constr
$cBDForceSingleline :: Constr
$cBDForceMultiline :: Constr
$cBDEnsureIndent :: Constr
$cBDLines :: Constr
$cBDMoveToKWDP :: Constr
$cBDAnnotationRest :: Constr
$cBDAnnotationKW :: Constr
$cBDAnnotationPrior :: Constr
$cBDPlain :: Constr
$cBDExternal :: Constr
$cBDForwardLineMode :: Constr
$cBDAlt :: Constr
$cBDPar :: Constr
$cBDIndentLevelPop :: Constr
$cBDIndentLevelPushCur :: Constr
$cBDBaseYPop :: Constr
$cBDBaseYPushCur :: Constr
$cBDAddBaseY :: Constr
$cBDSeparator :: Constr
$cBDCols :: Constr
$cBDSeq :: Constr
$cBDLit :: Constr
$cBDEmpty :: Constr
$tBriDoc :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BriDoc -> m BriDoc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BriDoc -> m BriDoc
gmapMp :: (forall d. Data d => d -> m d) -> BriDoc -> m BriDoc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BriDoc -> m BriDoc
gmapM :: (forall d. Data d => d -> m d) -> BriDoc -> m BriDoc
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BriDoc -> m BriDoc
gmapQi :: Int -> (forall d. Data d => d -> u) -> BriDoc -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BriDoc -> u
gmapQ :: (forall d. Data d => d -> u) -> BriDoc -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BriDoc -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BriDoc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BriDoc -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BriDoc -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BriDoc -> r
gmapT :: (forall b. Data b => b -> b) -> BriDoc -> BriDoc
$cgmapT :: (forall b. Data b => b -> b) -> BriDoc -> BriDoc
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BriDoc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BriDoc)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c BriDoc)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BriDoc)
dataTypeOf :: BriDoc -> DataType
$cdataTypeOf :: BriDoc -> DataType
toConstr :: BriDoc -> Constr
$ctoConstr :: BriDoc -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BriDoc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BriDoc
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BriDoc -> c BriDoc
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BriDoc -> c BriDoc
$cp1Data :: Typeable BriDoc
Data.Data.Data, BriDoc -> BriDoc -> Bool
(BriDoc -> BriDoc -> Bool)
-> (BriDoc -> BriDoc -> Bool) -> Eq BriDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BriDoc -> BriDoc -> Bool
$c/= :: BriDoc -> BriDoc -> Bool
== :: BriDoc -> BriDoc -> Bool
$c== :: BriDoc -> BriDoc -> Bool
Eq, Eq BriDoc
Eq BriDoc
-> (BriDoc -> BriDoc -> Ordering)
-> (BriDoc -> BriDoc -> Bool)
-> (BriDoc -> BriDoc -> Bool)
-> (BriDoc -> BriDoc -> Bool)
-> (BriDoc -> BriDoc -> Bool)
-> (BriDoc -> BriDoc -> BriDoc)
-> (BriDoc -> BriDoc -> BriDoc)
-> Ord BriDoc
BriDoc -> BriDoc -> Bool
BriDoc -> BriDoc -> Ordering
BriDoc -> BriDoc -> BriDoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BriDoc -> BriDoc -> BriDoc
$cmin :: BriDoc -> BriDoc -> BriDoc
max :: BriDoc -> BriDoc -> BriDoc
$cmax :: BriDoc -> BriDoc -> BriDoc
>= :: BriDoc -> BriDoc -> Bool
$c>= :: BriDoc -> BriDoc -> Bool
> :: BriDoc -> BriDoc -> Bool
$c> :: BriDoc -> BriDoc -> Bool
<= :: BriDoc -> BriDoc -> Bool
$c<= :: BriDoc -> BriDoc -> Bool
< :: BriDoc -> BriDoc -> Bool
$c< :: BriDoc -> BriDoc -> Bool
compare :: BriDoc -> BriDoc -> Ordering
$ccompare :: BriDoc -> BriDoc -> Ordering
$cp1Ord :: Eq BriDoc
Ord)

data BriDocF f
  = -- BDWrapAnnKey AnnKey BriDoc
    BDFEmpty
  | BDFLit !Text
  | BDFSeq [f (BriDocF f)] -- elements other than the last should
                   -- not contains BDPars.
  | BDFCols ColSig [f (BriDocF f)] -- elements other than the last
                         -- should not contains BDPars
  | BDFSeparator -- semantically, space-unless-at-end-of-line.
  | BDFAddBaseY BrIndent (f (BriDocF f))
  | BDFBaseYPushCur (f (BriDocF f))
  | BDFBaseYPop (f (BriDocF f))
  | BDFIndentLevelPushCur (f (BriDocF f))
  | BDFIndentLevelPop (f (BriDocF f))
  | BDFPar
    { BriDocF f -> BrIndent
_bdfpar_indent :: BrIndent
    , BriDocF f -> f (BriDocF f)
_bdfpar_restOfLine :: f (BriDocF f) -- should not contain other BDPars
    , BriDocF f -> f (BriDocF f)
_bdfpar_indented :: f (BriDocF f)
    }
  -- | BDAddIndent BrIndent (BriDocF f)
  -- | BDNewline
  | BDFAlt [f (BriDocF f)]
  | BDFForwardLineMode (f (BriDocF f))
  | BDFExternal AnnKey
               (Set AnnKey) -- set of annkeys contained within the node
                            -- to be printed via exactprint
               Bool -- should print extra comment ?
               Text
  | BDFPlain !Text -- used for QuasiQuotes, content can be multi-line
                   -- (contrast to BDLit)
  | BDFAnnotationPrior AnnKey (f (BriDocF f))
  | BDFAnnotationKW AnnKey (Maybe AnnKeywordId) (f (BriDocF f))
  | BDFAnnotationRest  AnnKey (f (BriDocF f))
  | BDFMoveToKWDP AnnKey AnnKeywordId Bool (f (BriDocF f)) -- True if should respect x offset
  | BDFLines [(f (BriDocF f))]
  | BDFEnsureIndent BrIndent (f (BriDocF f))
  | BDFForceMultiline (f (BriDocF f))
  | BDFForceSingleline (f (BriDocF f))
  | BDFNonBottomSpacing Bool (f (BriDocF f))
  | BDFSetParSpacing (f (BriDocF f))
  | BDFForceParSpacing (f (BriDocF f))
  | BDFDebug String (f (BriDocF f))

-- deriving instance Data.Data.Data (BriDocF Identity)
deriving instance Data.Data.Data (BriDocF ((,) Int))

type BriDocFInt = BriDocF ((,) Int)
type BriDocNumbered = (Int, BriDocFInt)

instance Uniplate.Uniplate BriDoc where
  uniplate :: BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
uniplate x :: BriDoc
x@BDEmpty{}               = BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall from to. from -> Type from to
plate BriDoc
x
  uniplate x :: BriDoc
x@BDLit{}                 = BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall from to. from -> Type from to
plate BriDoc
x
  uniplate (BDSeq [BriDoc]
list     )         = ([BriDoc] -> BriDoc) -> Type ([BriDoc] -> BriDoc) BriDoc
forall from to. from -> Type from to
plate [BriDoc] -> BriDoc
BDSeq Type ([BriDoc] -> BriDoc) BriDoc
-> [BriDoc] -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type ([to] -> from) to -> [to] -> Type from to
||* [BriDoc]
list
  uniplate (BDCols ColSig
sig [BriDoc]
list)         = (ColSig -> [BriDoc] -> BriDoc)
-> Type (ColSig -> [BriDoc] -> BriDoc) BriDoc
forall from to. from -> Type from to
plate ColSig -> [BriDoc] -> BriDoc
BDCols Type (ColSig -> [BriDoc] -> BriDoc) BriDoc
-> ColSig -> Type ([BriDoc] -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- ColSig
sig Type ([BriDoc] -> BriDoc) BriDoc
-> [BriDoc] -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type ([to] -> from) to -> [to] -> Type from to
||* [BriDoc]
list
  uniplate x :: BriDoc
x@BriDoc
BDSeparator             = BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall from to. from -> Type from to
plate BriDoc
x
  uniplate (BDAddBaseY BrIndent
ind BriDoc
bd      ) = (BrIndent -> BriDoc -> BriDoc)
-> Type (BrIndent -> BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BrIndent -> BriDoc -> BriDoc
BDAddBaseY Type (BrIndent -> BriDoc -> BriDoc) BriDoc
-> BrIndent -> Type (BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- BrIndent
ind Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDBaseYPushCur       BriDoc
bd) = (BriDoc -> BriDoc) -> Type (BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BriDoc -> BriDoc
BDBaseYPushCur Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDBaseYPop           BriDoc
bd) = (BriDoc -> BriDoc) -> Type (BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BriDoc -> BriDoc
BDBaseYPop Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDIndentLevelPushCur BriDoc
bd) = (BriDoc -> BriDoc) -> Type (BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BriDoc -> BriDoc
BDIndentLevelPushCur Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDIndentLevelPop     BriDoc
bd) = (BriDoc -> BriDoc) -> Type (BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BriDoc -> BriDoc
BDIndentLevelPop Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDPar BrIndent
ind BriDoc
line BriDoc
indented) = (BrIndent -> BriDoc -> BriDoc -> BriDoc)
-> Type (BrIndent -> BriDoc -> BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BrIndent -> BriDoc -> BriDoc -> BriDoc
BDPar Type (BrIndent -> BriDoc -> BriDoc -> BriDoc) BriDoc
-> BrIndent -> Type (BriDoc -> BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- BrIndent
ind Type (BriDoc -> BriDoc -> BriDoc) BriDoc
-> BriDoc -> Type (BriDoc -> BriDoc) BriDoc
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
line Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
indented
  uniplate (BDAlt             [BriDoc]
alts ) = ([BriDoc] -> BriDoc) -> Type ([BriDoc] -> BriDoc) BriDoc
forall from to. from -> Type from to
plate [BriDoc] -> BriDoc
BDAlt Type ([BriDoc] -> BriDoc) BriDoc
-> [BriDoc] -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type ([to] -> from) to -> [to] -> Type from to
||* [BriDoc]
alts
  uniplate (BDForwardLineMode BriDoc
bd   ) = (BriDoc -> BriDoc) -> Type (BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BriDoc -> BriDoc
BDForwardLineMode Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate x :: BriDoc
x@BDExternal{}            = BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall from to. from -> Type from to
plate BriDoc
x
  uniplate x :: BriDoc
x@BDPlain{}               = BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall from to. from -> Type from to
plate BriDoc
x
  uniplate (BDAnnotationPrior AnnKey
annKey BriDoc
bd) =
    (AnnKey -> BriDoc -> BriDoc)
-> Type (AnnKey -> BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate AnnKey -> BriDoc -> BriDoc
BDAnnotationPrior Type (AnnKey -> BriDoc -> BriDoc) BriDoc
-> AnnKey -> Type (BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- AnnKey
annKey Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDAnnotationKW AnnKey
annKey Maybe AnnKeywordId
kw BriDoc
bd) =
    (AnnKey -> Maybe AnnKeywordId -> BriDoc -> BriDoc)
-> Type (AnnKey -> Maybe AnnKeywordId -> BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate AnnKey -> Maybe AnnKeywordId -> BriDoc -> BriDoc
BDAnnotationKW Type (AnnKey -> Maybe AnnKeywordId -> BriDoc -> BriDoc) BriDoc
-> AnnKey -> Type (Maybe AnnKeywordId -> BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- AnnKey
annKey Type (Maybe AnnKeywordId -> BriDoc -> BriDoc) BriDoc
-> Maybe AnnKeywordId -> Type (BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- Maybe AnnKeywordId
kw Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDAnnotationRest AnnKey
annKey BriDoc
bd) =
    (AnnKey -> BriDoc -> BriDoc)
-> Type (AnnKey -> BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate AnnKey -> BriDoc -> BriDoc
BDAnnotationRest Type (AnnKey -> BriDoc -> BriDoc) BriDoc
-> AnnKey -> Type (BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- AnnKey
annKey Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDMoveToKWDP AnnKey
annKey AnnKeywordId
kw Bool
b BriDoc
bd) =
    (AnnKey -> AnnKeywordId -> Bool -> BriDoc -> BriDoc)
-> Type (AnnKey -> AnnKeywordId -> Bool -> BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate AnnKey -> AnnKeywordId -> Bool -> BriDoc -> BriDoc
BDMoveToKWDP Type (AnnKey -> AnnKeywordId -> Bool -> BriDoc -> BriDoc) BriDoc
-> AnnKey -> Type (AnnKeywordId -> Bool -> BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- AnnKey
annKey Type (AnnKeywordId -> Bool -> BriDoc -> BriDoc) BriDoc
-> AnnKeywordId -> Type (Bool -> BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- AnnKeywordId
kw Type (Bool -> BriDoc -> BriDoc) BriDoc
-> Bool -> Type (BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- Bool
b Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDLines [BriDoc]
lines          ) = ([BriDoc] -> BriDoc) -> Type ([BriDoc] -> BriDoc) BriDoc
forall from to. from -> Type from to
plate [BriDoc] -> BriDoc
BDLines Type ([BriDoc] -> BriDoc) BriDoc
-> [BriDoc] -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type ([to] -> from) to -> [to] -> Type from to
||* [BriDoc]
lines
  uniplate (BDEnsureIndent BrIndent
ind BriDoc
bd  ) = (BrIndent -> BriDoc -> BriDoc)
-> Type (BrIndent -> BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BrIndent -> BriDoc -> BriDoc
BDEnsureIndent Type (BrIndent -> BriDoc -> BriDoc) BriDoc
-> BrIndent -> Type (BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- BrIndent
ind Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDForceMultiline  BriDoc
bd   ) = (BriDoc -> BriDoc) -> Type (BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BriDoc -> BriDoc
BDForceMultiline Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDForceSingleline BriDoc
bd   ) = (BriDoc -> BriDoc) -> Type (BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BriDoc -> BriDoc
BDForceSingleline Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDNonBottomSpacing Bool
b BriDoc
bd) = (Bool -> BriDoc -> BriDoc)
-> Type (Bool -> BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate Bool -> BriDoc -> BriDoc
BDNonBottomSpacing Type (Bool -> BriDoc -> BriDoc) BriDoc
-> Bool -> Type (BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- Bool
b Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDSetParSpacing   BriDoc
bd   ) = (BriDoc -> BriDoc) -> Type (BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BriDoc -> BriDoc
BDSetParSpacing Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDForceParSpacing BriDoc
bd   ) = (BriDoc -> BriDoc) -> Type (BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate BriDoc -> BriDoc
BDForceParSpacing Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd
  uniplate (BDDebug String
s BriDoc
bd           ) = (String -> BriDoc -> BriDoc)
-> Type (String -> BriDoc -> BriDoc) BriDoc
forall from to. from -> Type from to
plate String -> BriDoc -> BriDoc
BDDebug Type (String -> BriDoc -> BriDoc) BriDoc
-> String -> Type (BriDoc -> BriDoc) BriDoc
forall item from to. Type (item -> from) to -> item -> Type from to
|- String
s Type (BriDoc -> BriDoc) BriDoc
-> BriDoc -> (Str BriDoc, Str BriDoc -> BriDoc)
forall to from. Type (to -> from) to -> to -> Type from to
|* BriDoc
bd

newtype NodeAllocIndex = NodeAllocIndex Int

-- TODO: rename to "dropLabels" ?
unwrapBriDocNumbered :: BriDocNumbered -> BriDoc
unwrapBriDocNumbered :: BriDocNumbered -> BriDoc
unwrapBriDocNumbered BriDocNumbered
tpl = case BriDocNumbered -> BriDocF ((,) Int)
forall a b. (a, b) -> b
snd BriDocNumbered
tpl of
  BriDocF ((,) Int)
BDFEmpty                     -> BriDoc
BDEmpty
  BDFLit Text
t                     -> Text -> BriDoc
BDLit Text
t
  BDFSeq [BriDocNumbered]
list                  -> [BriDoc] -> BriDoc
BDSeq ([BriDoc] -> BriDoc) -> [BriDoc] -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec (BriDocNumbered -> BriDoc) -> [BriDocNumbered] -> [BriDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BriDocNumbered]
list
  BDFCols ColSig
sig [BriDocNumbered]
list             -> ColSig -> [BriDoc] -> BriDoc
BDCols ColSig
sig ([BriDoc] -> BriDoc) -> [BriDoc] -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec (BriDocNumbered -> BriDoc) -> [BriDocNumbered] -> [BriDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BriDocNumbered]
list
  BriDocF ((,) Int)
BDFSeparator                 -> BriDoc
BDSeparator
  BDFAddBaseY BrIndent
ind BriDocNumbered
bd           -> BrIndent -> BriDoc -> BriDoc
BDAddBaseY BrIndent
ind (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFBaseYPushCur       BriDocNumbered
bd     -> BriDoc -> BriDoc
BDBaseYPushCur (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFBaseYPop           BriDocNumbered
bd     -> BriDoc -> BriDoc
BDBaseYPop (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFIndentLevelPushCur BriDocNumbered
bd     -> BriDoc -> BriDoc
BDIndentLevelPushCur (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFIndentLevelPop     BriDocNumbered
bd     -> BriDoc -> BriDoc
BDIndentLevelPop (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFPar BrIndent
ind BriDocNumbered
line BriDocNumbered
indented     -> BrIndent -> BriDoc -> BriDoc -> BriDoc
BDPar BrIndent
ind (BriDocNumbered -> BriDoc
rec BriDocNumbered
line) (BriDocNumbered -> BriDoc
rec BriDocNumbered
indented)
  BDFAlt             [BriDocNumbered]
alts      -> [BriDoc] -> BriDoc
BDAlt ([BriDoc] -> BriDoc) -> [BriDoc] -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec (BriDocNumbered -> BriDoc) -> [BriDocNumbered] -> [BriDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BriDocNumbered]
alts -- not that this will happen
  BDFForwardLineMode BriDocNumbered
bd        -> BriDoc -> BriDoc
BDForwardLineMode (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFExternal AnnKey
k Set AnnKey
ks Bool
c Text
t         -> AnnKey -> Set AnnKey -> Bool -> Text -> BriDoc
BDExternal AnnKey
k Set AnnKey
ks Bool
c Text
t
  BDFPlain Text
t                   -> Text -> BriDoc
BDPlain Text
t
  BDFAnnotationPrior AnnKey
annKey BriDocNumbered
bd -> AnnKey -> BriDoc -> BriDoc
BDAnnotationPrior AnnKey
annKey (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFAnnotationKW AnnKey
annKey Maybe AnnKeywordId
kw BriDocNumbered
bd -> AnnKey -> Maybe AnnKeywordId -> BriDoc -> BriDoc
BDAnnotationKW AnnKey
annKey Maybe AnnKeywordId
kw (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFAnnotationRest AnnKey
annKey BriDocNumbered
bd  -> AnnKey -> BriDoc -> BriDoc
BDAnnotationRest AnnKey
annKey (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFMoveToKWDP AnnKey
annKey AnnKeywordId
kw Bool
b BriDocNumbered
bd -> AnnKey -> AnnKeywordId -> Bool -> BriDoc -> BriDoc
BDMoveToKWDP AnnKey
annKey AnnKeywordId
kw Bool
b (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFLines [BriDocNumbered]
lines               -> [BriDoc] -> BriDoc
BDLines ([BriDoc] -> BriDoc) -> [BriDoc] -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec (BriDocNumbered -> BriDoc) -> [BriDocNumbered] -> [BriDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BriDocNumbered]
lines
  BDFEnsureIndent BrIndent
ind BriDocNumbered
bd       -> BrIndent -> BriDoc -> BriDoc
BDEnsureIndent BrIndent
ind (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFForceMultiline  BriDocNumbered
bd        -> BriDoc -> BriDoc
BDForceMultiline (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFForceSingleline BriDocNumbered
bd        -> BriDoc -> BriDoc
BDForceSingleline (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFNonBottomSpacing Bool
b BriDocNumbered
bd     -> Bool -> BriDoc -> BriDoc
BDNonBottomSpacing Bool
b (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFSetParSpacing   BriDocNumbered
bd        -> BriDoc -> BriDoc
BDSetParSpacing (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFForceParSpacing BriDocNumbered
bd        -> BriDoc -> BriDoc
BDForceParSpacing (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  BDFDebug String
s BriDocNumbered
bd                -> String -> BriDoc -> BriDoc
BDDebug (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"@" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (BriDocNumbered -> Int
forall a b. (a, b) -> a
fst BriDocNumbered
tpl)) (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
rec BriDocNumbered
bd
  where rec :: BriDocNumbered -> BriDoc
rec = BriDocNumbered -> BriDoc
unwrapBriDocNumbered

isNotEmpty :: BriDoc -> Bool
isNotEmpty :: BriDoc -> Bool
isNotEmpty BriDoc
BDEmpty = Bool
False
isNotEmpty BriDoc
_       = Bool
True

-- this might not work. is not used anywhere either.
briDocSeqSpine :: BriDoc -> ()
briDocSeqSpine :: BriDoc -> ()
briDocSeqSpine = \case
  BriDoc
BDEmpty                        -> ()
  BDLit Text
_t                       -> ()
  BDSeq [BriDoc]
list                     -> (() -> BriDoc -> ()) -> () -> [BriDoc] -> ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((BriDoc -> ()
briDocSeqSpine (BriDoc -> ()) -> (BriDoc -> BriDoc) -> BriDoc -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((BriDoc -> BriDoc) -> BriDoc -> ())
-> (() -> BriDoc -> BriDoc) -> () -> BriDoc -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> BriDoc -> BriDoc
seq) () [BriDoc]
list
  BDCols ColSig
_sig [BriDoc]
list               -> (() -> BriDoc -> ()) -> () -> [BriDoc] -> ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((BriDoc -> ()
briDocSeqSpine (BriDoc -> ()) -> (BriDoc -> BriDoc) -> BriDoc -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((BriDoc -> BriDoc) -> BriDoc -> ())
-> (() -> BriDoc -> BriDoc) -> () -> BriDoc -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> BriDoc -> BriDoc
seq) () [BriDoc]
list
  BriDoc
BDSeparator                    -> ()
  BDAddBaseY BrIndent
_ind BriDoc
bd             -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDBaseYPushCur       BriDoc
bd        -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDBaseYPop           BriDoc
bd        -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDIndentLevelPushCur BriDoc
bd        -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDIndentLevelPop     BriDoc
bd        -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDPar BrIndent
_ind BriDoc
line BriDoc
indented -> BriDoc -> ()
briDocSeqSpine BriDoc
line () -> () -> ()
`seq` BriDoc -> ()
briDocSeqSpine BriDoc
indented
  BDAlt             [BriDoc]
alts         -> (() -> BriDoc -> ()) -> () -> [BriDoc] -> ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(!()) -> BriDoc -> ()
briDocSeqSpine) () [BriDoc]
alts
  BDForwardLineMode BriDoc
bd           -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDExternal{}                   -> ()
  BDPlain{}                      -> ()
  BDAnnotationPrior AnnKey
_annKey BriDoc
bd   -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDAnnotationKW AnnKey
_annKey Maybe AnnKeywordId
_kw BriDoc
bd  -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDAnnotationRest AnnKey
_annKey BriDoc
bd    -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDMoveToKWDP AnnKey
_annKey AnnKeywordId
_kw Bool
_b BriDoc
bd -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDLines [BriDoc]
lines                  -> (() -> BriDoc -> ()) -> () -> [BriDoc] -> ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(!()) -> BriDoc -> ()
briDocSeqSpine) () [BriDoc]
lines
  BDEnsureIndent BrIndent
_ind BriDoc
bd         -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDForceMultiline  BriDoc
bd           -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDForceSingleline BriDoc
bd           -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDNonBottomSpacing Bool
_ BriDoc
bd        -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDSetParSpacing   BriDoc
bd           -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDForceParSpacing BriDoc
bd           -> BriDoc -> ()
briDocSeqSpine BriDoc
bd
  BDDebug String
_s BriDoc
bd                  -> BriDoc -> ()
briDocSeqSpine BriDoc
bd

briDocForceSpine :: BriDoc -> BriDoc
briDocForceSpine :: BriDoc -> BriDoc
briDocForceSpine BriDoc
bd = BriDoc -> ()
briDocSeqSpine BriDoc
bd () -> BriDoc -> BriDoc
`seq` BriDoc
bd


data VerticalSpacingPar
  = VerticalSpacingParNone -- no indented lines
  | VerticalSpacingParSome   Int -- indented lines, requiring this much
                                 -- vertical space at most
  | VerticalSpacingParAlways Int -- indented lines, requiring this much
                                 -- vertical space at most, but should
                                 -- be considered as having space for
                                 -- any spacing validity check.
    -- TODO: it might be wrong not to extend "always" to the none case, i.e.
    -- we might get better properties of spacing operators by having a
    -- product like (Normal|Always, None|Some Int).
  deriving (VerticalSpacingPar -> VerticalSpacingPar -> Bool
(VerticalSpacingPar -> VerticalSpacingPar -> Bool)
-> (VerticalSpacingPar -> VerticalSpacingPar -> Bool)
-> Eq VerticalSpacingPar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerticalSpacingPar -> VerticalSpacingPar -> Bool
$c/= :: VerticalSpacingPar -> VerticalSpacingPar -> Bool
== :: VerticalSpacingPar -> VerticalSpacingPar -> Bool
$c== :: VerticalSpacingPar -> VerticalSpacingPar -> Bool
Eq, Int -> VerticalSpacingPar -> ShowS
[VerticalSpacingPar] -> ShowS
VerticalSpacingPar -> String
(Int -> VerticalSpacingPar -> ShowS)
-> (VerticalSpacingPar -> String)
-> ([VerticalSpacingPar] -> ShowS)
-> Show VerticalSpacingPar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerticalSpacingPar] -> ShowS
$cshowList :: [VerticalSpacingPar] -> ShowS
show :: VerticalSpacingPar -> String
$cshow :: VerticalSpacingPar -> String
showsPrec :: Int -> VerticalSpacingPar -> ShowS
$cshowsPrec :: Int -> VerticalSpacingPar -> ShowS
Show)

data VerticalSpacing
  = VerticalSpacing
    { VerticalSpacing -> Int
_vs_sameLine  :: !Int
    , VerticalSpacing -> VerticalSpacingPar
_vs_paragraph :: !VerticalSpacingPar
    , VerticalSpacing -> Bool
_vs_parFlag   :: !Bool
    }
  deriving (VerticalSpacing -> VerticalSpacing -> Bool
(VerticalSpacing -> VerticalSpacing -> Bool)
-> (VerticalSpacing -> VerticalSpacing -> Bool)
-> Eq VerticalSpacing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerticalSpacing -> VerticalSpacing -> Bool
$c/= :: VerticalSpacing -> VerticalSpacing -> Bool
== :: VerticalSpacing -> VerticalSpacing -> Bool
$c== :: VerticalSpacing -> VerticalSpacing -> Bool
Eq, Int -> VerticalSpacing -> ShowS
[VerticalSpacing] -> ShowS
VerticalSpacing -> String
(Int -> VerticalSpacing -> ShowS)
-> (VerticalSpacing -> String)
-> ([VerticalSpacing] -> ShowS)
-> Show VerticalSpacing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerticalSpacing] -> ShowS
$cshowList :: [VerticalSpacing] -> ShowS
show :: VerticalSpacing -> String
$cshow :: VerticalSpacing -> String
showsPrec :: Int -> VerticalSpacing -> ShowS
$cshowsPrec :: Int -> VerticalSpacing -> ShowS
Show)

newtype LineModeValidity a = LineModeValidity (Strict.Maybe a)
  deriving (a -> LineModeValidity b -> LineModeValidity a
(a -> b) -> LineModeValidity a -> LineModeValidity b
(forall a b. (a -> b) -> LineModeValidity a -> LineModeValidity b)
-> (forall a b. a -> LineModeValidity b -> LineModeValidity a)
-> Functor LineModeValidity
forall a b. a -> LineModeValidity b -> LineModeValidity a
forall a b. (a -> b) -> LineModeValidity a -> LineModeValidity b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LineModeValidity b -> LineModeValidity a
$c<$ :: forall a b. a -> LineModeValidity b -> LineModeValidity a
fmap :: (a -> b) -> LineModeValidity a -> LineModeValidity b
$cfmap :: forall a b. (a -> b) -> LineModeValidity a -> LineModeValidity b
Functor, Functor LineModeValidity
a -> LineModeValidity a
Functor LineModeValidity
-> (forall a. a -> LineModeValidity a)
-> (forall a b.
    LineModeValidity (a -> b)
    -> LineModeValidity a -> LineModeValidity b)
-> (forall a b c.
    (a -> b -> c)
    -> LineModeValidity a -> LineModeValidity b -> LineModeValidity c)
-> (forall a b.
    LineModeValidity a -> LineModeValidity b -> LineModeValidity b)
-> (forall a b.
    LineModeValidity a -> LineModeValidity b -> LineModeValidity a)
-> Applicative LineModeValidity
LineModeValidity a -> LineModeValidity b -> LineModeValidity b
LineModeValidity a -> LineModeValidity b -> LineModeValidity a
LineModeValidity (a -> b)
-> LineModeValidity a -> LineModeValidity b
(a -> b -> c)
-> LineModeValidity a -> LineModeValidity b -> LineModeValidity c
forall a. a -> LineModeValidity a
forall a b.
LineModeValidity a -> LineModeValidity b -> LineModeValidity a
forall a b.
LineModeValidity a -> LineModeValidity b -> LineModeValidity b
forall a b.
LineModeValidity (a -> b)
-> LineModeValidity a -> LineModeValidity b
forall a b c.
(a -> b -> c)
-> LineModeValidity a -> LineModeValidity b -> LineModeValidity c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: LineModeValidity a -> LineModeValidity b -> LineModeValidity a
$c<* :: forall a b.
LineModeValidity a -> LineModeValidity b -> LineModeValidity a
*> :: LineModeValidity a -> LineModeValidity b -> LineModeValidity b
$c*> :: forall a b.
LineModeValidity a -> LineModeValidity b -> LineModeValidity b
liftA2 :: (a -> b -> c)
-> LineModeValidity a -> LineModeValidity b -> LineModeValidity c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> LineModeValidity a -> LineModeValidity b -> LineModeValidity c
<*> :: LineModeValidity (a -> b)
-> LineModeValidity a -> LineModeValidity b
$c<*> :: forall a b.
LineModeValidity (a -> b)
-> LineModeValidity a -> LineModeValidity b
pure :: a -> LineModeValidity a
$cpure :: forall a. a -> LineModeValidity a
$cp1Applicative :: Functor LineModeValidity
Applicative, Applicative LineModeValidity
a -> LineModeValidity a
Applicative LineModeValidity
-> (forall a b.
    LineModeValidity a
    -> (a -> LineModeValidity b) -> LineModeValidity b)
-> (forall a b.
    LineModeValidity a -> LineModeValidity b -> LineModeValidity b)
-> (forall a. a -> LineModeValidity a)
-> Monad LineModeValidity
LineModeValidity a
-> (a -> LineModeValidity b) -> LineModeValidity b
LineModeValidity a -> LineModeValidity b -> LineModeValidity b
forall a. a -> LineModeValidity a
forall a b.
LineModeValidity a -> LineModeValidity b -> LineModeValidity b
forall a b.
LineModeValidity a
-> (a -> LineModeValidity b) -> LineModeValidity b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> LineModeValidity a
$creturn :: forall a. a -> LineModeValidity a
>> :: LineModeValidity a -> LineModeValidity b -> LineModeValidity b
$c>> :: forall a b.
LineModeValidity a -> LineModeValidity b -> LineModeValidity b
>>= :: LineModeValidity a
-> (a -> LineModeValidity b) -> LineModeValidity b
$c>>= :: forall a b.
LineModeValidity a
-> (a -> LineModeValidity b) -> LineModeValidity b
$cp1Monad :: Applicative LineModeValidity
Monad, Int -> LineModeValidity a -> ShowS
[LineModeValidity a] -> ShowS
LineModeValidity a -> String
(Int -> LineModeValidity a -> ShowS)
-> (LineModeValidity a -> String)
-> ([LineModeValidity a] -> ShowS)
-> Show (LineModeValidity a)
forall a. Show a => Int -> LineModeValidity a -> ShowS
forall a. Show a => [LineModeValidity a] -> ShowS
forall a. Show a => LineModeValidity a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineModeValidity a] -> ShowS
$cshowList :: forall a. Show a => [LineModeValidity a] -> ShowS
show :: LineModeValidity a -> String
$cshow :: forall a. Show a => LineModeValidity a -> String
showsPrec :: Int -> LineModeValidity a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LineModeValidity a -> ShowS
Show, Applicative LineModeValidity
LineModeValidity a
Applicative LineModeValidity
-> (forall a. LineModeValidity a)
-> (forall a.
    LineModeValidity a -> LineModeValidity a -> LineModeValidity a)
-> (forall a. LineModeValidity a -> LineModeValidity [a])
-> (forall a. LineModeValidity a -> LineModeValidity [a])
-> Alternative LineModeValidity
LineModeValidity a -> LineModeValidity a -> LineModeValidity a
LineModeValidity a -> LineModeValidity [a]
LineModeValidity a -> LineModeValidity [a]
forall a. LineModeValidity a
forall a. LineModeValidity a -> LineModeValidity [a]
forall a.
LineModeValidity a -> LineModeValidity a -> LineModeValidity a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: LineModeValidity a -> LineModeValidity [a]
$cmany :: forall a. LineModeValidity a -> LineModeValidity [a]
some :: LineModeValidity a -> LineModeValidity [a]
$csome :: forall a. LineModeValidity a -> LineModeValidity [a]
<|> :: LineModeValidity a -> LineModeValidity a -> LineModeValidity a
$c<|> :: forall a.
LineModeValidity a -> LineModeValidity a -> LineModeValidity a
empty :: LineModeValidity a
$cempty :: forall a. LineModeValidity a
$cp1Alternative :: Applicative LineModeValidity
Alternative)

pattern LineModeValid :: forall t. t -> LineModeValidity t
pattern $bLineModeValid :: t -> LineModeValidity t
$mLineModeValid :: forall r t. LineModeValidity t -> (t -> r) -> (Void# -> r) -> r
LineModeValid x = LineModeValidity (Strict.Just x) :: LineModeValidity t
pattern LineModeInvalid :: forall t. LineModeValidity t
pattern $bLineModeInvalid :: LineModeValidity t
$mLineModeInvalid :: forall r t. LineModeValidity t -> (Void# -> r) -> (Void# -> r) -> r
LineModeInvalid = LineModeValidity Strict.Nothing :: LineModeValidity t