{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Language.Haskell.Brittany.Internal.Utils
  ( parDoc
  , parDocW
  , fromMaybeIdentity
  , fromOptionIdentity
  , traceIfDumpConf
  , mModify
  , customLayouterF
  , astToDoc
  , briDocToDoc
  -- , displayBriDocSimpleTree
  , annsDoc
  , Max (..)
  , tellDebugMess
  , tellDebugMessShow
  , briDocToDocWithAnns
  , breakEither
  , spanMaybe
  , transformUp
  , transformDownMay
  , FirstLastView(..)
  , splitFirstLast
  , lines'
  , showOutputable
  , absurdExt
  )
where



#include "prelude.inc"

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

import           Data.Data
import           Data.Generics.Schemes
import           Data.Generics.Aliases

import qualified Text.PrettyPrint as PP
import           Text.PrettyPrint ( ($+$), (<+>) )

import qualified Outputable    as GHC
import qualified DynFlags      as GHC
import qualified FastString    as GHC
import qualified SrcLoc        as GHC
import           OccName ( occNameString )
import qualified Data.ByteString as B

import           DataTreePrint

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

import qualified Data.Generics.Uniplate.Direct as Uniplate
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import qualified GHC.Hs.Extension as HsExtension
#else
import qualified HsExtension
#endif /* ghc-8.10.1 */



parDoc :: String -> PP.Doc
parDoc :: String -> Doc
parDoc = [Doc] -> Doc
PP.fsep ([Doc] -> Doc) -> (String -> [Doc]) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
PP.text ([String] -> [Doc]) -> (String -> [String]) -> String -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
List.words

parDocW :: [String] -> PP.Doc
parDocW :: [String] -> Doc
parDocW = [Doc] -> Doc
PP.fsep ([Doc] -> Doc) -> ([String] -> [Doc]) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
PP.text ([String] -> [Doc]) -> ([String] -> [String]) -> [String] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
List.words (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
List.unwords


showSDoc_ :: GHC.SDoc -> String
showSDoc_ :: SDoc -> String
showSDoc_ = DynFlags -> SDoc -> String
GHC.showSDoc DynFlags
GHC.unsafeGlobalDynFlags

showOutputable :: (GHC.Outputable a) => a -> String
showOutputable :: a -> String
showOutputable = DynFlags -> a -> String
forall a. Outputable a => DynFlags -> a -> String
GHC.showPpr DynFlags
GHC.unsafeGlobalDynFlags

fromMaybeIdentity :: Identity a -> Maybe a -> Identity a
fromMaybeIdentity :: Identity a -> Maybe a -> Identity a
fromMaybeIdentity Identity a
x Maybe a
y = a -> Identity a
Data.Coerce.coerce (a -> Identity a) -> a -> Identity a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Identity a -> a
Data.Coerce.coerce Identity a
x) Maybe a
y

fromOptionIdentity :: Identity a -> Option a -> Identity a
fromOptionIdentity :: Identity a -> Option a -> Identity a
fromOptionIdentity Identity a
x Option a
y =
  a -> Identity a
Data.Coerce.coerce (a -> Identity a) -> a -> Identity a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Identity a -> a
Data.Coerce.coerce Identity a
x) (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Option a -> Maybe a
forall a. Option a -> Maybe a
getOption Option a
y

-- maximum monoid over N+0
-- or more than N, because Num is allowed.
newtype Max a = Max { Max a -> a
getMax :: a }
  deriving (Max a -> Max a -> Bool
(Max a -> Max a -> Bool) -> (Max a -> Max a -> Bool) -> Eq (Max a)
forall a. Eq a => Max a -> Max a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Max a -> Max a -> Bool
$c/= :: forall a. Eq a => Max a -> Max a -> Bool
== :: Max a -> Max a -> Bool
$c== :: forall a. Eq a => Max a -> Max a -> Bool
Eq, Eq (Max a)
Eq (Max a)
-> (Max a -> Max a -> Ordering)
-> (Max a -> Max a -> Bool)
-> (Max a -> Max a -> Bool)
-> (Max a -> Max a -> Bool)
-> (Max a -> Max a -> Bool)
-> (Max a -> Max a -> Max a)
-> (Max a -> Max a -> Max a)
-> Ord (Max a)
Max a -> Max a -> Bool
Max a -> Max a -> Ordering
Max a -> Max a -> Max a
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
forall a. Ord a => Eq (Max a)
forall a. Ord a => Max a -> Max a -> Bool
forall a. Ord a => Max a -> Max a -> Ordering
forall a. Ord a => Max a -> Max a -> Max a
min :: Max a -> Max a -> Max a
$cmin :: forall a. Ord a => Max a -> Max a -> Max a
max :: Max a -> Max a -> Max a
$cmax :: forall a. Ord a => Max a -> Max a -> Max a
>= :: Max a -> Max a -> Bool
$c>= :: forall a. Ord a => Max a -> Max a -> Bool
> :: Max a -> Max a -> Bool
$c> :: forall a. Ord a => Max a -> Max a -> Bool
<= :: Max a -> Max a -> Bool
$c<= :: forall a. Ord a => Max a -> Max a -> Bool
< :: Max a -> Max a -> Bool
$c< :: forall a. Ord a => Max a -> Max a -> Bool
compare :: Max a -> Max a -> Ordering
$ccompare :: forall a. Ord a => Max a -> Max a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Max a)
Ord, Int -> Max a -> ShowS
[Max a] -> ShowS
Max a -> String
(Int -> Max a -> ShowS)
-> (Max a -> String) -> ([Max a] -> ShowS) -> Show (Max a)
forall a. Show a => Int -> Max a -> ShowS
forall a. Show a => [Max a] -> ShowS
forall a. Show a => Max a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Max a] -> ShowS
$cshowList :: forall a. Show a => [Max a] -> ShowS
show :: Max a -> String
$cshow :: forall a. Show a => Max a -> String
showsPrec :: Int -> Max a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Max a -> ShowS
Show, Max a
Max a -> Max a -> Bounded (Max a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Max a
maxBound :: Max a
$cmaxBound :: forall a. Bounded a => Max a
minBound :: Max a
$cminBound :: forall a. Bounded a => Max a
Bounded, Integer -> Max a
Max a -> Max a
Max a -> Max a -> Max a
(Max a -> Max a -> Max a)
-> (Max a -> Max a -> Max a)
-> (Max a -> Max a -> Max a)
-> (Max a -> Max a)
-> (Max a -> Max a)
-> (Max a -> Max a)
-> (Integer -> Max a)
-> Num (Max a)
forall a. Num a => Integer -> Max a
forall a. Num a => Max a -> Max a
forall a. Num a => Max a -> Max a -> Max a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Max a
$cfromInteger :: forall a. Num a => Integer -> Max a
signum :: Max a -> Max a
$csignum :: forall a. Num a => Max a -> Max a
abs :: Max a -> Max a
$cabs :: forall a. Num a => Max a -> Max a
negate :: Max a -> Max a
$cnegate :: forall a. Num a => Max a -> Max a
* :: Max a -> Max a -> Max a
$c* :: forall a. Num a => Max a -> Max a -> Max a
- :: Max a -> Max a -> Max a
$c- :: forall a. Num a => Max a -> Max a -> Max a
+ :: Max a -> Max a -> Max a
$c+ :: forall a. Num a => Max a -> Max a -> Max a
Num)

instance (Num a, Ord a) => Semigroup (Max a) where
  <> :: Max a -> Max a -> Max a
(<>) = (a -> a -> a) -> Max a -> Max a -> Max a
Data.Coerce.coerce (a -> a -> a
forall a. Ord a => a -> a -> a
max :: a -> a -> a)

instance (Num a, Ord a) => Monoid (Max a) where
  mempty :: Max a
mempty  = a -> Max a
forall a. a -> Max a
Max a
0
  mappend :: Max a -> Max a -> Max a
mappend = Max a -> Max a -> Max a
forall a. Semigroup a => a -> a -> a
(<>)

newtype ShowIsId = ShowIsId String deriving Typeable ShowIsId
DataType
Constr
Typeable ShowIsId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ShowIsId -> c ShowIsId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ShowIsId)
-> (ShowIsId -> Constr)
-> (ShowIsId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ShowIsId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShowIsId))
-> ((forall b. Data b => b -> b) -> ShowIsId -> ShowIsId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ShowIsId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ShowIsId -> r)
-> (forall u. (forall d. Data d => d -> u) -> ShowIsId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ShowIsId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ShowIsId -> m ShowIsId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ShowIsId -> m ShowIsId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ShowIsId -> m ShowIsId)
-> Data ShowIsId
ShowIsId -> DataType
ShowIsId -> Constr
(forall b. Data b => b -> b) -> ShowIsId -> ShowIsId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShowIsId -> c ShowIsId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ShowIsId
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) -> ShowIsId -> u
forall u. (forall d. Data d => d -> u) -> ShowIsId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShowIsId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShowIsId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ShowIsId -> m ShowIsId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ShowIsId -> m ShowIsId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ShowIsId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShowIsId -> c ShowIsId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ShowIsId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShowIsId)
$cShowIsId :: Constr
$tShowIsId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ShowIsId -> m ShowIsId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ShowIsId -> m ShowIsId
gmapMp :: (forall d. Data d => d -> m d) -> ShowIsId -> m ShowIsId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ShowIsId -> m ShowIsId
gmapM :: (forall d. Data d => d -> m d) -> ShowIsId -> m ShowIsId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ShowIsId -> m ShowIsId
gmapQi :: Int -> (forall d. Data d => d -> u) -> ShowIsId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ShowIsId -> u
gmapQ :: (forall d. Data d => d -> u) -> ShowIsId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ShowIsId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShowIsId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShowIsId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShowIsId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShowIsId -> r
gmapT :: (forall b. Data b => b -> b) -> ShowIsId -> ShowIsId
$cgmapT :: (forall b. Data b => b -> b) -> ShowIsId -> ShowIsId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShowIsId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShowIsId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ShowIsId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ShowIsId)
dataTypeOf :: ShowIsId -> DataType
$cdataTypeOf :: ShowIsId -> DataType
toConstr :: ShowIsId -> Constr
$ctoConstr :: ShowIsId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ShowIsId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ShowIsId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShowIsId -> c ShowIsId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShowIsId -> c ShowIsId
$cp1Data :: Typeable ShowIsId
Data

instance Show ShowIsId where show :: ShowIsId -> String
show (ShowIsId String
x) = String
x

data A x = A ShowIsId x deriving Typeable (A x)
DataType
Constr
Typeable (A x)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> A x -> c (A x))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (A x))
-> (A x -> Constr)
-> (A x -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (A x)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (A x)))
-> ((forall b. Data b => b -> b) -> A x -> A x)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> A x -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> A x -> r)
-> (forall u. (forall d. Data d => d -> u) -> A x -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> A x -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> A x -> m (A x))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> A x -> m (A x))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> A x -> m (A x))
-> Data (A x)
A x -> DataType
A x -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (A x))
(forall b. Data b => b -> b) -> A x -> A x
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> A x -> c (A x)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (A x)
forall x. Data x => Typeable (A x)
forall x. Data x => A x -> DataType
forall x. Data x => A x -> Constr
forall x. Data x => (forall b. Data b => b -> b) -> A x -> A x
forall x u.
Data x =>
Int -> (forall d. Data d => d -> u) -> A x -> u
forall x u. Data x => (forall d. Data d => d -> u) -> A x -> [u]
forall x r r'.
Data x =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> A x -> r
forall x r r'.
Data x =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> A x -> r
forall x (m :: * -> *).
(Data x, Monad m) =>
(forall d. Data d => d -> m d) -> A x -> m (A x)
forall x (m :: * -> *).
(Data x, MonadPlus m) =>
(forall d. Data d => d -> m d) -> A x -> m (A x)
forall x (c :: * -> *).
Data x =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (A x)
forall x (c :: * -> *).
Data x =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> A x -> c (A x)
forall x (t :: * -> *) (c :: * -> *).
(Data x, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (A x))
forall x (t :: * -> * -> *) (c :: * -> *).
(Data x, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (A x))
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) -> A x -> u
forall u. (forall d. Data d => d -> u) -> A x -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> A x -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> A x -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> A x -> m (A x)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> A x -> m (A x)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (A x)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> A x -> c (A x)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (A x))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (A x))
$cA :: Constr
$tA :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> A x -> m (A x)
$cgmapMo :: forall x (m :: * -> *).
(Data x, MonadPlus m) =>
(forall d. Data d => d -> m d) -> A x -> m (A x)
gmapMp :: (forall d. Data d => d -> m d) -> A x -> m (A x)
$cgmapMp :: forall x (m :: * -> *).
(Data x, MonadPlus m) =>
(forall d. Data d => d -> m d) -> A x -> m (A x)
gmapM :: (forall d. Data d => d -> m d) -> A x -> m (A x)
$cgmapM :: forall x (m :: * -> *).
(Data x, Monad m) =>
(forall d. Data d => d -> m d) -> A x -> m (A x)
gmapQi :: Int -> (forall d. Data d => d -> u) -> A x -> u
$cgmapQi :: forall x u.
Data x =>
Int -> (forall d. Data d => d -> u) -> A x -> u
gmapQ :: (forall d. Data d => d -> u) -> A x -> [u]
$cgmapQ :: forall x u. Data x => (forall d. Data d => d -> u) -> A x -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> A x -> r
$cgmapQr :: forall x r r'.
Data x =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> A x -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> A x -> r
$cgmapQl :: forall x r r'.
Data x =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> A x -> r
gmapT :: (forall b. Data b => b -> b) -> A x -> A x
$cgmapT :: forall x. Data x => (forall b. Data b => b -> b) -> A x -> A x
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (A x))
$cdataCast2 :: forall x (t :: * -> * -> *) (c :: * -> *).
(Data x, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (A x))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (A x))
$cdataCast1 :: forall x (t :: * -> *) (c :: * -> *).
(Data x, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (A x))
dataTypeOf :: A x -> DataType
$cdataTypeOf :: forall x. Data x => A x -> DataType
toConstr :: A x -> Constr
$ctoConstr :: forall x. Data x => A x -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (A x)
$cgunfold :: forall x (c :: * -> *).
Data x =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (A x)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> A x -> c (A x)
$cgfoldl :: forall x (c :: * -> *).
Data x =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> A x -> c (A x)
$cp1Data :: forall x. Data x => Typeable (A x)
Data

customLayouterF :: ExactPrint.Types.Anns -> LayouterF
customLayouterF :: Anns -> LayouterF
customLayouterF Anns
anns DataToLayouter
layoutF =
  (forall a. Data a => a -> NodeLayouter) -> DataToLayouter
DataToLayouter
    ((forall a. Data a => a -> NodeLayouter) -> DataToLayouter)
-> (forall a. Data a => a -> NodeLayouter) -> DataToLayouter
forall a b. (a -> b) -> a -> b
$       a -> NodeLayouter
forall a. Data a => a -> NodeLayouter
f
    (a -> NodeLayouter)
-> (ShowIsId -> NodeLayouter) -> a -> NodeLayouter
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ`  ShowIsId -> NodeLayouter
showIsId
    (a -> NodeLayouter)
-> (FastString -> NodeLayouter) -> a -> NodeLayouter
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ`  FastString -> NodeLayouter
fastString
    (a -> NodeLayouter)
-> (ByteString -> NodeLayouter) -> a -> NodeLayouter
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ`  ByteString -> NodeLayouter
bytestring
    (a -> NodeLayouter)
-> (OccName -> NodeLayouter) -> a -> NodeLayouter
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ`  OccName -> NodeLayouter
occName
    (a -> NodeLayouter)
-> (SrcSpan -> NodeLayouter) -> a -> NodeLayouter
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ`  SrcSpan -> NodeLayouter
srcSpan
    (a -> NodeLayouter)
-> (forall d1 d2.
    (Data d1, Data d2) =>
    GenLocated d1 d2 -> NodeLayouter)
-> a
-> NodeLayouter
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` forall d1 d2.
(Data d1, Data d2) =>
GenLocated d1 d2 -> NodeLayouter
forall b loc.
(Data b, Data loc) =>
GenLocated loc b -> NodeLayouter
located
 where
  DataToLayouter forall a. Data a => a -> NodeLayouter
f = LayouterF
defaultLayouterF DataToLayouter
layoutF
  simpleLayouter :: String -> NodeLayouter
  simpleLayouter :: String -> NodeLayouter
simpleLayouter String
s = Int -> Bool -> (Either Bool Int -> Doc) -> NodeLayouter
NodeLayouter (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Bool
False (Doc -> Either Bool Int -> Doc
forall a b. a -> b -> a
const (Doc -> Either Bool Int -> Doc) -> Doc -> Either Bool Int -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text String
s)
  showIsId :: ShowIsId -> NodeLayouter
  showIsId :: ShowIsId -> NodeLayouter
showIsId (ShowIsId String
s) = Int -> Bool -> (Either Bool Int -> Doc) -> NodeLayouter
NodeLayouter (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Bool
True ((Either Bool Int -> Doc) -> NodeLayouter)
-> (Either Bool Int -> Doc) -> NodeLayouter
forall a b. (a -> b) -> a -> b
$ \case
    Left  Bool
True -> Doc -> Doc
PP.parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text String
s
    Left  Bool
False -> String -> Doc
PP.text String
s
    Right Int
_    -> String -> Doc
PP.text String
s
  fastString :: FastString -> NodeLayouter
fastString =
    String -> NodeLayouter
simpleLayouter (String -> NodeLayouter)
-> (FastString -> String) -> FastString -> NodeLayouter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"{FastString: "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (FastString -> String) -> FastString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"}") ShowS -> (FastString -> String) -> FastString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
forall a. Show a => a -> String
show :: GHC.FastString
      -> NodeLayouter
  bytestring :: ByteString -> NodeLayouter
bytestring = String -> NodeLayouter
simpleLayouter (String -> NodeLayouter)
-> (ByteString -> String) -> ByteString -> NodeLayouter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a. Show a => a -> String
show :: B.ByteString -> NodeLayouter
  occName :: OccName -> NodeLayouter
occName = String -> NodeLayouter
simpleLayouter (String -> NodeLayouter)
-> (OccName -> String) -> OccName -> NodeLayouter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"{OccName: "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (OccName -> String) -> OccName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"}") ShowS -> (OccName -> String) -> OccName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
OccName.occNameString
  srcSpan :: GHC.SrcSpan -> NodeLayouter
  srcSpan :: SrcSpan -> NodeLayouter
srcSpan SrcSpan
ss = String -> NodeLayouter
simpleLayouter
             -- - $ "{"++ showSDoc_ (GHC.ppr ss)++"}"
                              (String -> NodeLayouter) -> String -> NodeLayouter
forall a b. (a -> b) -> a -> b
$ String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcSpan -> String
forall a. Outputable a => a -> String
showOutputable SrcSpan
ss String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
  located :: (Data b, Data loc) => GHC.GenLocated loc b -> NodeLayouter
  located :: GenLocated loc b -> NodeLayouter
located (GHC.L loc
ss b
a) = DataToLayouter -> forall a. Data a => a -> NodeLayouter
runDataToLayouter DataToLayouter
layoutF (A b -> NodeLayouter) -> A b -> NodeLayouter
forall a b. (a -> b) -> a -> b
$ ShowIsId -> b -> A b
forall x. ShowIsId -> x -> A x
A ShowIsId
annStr b
a
   where
    annStr :: ShowIsId
annStr = case loc -> Maybe SrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast loc
ss of
      Just (SrcSpan
s :: GHC.SrcSpan) ->
        String -> ShowIsId
ShowIsId (String -> ShowIsId) -> String -> ShowIsId
forall a b. (a -> b) -> a -> b
$ Maybe Annotation -> String
forall a. Show a => a -> String
show (GenLocated SrcSpan b -> Anns -> Maybe Annotation
forall a.
(Data a, Data (SrcSpanLess a), HasSrcSpan a) =>
a -> Anns -> Maybe Annotation
ExactPrint.Utils.getAnnotationEP (SrcSpan -> b -> GenLocated SrcSpan b
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
s b
a) Anns
anns)
      Maybe SrcSpan
Nothing -> String -> ShowIsId
ShowIsId String
"nnnnnnnn"

customLayouterNoAnnsF :: LayouterF
customLayouterNoAnnsF :: LayouterF
customLayouterNoAnnsF DataToLayouter
layoutF =
  (forall a. Data a => a -> NodeLayouter) -> DataToLayouter
DataToLayouter
    ((forall a. Data a => a -> NodeLayouter) -> DataToLayouter)
-> (forall a. Data a => a -> NodeLayouter) -> DataToLayouter
forall a b. (a -> b) -> a -> b
$       a -> NodeLayouter
forall a. Data a => a -> NodeLayouter
f
    (a -> NodeLayouter)
-> (ShowIsId -> NodeLayouter) -> a -> NodeLayouter
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ`  ShowIsId -> NodeLayouter
showIsId
    (a -> NodeLayouter)
-> (FastString -> NodeLayouter) -> a -> NodeLayouter
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ`  FastString -> NodeLayouter
fastString
    (a -> NodeLayouter)
-> (ByteString -> NodeLayouter) -> a -> NodeLayouter
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ`  ByteString -> NodeLayouter
bytestring
    (a -> NodeLayouter)
-> (OccName -> NodeLayouter) -> a -> NodeLayouter
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ`  OccName -> NodeLayouter
occName
    (a -> NodeLayouter)
-> (SrcSpan -> NodeLayouter) -> a -> NodeLayouter
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ`  SrcSpan -> NodeLayouter
srcSpan
    (a -> NodeLayouter)
-> (forall d1 d2.
    (Data d1, Data d2) =>
    GenLocated d1 d2 -> NodeLayouter)
-> a
-> NodeLayouter
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` forall d1 d2.
(Data d1, Data d2) =>
GenLocated d1 d2 -> NodeLayouter
forall b loc. Data b => GenLocated loc b -> NodeLayouter
located
 where
  DataToLayouter forall a. Data a => a -> NodeLayouter
f = LayouterF
defaultLayouterF DataToLayouter
layoutF
  simpleLayouter :: String -> NodeLayouter
  simpleLayouter :: String -> NodeLayouter
simpleLayouter String
s = Int -> Bool -> (Either Bool Int -> Doc) -> NodeLayouter
NodeLayouter (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Bool
False (Doc -> Either Bool Int -> Doc
forall a b. a -> b -> a
const (Doc -> Either Bool Int -> Doc) -> Doc -> Either Bool Int -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text String
s)
  showIsId :: ShowIsId -> NodeLayouter
  showIsId :: ShowIsId -> NodeLayouter
showIsId (ShowIsId String
s) = Int -> Bool -> (Either Bool Int -> Doc) -> NodeLayouter
NodeLayouter (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Bool
True ((Either Bool Int -> Doc) -> NodeLayouter)
-> (Either Bool Int -> Doc) -> NodeLayouter
forall a b. (a -> b) -> a -> b
$ \case
    Left  Bool
True -> Doc -> Doc
PP.parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text String
s
    Left  Bool
False -> String -> Doc
PP.text String
s
    Right Int
_    -> String -> Doc
PP.text String
s
  fastString :: FastString -> NodeLayouter
fastString =
    String -> NodeLayouter
simpleLayouter (String -> NodeLayouter)
-> (FastString -> String) -> FastString -> NodeLayouter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"{FastString: "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (FastString -> String) -> FastString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"}") ShowS -> (FastString -> String) -> FastString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
forall a. Show a => a -> String
show :: GHC.FastString
      -> NodeLayouter
  bytestring :: ByteString -> NodeLayouter
bytestring = String -> NodeLayouter
simpleLayouter (String -> NodeLayouter)
-> (ByteString -> String) -> ByteString -> NodeLayouter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a. Show a => a -> String
show :: B.ByteString -> NodeLayouter
  occName :: OccName -> NodeLayouter
occName = String -> NodeLayouter
simpleLayouter (String -> NodeLayouter)
-> (OccName -> String) -> OccName -> NodeLayouter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"{OccName: "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (OccName -> String) -> OccName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"}") ShowS -> (OccName -> String) -> OccName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
OccName.occNameString
  srcSpan :: GHC.SrcSpan -> NodeLayouter
  srcSpan :: SrcSpan -> NodeLayouter
srcSpan SrcSpan
ss = String -> NodeLayouter
simpleLayouter (String -> NodeLayouter) -> String -> NodeLayouter
forall a b. (a -> b) -> a -> b
$ String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SDoc -> String
showSDoc_ (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr SrcSpan
ss) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
  located :: (Data b) => GHC.GenLocated loc b -> NodeLayouter
  located :: GenLocated loc b -> NodeLayouter
located (GHC.L loc
_ss b
a) = DataToLayouter -> b -> NodeLayouter
DataToLayouter -> forall a. Data a => a -> NodeLayouter
runDataToLayouter DataToLayouter
layoutF b
a

-- displayBriDocTree :: BriDoc -> PP.Doc
-- displayBriDocTree = \case
--   BDWrapAnnKey annKey doc -> def "BDWrapAnnKey"
--                            $ PP.text (show annKey)
--                          $+$ displayBriDocTree doc
--   BDEmpty         -> PP.text "BDEmpty"
--   BDLit t         -> def "BDLit" $ PP.text (show t)
--   BDSeq list      -> def "BDSeq" $ displayList list
--   BDCols sig list -> def "BDCols" $ PP.text (show sig)
--                                 $+$ displayList list
--   BDSeparator     -> PP.text "BDSeparator"
--   BDPar rol indent lines -> def "BDPar" $ displayBriDocTree rol
--                                       $+$ PP.text (show indent)
--                                       $+$ displayList lines
--   BDAlt alts      -> def "BDAlt" $ displayList alts
--   BDExternal ast _t -> def "BDExternal" (astToDoc ast)
--   BDSpecialPostCommentLoc _ -> PP.text "BDSpecialPostCommentLoc"
--  where
--   def x r = PP.text x $+$ PP.nest 2 r
--   displayList :: [BriDoc] -> PP.Doc
--   displayList [] = PP.text "[]"
--   displayList (x:xr) = PP.cat $ PP.text "[" <+> displayBriDocTree x
--                               : [PP.text "," <+> displayBriDocTree t | t<-xr]
--                              ++ [PP.text "]"]

-- displayBriDocSimpleTree :: BriDocSimple -> PP.Doc
-- displayBriDocSimpleTree = \case
--   BDSWrapAnnKey annKey doc -> def "BDSWrapAnnKey"
--                            $ PP.text (show annKey)
--                          $+$ displayBriDocSimpleTree doc
--   BDSLit t         -> def "BDSLit" $ PP.text (show t)
--   BDSSeq list      -> def "BDSSeq" $ displayList list
--   BDSCols sig list -> def "BDSCols" $ PP.text (show sig)
--                                 $+$ displayList list
--   BDSSeparator     -> PP.text "BDSSeparator"
--   BDSPar rol indent lines -> def "BDSPar" $ displayBriDocSimpleTree rol
--                                       $+$ PP.text (show indent)
--                                       $+$ displayList lines
--   BDSExternal annKey _subKeys _t -> def "BDSExternal" (PP.text $ show annKey)
--   BDSSpecialPostCommentLoc _ -> PP.text "BDSSpecialPostCommentLoc"
--  where
--   def x r = PP.text x $+$ PP.nest 2 r
--   displayList :: [BriDocSimple] -> PP.Doc
--   displayList [] = PP.text "[]"
--   displayList (x:xr) = PP.cat $ PP.text "[" <+> displayBriDocSimpleTree x
--                               : [PP.text "," <+> displayBriDocSimpleTree t | t<-xr]
--                              ++ [PP.text "]"]

traceIfDumpConf
  :: (MonadMultiReader Config m, Show a)
  => String
  -> (DebugConfig -> Identity (Semigroup.Last Bool))
  -> a
  -> m ()
traceIfDumpConf :: String -> (DebugConfig -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
s DebugConfig -> Identity (Last Bool)
accessor a
val = do
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m (CConfig Identity)
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk m (CConfig Identity) -> (CConfig Identity -> Bool) -> m Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CConfig Identity -> DebugConfig
forall (f :: * -> *). CConfig f -> CDebugConfig f
_conf_debug (CConfig Identity -> DebugConfig)
-> (DebugConfig -> Identity (Last Bool))
-> CConfig Identity
-> Identity (Last Bool)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> DebugConfig -> Identity (Last Bool)
accessor (CConfig Identity -> Identity (Last Bool))
-> (Identity (Last Bool) -> Bool) -> CConfig Identity -> Bool
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> m () -> m ()
forall a. String -> a -> a
trace (String
"---- " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ----\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
val) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

tellDebugMess :: MonadMultiWriter
  (Seq String) m => String -> m ()
tellDebugMess :: String -> m ()
tellDebugMess String
s = Seq String -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell (Seq String -> m ()) -> Seq String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Seq String
forall a. a -> Seq a
Seq.singleton String
s

tellDebugMessShow :: forall a m . (MonadMultiWriter
  (Seq String) m, Show a) => a -> m ()
tellDebugMessShow :: a -> m ()
tellDebugMessShow = String -> m ()
forall (m :: * -> *).
MonadMultiWriter (Seq String) m =>
String -> m ()
tellDebugMess (String -> m ()) -> (a -> String) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- i should really put that into multistate..
mModify :: MonadMultiState s m => (s -> s) -> m ()
mModify :: (s -> s) -> m ()
mModify s -> s
f = m s
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet m s -> (s -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (s -> m ()) -> (s -> s) -> s -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f

astToDoc :: Data ast => ast -> PP.Doc
astToDoc :: ast -> Doc
astToDoc ast
ast = Int -> LayouterF -> ast -> Doc
forall a. Data a => Int -> LayouterF -> a -> Doc
printTreeWithCustom Int
160 LayouterF
customLayouterNoAnnsF ast
ast

briDocToDoc :: BriDoc -> PP.Doc
briDocToDoc :: BriDoc -> Doc
briDocToDoc = BriDoc -> Doc
forall ast. Data ast => ast -> Doc
astToDoc (BriDoc -> Doc) -> (BriDoc -> BriDoc) -> BriDoc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BriDoc -> BriDoc
removeAnnotations
 where
  removeAnnotations :: BriDoc -> BriDoc
removeAnnotations = (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall on. Uniplate on => (on -> on) -> on -> on
Uniplate.transform ((BriDoc -> BriDoc) -> BriDoc -> BriDoc)
-> (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ \case
    BDAnnotationPrior AnnKey
_ BriDoc
x -> BriDoc
x
    BDAnnotationKW AnnKey
_ Maybe AnnKeywordId
_ BriDoc
x  -> BriDoc
x
    BDAnnotationRest AnnKey
_ BriDoc
x  -> BriDoc
x
    BriDoc
x                     -> BriDoc
x

briDocToDocWithAnns :: BriDoc -> PP.Doc
briDocToDocWithAnns :: BriDoc -> Doc
briDocToDocWithAnns = BriDoc -> Doc
forall ast. Data ast => ast -> Doc
astToDoc

annsDoc :: ExactPrint.Types.Anns -> PP.Doc
annsDoc :: Anns -> Doc
annsDoc = Int -> LayouterF -> Map AnnKey ShowIsId -> Doc
forall a. Data a => Int -> LayouterF -> a -> Doc
printTreeWithCustom Int
100 LayouterF
customLayouterNoAnnsF (Map AnnKey ShowIsId -> Doc)
-> (Anns -> Map AnnKey ShowIsId) -> Anns -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Annotation -> ShowIsId) -> Anns -> Map AnnKey ShowIsId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowIsId
ShowIsId (String -> ShowIsId)
-> (Annotation -> String) -> Annotation -> ShowIsId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> String
forall a. Show a => a -> String
show)

breakEither :: (a -> Either b c) -> [a] -> ([b], [c])
breakEither :: (a -> Either b c) -> [a] -> ([b], [c])
breakEither a -> Either b c
_  []      = ([], [])
breakEither a -> Either b c
fn (a
a1:[a]
aR) = case a -> Either b c
fn a
a1 of
  Left  b
b -> (b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
bs, [c]
cs)
  Right c
c -> ([b]
bs, c
c c -> [c] -> [c]
forall a. a -> [a] -> [a]
: [c]
cs)
 where
  ([b]
bs, [c]
cs) = (a -> Either b c) -> [a] -> ([b], [c])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
breakEither a -> Either b c
fn [a]
aR

spanMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
spanMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
spanMaybe a -> Maybe b
f (a
x1:[a]
xR) | Just b
y <- a -> Maybe b
f a
x1 = (b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ys, [a]
xs)
 where
  ([b]
ys, [a]
xs) = (a -> Maybe b) -> [a] -> ([b], [a])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
spanMaybe a -> Maybe b
f [a]
xR
spanMaybe a -> Maybe b
_ [a]
xs                       = ([], [a]
xs)

data FirstLastView a
  = FirstLastEmpty
  | FirstLastSingleton a
  | FirstLast a [a] a

splitFirstLast :: [a] -> FirstLastView a
splitFirstLast :: [a] -> FirstLastView a
splitFirstLast [] = FirstLastView a
forall a. FirstLastView a
FirstLastEmpty
splitFirstLast [a
x] = a -> FirstLastView a
forall a. a -> FirstLastView a
FirstLastSingleton a
x
splitFirstLast (a
x1:[a]
xr) = a -> [a] -> a -> FirstLastView a
forall a. a -> [a] -> a -> FirstLastView a
FirstLast a
x1 ([a] -> [a]
forall a. [a] -> [a]
List.init [a]
xr) ([a] -> a
forall a. [a] -> a
List.last [a]
xr)

-- TODO: move to uniplate upstream?
-- aka `transform`
transformUp :: Uniplate.Uniplate on => (on -> on) -> (on -> on)
transformUp :: (on -> on) -> on -> on
transformUp on -> on
f = on -> on
g where g :: on -> on
g = on -> on
f (on -> on) -> (on -> on) -> on -> on
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (on -> on) -> on -> on
forall on. Uniplate on => (on -> on) -> on -> on
Uniplate.descend on -> on
g
_transformDown :: Uniplate.Uniplate on => (on -> on) -> (on -> on)
_transformDown :: (on -> on) -> on -> on
_transformDown on -> on
f = on -> on
g where g :: on -> on
g = (on -> on) -> on -> on
forall on. Uniplate on => (on -> on) -> on -> on
Uniplate.descend on -> on
g (on -> on) -> (on -> on) -> on -> on
forall b c a. (b -> c) -> (a -> b) -> a -> c
. on -> on
f
transformDownMay :: Uniplate.Uniplate on => (on -> Maybe on) -> (on -> on)
transformDownMay :: (on -> Maybe on) -> on -> on
transformDownMay on -> Maybe on
f = on -> on
g where g :: on -> on
g on
x = on -> (on -> on) -> Maybe on -> on
forall b a. b -> (a -> b) -> Maybe a -> b
maybe on
x ((on -> on) -> on -> on
forall on. Uniplate on => (on -> on) -> on -> on
Uniplate.descend on -> on
g) (Maybe on -> on) -> Maybe on -> on
forall a b. (a -> b) -> a -> b
$ on -> Maybe on
f on
x
_transformDownRec :: Uniplate.Uniplate on => (on -> Maybe on) -> (on -> on)
_transformDownRec :: (on -> Maybe on) -> on -> on
_transformDownRec on -> Maybe on
f = on -> on
g where g :: on -> on
g on
x = on -> (on -> on) -> Maybe on -> on
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((on -> on) -> on -> on
forall on. Uniplate on => (on -> on) -> on -> on
Uniplate.descend on -> on
g on
x) on -> on
g (Maybe on -> on) -> Maybe on -> on
forall a b. (a -> b) -> a -> b
$ on -> Maybe on
f on
x

-- | similar to List.lines, but treating the case of final newline character
-- in such a manner that this function is the inverse of @intercalate "\n"@.
lines' :: String -> [String]
lines' :: String -> [String]
lines' String
s = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') String
s of
  (String
s1, []) -> [String
s1]
  (String
s1, [Char
_]) -> [String
s1, String
""]
  (String
s1, (Char
_:String
r)) -> String
s1 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
lines' String
r

#if MIN_VERSION_ghc(8,10,1)   /* ghc-8.10.1 */
absurdExt :: HsExtension.NoExtCon -> a
absurdExt :: NoExtCon -> a
absurdExt = NoExtCon -> a
forall a. NoExtCon -> a
HsExtension.noExtCon
#else
-- | A method to dismiss NoExt patterns for total matches
absurdExt :: HsExtension.NoExt -> a
absurdExt = error "cannot construct NoExt"
#endif