{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Haskell.GHC.ExactPrint.Types
  ( -- * Core Types
   Anns
  , emptyAnns
  , Annotation(..)
  , annNone

  , KeywordId(..)
  , Comment(..)
  -- * Positions
  , Pos
  , DeltaPos(..)
  , deltaRow, deltaColumn
  -- * AnnKey
  , AnnSpan
  , AnnKey(..)
  , mkAnnKey
  , AnnConName(..)
  , annGetConstr
#if __GLASGOW_HASKELL__ >= 900
  , badRealSrcSpan
#endif

  -- * Other

  , Rigidity(..)
  , AstContext(..),AstContextSet,defaultACS
  , ACS'(..)
  , ListContexts(..)

  -- * For managing compatibility
  , Constraints

  -- * GHC version compatibility
  , GhcPs
  , GhcRn
  , GhcTc

#if __GLASGOW_HASKELL__ > 804
  , noExt
#endif

  -- * Internal Types
  , LayoutStartCol(..)
  , declFun

  ) where

import Data.Data (Data, Typeable, toConstr,cast)
-- import Data.Generics

import qualified GHC
#if __GLASGOW_HASKELL__ >= 900
import GHC.Data.FastString     as GHC
import GHC.Driver.Session      as GHC
import GHC.Types.SrcLoc        as GHC
import GHC.Utils.Outputable    as GHC
#else
import qualified DynFlags      as GHC
import qualified Outputable    as GHC
#endif

import qualified Data.Map as Map
import qualified Data.Set as Set

-- ---------------------------------------------------------------------

#if (__GLASGOW_HASKELL__ >= 808) && (__GLASGOW_HASKELL__ < 900)
type Constraints a = (Data a,Data (GHC.SrcSpanLess a),GHC.HasSrcSpan a)
#else
type Constraints a = (Data a)
#endif

-- ---------------------------------------------------------------------

-- | A Haskell comment. The @AnnKeywordId@ is present if it has been converted
-- from an @AnnKeywordId@ because the annotation must be interleaved into the
-- stream and does not have a well-defined position
data Comment = Comment
    {
      Comment -> String
commentContents   :: !String -- ^ The contents of the comment including separators

    -- AZ:TODO: commentIdentifier is a misnomer, should be commentSrcSpan, it is
    -- the thing we use to decide where in the output stream the comment should
    -- go.
    , Comment -> AnnSpan
commentIdentifier :: !AnnSpan -- ^ Needed to uniquely identify two comments with the same contents
    , Comment -> Maybe AnnKeywordId
commentOrigin     :: !(Maybe GHC.AnnKeywordId) -- ^ We sometimes turn syntax into comments in order to process them properly.
    }
  deriving (Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c== :: Comment -> Comment -> Bool
Eq,Typeable,Typeable Comment
DataType
Constr
Typeable Comment
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Comment -> c Comment)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Comment)
-> (Comment -> Constr)
-> (Comment -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Comment))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment))
-> ((forall b. Data b => b -> b) -> Comment -> Comment)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Comment -> r)
-> (forall u. (forall d. Data d => d -> u) -> Comment -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Comment -> m Comment)
-> Data Comment
Comment -> DataType
Comment -> Constr
(forall b. Data b => b -> b) -> Comment -> Comment
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
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) -> Comment -> u
forall u. (forall d. Data d => d -> u) -> Comment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
$cComment :: Constr
$tComment :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapMp :: (forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapM :: (forall d. Data d => d -> m d) -> Comment -> m Comment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment -> m Comment
gmapQi :: Int -> (forall d. Data d => d -> u) -> Comment -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comment -> u
gmapQ :: (forall d. Data d => d -> u) -> Comment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Comment -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment -> r
gmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
$cgmapT :: (forall b. Data b => b -> b) -> Comment -> Comment
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Comment)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Comment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Comment)
dataTypeOf :: Comment -> DataType
$cdataTypeOf :: Comment -> DataType
toConstr :: Comment -> Constr
$ctoConstr :: Comment -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Comment
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment -> c Comment
$cp1Data :: Typeable Comment
Data,Eq Comment
Eq Comment
-> (Comment -> Comment -> Ordering)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Comment)
-> (Comment -> Comment -> Comment)
-> Ord Comment
Comment -> Comment -> Bool
Comment -> Comment -> Ordering
Comment -> Comment -> Comment
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 :: Comment -> Comment -> Comment
$cmin :: Comment -> Comment -> Comment
max :: Comment -> Comment -> Comment
$cmax :: Comment -> Comment -> Comment
>= :: Comment -> Comment -> Bool
$c>= :: Comment -> Comment -> Bool
> :: Comment -> Comment -> Bool
$c> :: Comment -> Comment -> Bool
<= :: Comment -> Comment -> Bool
$c<= :: Comment -> Comment -> Bool
< :: Comment -> Comment -> Bool
$c< :: Comment -> Comment -> Bool
compare :: Comment -> Comment -> Ordering
$ccompare :: Comment -> Comment -> Ordering
$cp1Ord :: Eq Comment
Ord)
instance Show Comment where
  show :: Comment -> String
show (Comment String
cs AnnSpan
ss Maybe AnnKeywordId
o) = String
"(Comment " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
cs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnnSpan -> String
forall a. Outputable a => a -> String
showGhc AnnSpan
ss String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe AnnKeywordId -> String
forall a. Show a => a -> String
show Maybe AnnKeywordId
o String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance GHC.Outputable Comment where
  ppr :: Comment -> SDoc
ppr Comment
x = String -> SDoc
GHC.text (Comment -> String
forall a. Show a => a -> String
show Comment
x)

type Pos = (Int,Int)

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

deltaRow, deltaColumn :: DeltaPos -> Int
deltaRow :: DeltaPos -> Int
deltaRow (DP (Int
r, Int
_)) = Int
r
deltaColumn :: DeltaPos -> Int
deltaColumn (DP (Int
_, Int
c)) = Int
c


-- | Marks the start column of a layout block.
newtype LayoutStartCol = LayoutStartCol { LayoutStartCol -> Int
getLayoutStartCol :: Int }
  deriving (LayoutStartCol -> LayoutStartCol -> Bool
(LayoutStartCol -> LayoutStartCol -> Bool)
-> (LayoutStartCol -> LayoutStartCol -> Bool) -> Eq LayoutStartCol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayoutStartCol -> LayoutStartCol -> Bool
$c/= :: LayoutStartCol -> LayoutStartCol -> Bool
== :: LayoutStartCol -> LayoutStartCol -> Bool
$c== :: LayoutStartCol -> LayoutStartCol -> Bool
Eq, Integer -> LayoutStartCol
LayoutStartCol -> LayoutStartCol
LayoutStartCol -> LayoutStartCol -> LayoutStartCol
(LayoutStartCol -> LayoutStartCol -> LayoutStartCol)
-> (LayoutStartCol -> LayoutStartCol -> LayoutStartCol)
-> (LayoutStartCol -> LayoutStartCol -> LayoutStartCol)
-> (LayoutStartCol -> LayoutStartCol)
-> (LayoutStartCol -> LayoutStartCol)
-> (LayoutStartCol -> LayoutStartCol)
-> (Integer -> LayoutStartCol)
-> Num LayoutStartCol
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> LayoutStartCol
$cfromInteger :: Integer -> LayoutStartCol
signum :: LayoutStartCol -> LayoutStartCol
$csignum :: LayoutStartCol -> LayoutStartCol
abs :: LayoutStartCol -> LayoutStartCol
$cabs :: LayoutStartCol -> LayoutStartCol
negate :: LayoutStartCol -> LayoutStartCol
$cnegate :: LayoutStartCol -> LayoutStartCol
* :: LayoutStartCol -> LayoutStartCol -> LayoutStartCol
$c* :: LayoutStartCol -> LayoutStartCol -> LayoutStartCol
- :: LayoutStartCol -> LayoutStartCol -> LayoutStartCol
$c- :: LayoutStartCol -> LayoutStartCol -> LayoutStartCol
+ :: LayoutStartCol -> LayoutStartCol -> LayoutStartCol
$c+ :: LayoutStartCol -> LayoutStartCol -> LayoutStartCol
Num)

instance Show LayoutStartCol where
  show :: LayoutStartCol -> String
show (LayoutStartCol Int
sc) = String
"(LayoutStartCol " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"


annNone :: Annotation
annNone :: Annotation
annNone = DeltaPos
-> [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)]
-> [(KeywordId, DeltaPos)]
-> Maybe [AnnSpan]
-> Maybe AnnKey
-> Annotation
Ann ((Int, Int) -> DeltaPos
DP (Int
0,Int
0)) [] [] [] Maybe [AnnSpan]
forall a. Maybe a
Nothing Maybe AnnKey
forall a. Maybe a
Nothing

data Annotation = Ann
  {
    -- The first three fields relate to interfacing up into the AST
    Annotation -> DeltaPos
annEntryDelta      :: !DeltaPos
    -- ^ Offset used to get to the start of the SrcSpan, from whatever the prior
    -- output was, including all annPriorComments (field below).
  , Annotation -> [(Comment, DeltaPos)]
annPriorComments   :: ![(Comment,  DeltaPos)]
    -- ^ Comments coming after the last non-comment output of the preceding
    -- element but before the SrcSpan being annotated by this Annotation. If
    -- these are changed then annEntryDelta (field above) must also change to
    -- match.
  , Annotation -> [(Comment, DeltaPos)]
annFollowingComments   :: ![(Comment,  DeltaPos)]
    -- ^ Comments coming after the last output for the element subject to this
    -- Annotation. These will only be added by AST transformations, and care
    -- must be taken not to disturb layout of following elements.

  -- The next three fields relate to interacing down into the AST
  , Annotation -> [(KeywordId, DeltaPos)]
annsDP             :: ![(KeywordId, DeltaPos)]
    -- ^ Annotations associated with this element.
#if __GLASGOW_HASKELL__ >= 900
  , annSortKey         :: !(Maybe [GHC.RealSrcSpan])
#else
  , Annotation -> Maybe [AnnSpan]
annSortKey         :: !(Maybe [GHC.SrcSpan])
#endif
    -- ^ Captures the sort order of sub elements. This is needed when the
    -- sub-elements have been split (as in a HsLocalBind which holds separate
    -- binds and sigs) or for infix patterns where the order has been
    -- re-arranged. It is captured explicitly so that after the Delta phase a
    -- SrcSpan is used purely as an index into the annotations, allowing
    -- transformations of the AST including the introduction of new Located
    -- items or re-arranging existing ones.
  , Annotation -> Maybe AnnKey
annCapturedSpan    :: !(Maybe AnnKey)
    -- ^ Occasionally we must calculate a SrcSpan for an unlocated list of
    -- elements which we must remember for the Print phase. e.g. the statements
    -- in a HsLet or HsDo. These must be managed as a group because they all
    -- need eo be vertically aligned for the Haskell layout rules, and this
    -- guarantees this property in the presence of AST edits.

  } deriving (Typeable,Annotation -> Annotation -> Bool
(Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool) -> Eq Annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
Eq)

instance Show Annotation where
  show :: Annotation -> String
show (Ann DeltaPos
dp [(Comment, DeltaPos)]
comments [(Comment, DeltaPos)]
fcomments [(KeywordId, DeltaPos)]
ans Maybe [AnnSpan]
sk Maybe AnnKey
csp)
    = String
"(Ann (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DeltaPos -> String
forall a. Show a => a -> String
show DeltaPos
dp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Comment, DeltaPos)] -> String
forall a. Show a => a -> String
show [(Comment, DeltaPos)]
comments String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Comment, DeltaPos)] -> String
forall a. Show a => a -> String
show [(Comment, DeltaPos)]
fcomments String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(KeywordId, DeltaPos)] -> String
forall a. Show a => a -> String
show [(KeywordId, DeltaPos)]
ans String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe [AnnSpan] -> String
forall a. Outputable a => a -> String
showGhc Maybe [AnnSpan]
sk String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe AnnKey -> String
forall a. Outputable a => a -> String
showGhc Maybe AnnKey
csp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"


-- | This structure holds a complete set of annotations for an AST
type Anns = Map.Map AnnKey Annotation

emptyAnns :: Anns
emptyAnns :: Anns
emptyAnns = Anns
forall k a. Map k a
Map.empty

-- | For every @Located a@, use the @SrcSpan@ and constructor name of
-- a as the key, to store the standard annotation.
-- These are used to maintain context in the AP and EP monads
data AnnKey   = AnnKey AnnSpan AnnConName
                  deriving (AnnKey -> AnnKey -> Bool
(AnnKey -> AnnKey -> Bool)
-> (AnnKey -> AnnKey -> Bool) -> Eq AnnKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnKey -> AnnKey -> Bool
$c/= :: AnnKey -> AnnKey -> Bool
== :: AnnKey -> AnnKey -> Bool
$c== :: AnnKey -> AnnKey -> Bool
Eq, Eq AnnKey
Eq AnnKey
-> (AnnKey -> AnnKey -> Ordering)
-> (AnnKey -> AnnKey -> Bool)
-> (AnnKey -> AnnKey -> Bool)
-> (AnnKey -> AnnKey -> Bool)
-> (AnnKey -> AnnKey -> Bool)
-> (AnnKey -> AnnKey -> AnnKey)
-> (AnnKey -> AnnKey -> AnnKey)
-> Ord AnnKey
AnnKey -> AnnKey -> Bool
AnnKey -> AnnKey -> Ordering
AnnKey -> AnnKey -> AnnKey
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 :: AnnKey -> AnnKey -> AnnKey
$cmin :: AnnKey -> AnnKey -> AnnKey
max :: AnnKey -> AnnKey -> AnnKey
$cmax :: AnnKey -> AnnKey -> AnnKey
>= :: AnnKey -> AnnKey -> Bool
$c>= :: AnnKey -> AnnKey -> Bool
> :: AnnKey -> AnnKey -> Bool
$c> :: AnnKey -> AnnKey -> Bool
<= :: AnnKey -> AnnKey -> Bool
$c<= :: AnnKey -> AnnKey -> Bool
< :: AnnKey -> AnnKey -> Bool
$c< :: AnnKey -> AnnKey -> Bool
compare :: AnnKey -> AnnKey -> Ordering
$ccompare :: AnnKey -> AnnKey -> Ordering
$cp1Ord :: Eq AnnKey
Ord, Typeable AnnKey
DataType
Constr
Typeable AnnKey
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AnnKey -> c AnnKey)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AnnKey)
-> (AnnKey -> Constr)
-> (AnnKey -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AnnKey))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AnnKey))
-> ((forall b. Data b => b -> b) -> AnnKey -> AnnKey)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnKey -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnKey -> r)
-> (forall u. (forall d. Data d => d -> u) -> AnnKey -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> AnnKey -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AnnKey -> m AnnKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AnnKey -> m AnnKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AnnKey -> m AnnKey)
-> Data AnnKey
AnnKey -> DataType
AnnKey -> Constr
(forall b. Data b => b -> b) -> AnnKey -> AnnKey
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnKey -> c AnnKey
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnKey
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) -> AnnKey -> u
forall u. (forall d. Data d => d -> u) -> AnnKey -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> AnnKey -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> AnnKey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AnnKey -> m AnnKey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnnKey -> m AnnKey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnKey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnKey -> c AnnKey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnKey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AnnKey)
$cAnnKey :: Constr
$tAnnKey :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AnnKey -> m AnnKey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnnKey -> m AnnKey
gmapMp :: (forall d. Data d => d -> m d) -> AnnKey -> m AnnKey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnnKey -> m AnnKey
gmapM :: (forall d. Data d => d -> m d) -> AnnKey -> m AnnKey
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AnnKey -> m AnnKey
gmapQi :: Int -> (forall d. Data d => d -> u) -> AnnKey -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AnnKey -> u
gmapQ :: (forall d. Data d => d -> u) -> AnnKey -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AnnKey -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> AnnKey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> AnnKey -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> AnnKey -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> AnnKey -> r
gmapT :: (forall b. Data b => b -> b) -> AnnKey -> AnnKey
$cgmapT :: (forall b. Data b => b -> b) -> AnnKey -> AnnKey
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AnnKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AnnKey)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AnnKey)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnKey)
dataTypeOf :: AnnKey -> DataType
$cdataTypeOf :: AnnKey -> DataType
toConstr :: AnnKey -> Constr
$ctoConstr :: AnnKey -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnKey
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnKey -> c AnnKey
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnKey -> c AnnKey
$cp1Data :: Typeable AnnKey
Data)

-- | From GHC 9.0 the ParsedSource uses RealSrcSpan instead of SrcSpan.
--   Compatibility type
#if __GLASGOW_HASKELL__ >= 900
type AnnSpan = GHC.RealSrcSpan
#else
type AnnSpan = GHC.SrcSpan
#endif

-- More compact Show instance
instance Show AnnKey where
  show :: AnnKey -> String
show (AnnKey AnnSpan
ss AnnConName
cn) = String
"AnnKey " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnnSpan -> String
forall a. Outputable a => a -> String
showGhc AnnSpan
ss String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnnConName -> String
forall a. Show a => a -> String
show AnnConName
cn


#if __GLASGOW_HASKELL__ >= 900
mkAnnKeyPrim :: (Data a) => GHC.Located a -> AnnKey
mkAnnKeyPrim (GHC.L (GHC.RealSrcSpan l _) a) = AnnKey l (annGetConstr a)
mkAnnKeyPrim (GHC.L _ a) = AnnKey badRealSrcSpan (annGetConstr a)
#elif __GLASGOW_HASKELL__ > 806
mkAnnKeyPrim :: (Constraints a)
             => a -> AnnKey
mkAnnKeyPrim :: a -> AnnKey
mkAnnKeyPrim (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
GHC.dL->GHC.L AnnSpan
l SrcSpanLess a
a) = AnnSpan -> AnnConName -> AnnKey
AnnKey AnnSpan
l (SrcSpanLess a -> AnnConName
forall a. Data a => a -> AnnConName
annGetConstr SrcSpanLess a
a)
#else
mkAnnKeyPrim :: (Data a) => GHC.Located a -> AnnKey
mkAnnKeyPrim (GHC.L l a) = AnnKey l (annGetConstr a)
#endif


#if __GLASGOW_HASKELL__ >= 900
badRealSrcSpan :: GHC.RealSrcSpan
badRealSrcSpan = GHC.mkRealSrcSpan bad bad
  where
    bad = GHC.mkRealSrcLoc (GHC.fsLit "ghc-exactprint-nospan") 0 0
#endif

#if __GLASGOW_HASKELL__ <= 802
type GhcPs = GHC.RdrName
type GhcRn = GHC.Name
type GhcTc = GHC.Id
#else
type GhcPs = GHC.GhcPs
type GhcRn = GHC.GhcRn
type GhcTc = GHC.GhcTc
#endif


#if __GLASGOW_HASKELL__ > 808
noExt :: GHC.NoExtField
noExt :: NoExtField
noExt = NoExtField
GHC.NoExtField
#elif __GLASGOW_HASKELL__ > 804
noExt :: GHC.NoExt
noExt = GHC.noExt
#endif

-- |Make an unwrapped @AnnKey@ for the @LHsDecl@ case, a normal one otherwise.
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
mkAnnKey :: (Constraints a) => a -> AnnKey
#else
mkAnnKey :: (Data a) => GHC.Located a -> AnnKey
#endif
mkAnnKey :: a -> AnnKey
mkAnnKey a
ld =
  case a -> Maybe (LHsDecl GhcPs)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
ld :: Maybe (GHC.LHsDecl GhcPs) of
    Just LHsDecl GhcPs
d -> (forall a. Data a => Located a -> AnnKey)
-> LHsDecl GhcPs -> AnnKey
forall b.
(forall a. Data a => Located a -> b) -> LHsDecl GhcPs -> b
declFun forall a. Data a => Located a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKeyPrim LHsDecl GhcPs
d
    Maybe (LHsDecl GhcPs)
Nothing -> a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKeyPrim a
ld

-- Holds the name of a constructor
data AnnConName = CN { AnnConName -> String
unConName :: String }
                 deriving (AnnConName -> AnnConName -> Bool
(AnnConName -> AnnConName -> Bool)
-> (AnnConName -> AnnConName -> Bool) -> Eq AnnConName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnnConName -> AnnConName -> Bool
$c/= :: AnnConName -> AnnConName -> Bool
== :: AnnConName -> AnnConName -> Bool
$c== :: AnnConName -> AnnConName -> Bool
Eq, Eq AnnConName
Eq AnnConName
-> (AnnConName -> AnnConName -> Ordering)
-> (AnnConName -> AnnConName -> Bool)
-> (AnnConName -> AnnConName -> Bool)
-> (AnnConName -> AnnConName -> Bool)
-> (AnnConName -> AnnConName -> Bool)
-> (AnnConName -> AnnConName -> AnnConName)
-> (AnnConName -> AnnConName -> AnnConName)
-> Ord AnnConName
AnnConName -> AnnConName -> Bool
AnnConName -> AnnConName -> Ordering
AnnConName -> AnnConName -> AnnConName
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 :: AnnConName -> AnnConName -> AnnConName
$cmin :: AnnConName -> AnnConName -> AnnConName
max :: AnnConName -> AnnConName -> AnnConName
$cmax :: AnnConName -> AnnConName -> AnnConName
>= :: AnnConName -> AnnConName -> Bool
$c>= :: AnnConName -> AnnConName -> Bool
> :: AnnConName -> AnnConName -> Bool
$c> :: AnnConName -> AnnConName -> Bool
<= :: AnnConName -> AnnConName -> Bool
$c<= :: AnnConName -> AnnConName -> Bool
< :: AnnConName -> AnnConName -> Bool
$c< :: AnnConName -> AnnConName -> Bool
compare :: AnnConName -> AnnConName -> Ordering
$ccompare :: AnnConName -> AnnConName -> Ordering
$cp1Ord :: Eq AnnConName
Ord, Typeable AnnConName
DataType
Constr
Typeable AnnConName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AnnConName -> c AnnConName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AnnConName)
-> (AnnConName -> Constr)
-> (AnnConName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AnnConName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AnnConName))
-> ((forall b. Data b => b -> b) -> AnnConName -> AnnConName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnConName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AnnConName -> r)
-> (forall u. (forall d. Data d => d -> u) -> AnnConName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AnnConName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AnnConName -> m AnnConName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AnnConName -> m AnnConName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AnnConName -> m AnnConName)
-> Data AnnConName
AnnConName -> DataType
AnnConName -> Constr
(forall b. Data b => b -> b) -> AnnConName -> AnnConName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnConName -> c AnnConName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnConName
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) -> AnnConName -> u
forall u. (forall d. Data d => d -> u) -> AnnConName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnConName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnConName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AnnConName -> m AnnConName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnnConName -> m AnnConName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnConName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnConName -> c AnnConName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnConName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AnnConName)
$cCN :: Constr
$tAnnConName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AnnConName -> m AnnConName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnnConName -> m AnnConName
gmapMp :: (forall d. Data d => d -> m d) -> AnnConName -> m AnnConName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AnnConName -> m AnnConName
gmapM :: (forall d. Data d => d -> m d) -> AnnConName -> m AnnConName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AnnConName -> m AnnConName
gmapQi :: Int -> (forall d. Data d => d -> u) -> AnnConName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AnnConName -> u
gmapQ :: (forall d. Data d => d -> u) -> AnnConName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AnnConName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnConName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AnnConName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnConName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AnnConName -> r
gmapT :: (forall b. Data b => b -> b) -> AnnConName -> AnnConName
$cgmapT :: (forall b. Data b => b -> b) -> AnnConName -> AnnConName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AnnConName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AnnConName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AnnConName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AnnConName)
dataTypeOf :: AnnConName -> DataType
$cdataTypeOf :: AnnConName -> DataType
toConstr :: AnnConName -> Constr
$ctoConstr :: AnnConName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnConName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AnnConName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnConName -> c AnnConName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AnnConName -> c AnnConName
$cp1Data :: Typeable AnnConName
Data)

-- More compact show instance
instance Show AnnConName where
  show :: AnnConName -> String
show (CN String
s) = String
"CN " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s

annGetConstr :: (Data a) => a -> AnnConName
annGetConstr :: a -> AnnConName
annGetConstr a
a = String -> AnnConName
CN (Constr -> String
forall a. Show a => a -> String
show (Constr -> String) -> Constr -> String
forall a b. (a -> b) -> a -> b
$ a -> Constr
forall a. Data a => a -> Constr
toConstr a
a)

-- | The different syntactic elements which are not represented in the
-- AST.
data KeywordId = G GHC.AnnKeywordId  -- ^ A normal keyword
               | AnnSemiSep          -- ^ A separating comma
#if __GLASGOW_HASKELL__ >= 900
               | AnnEofPos
#endif
#if __GLASGOW_HASKELL__ >= 800
               | AnnTypeApp          -- ^ Visible type application annotation
#endif
               | AnnComment Comment
               | AnnString String    -- ^ Used to pass information from
                                     -- Delta to Print when we have to work
                                     -- out details from the original
                                     -- SrcSpan.
#if __GLASGOW_HASKELL__ <= 710
               | AnnUnicode GHC.AnnKeywordId -- ^ Used to indicate that we should print using unicode syntax if possible.
#endif
               deriving (KeywordId -> KeywordId -> Bool
(KeywordId -> KeywordId -> Bool)
-> (KeywordId -> KeywordId -> Bool) -> Eq KeywordId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeywordId -> KeywordId -> Bool
$c/= :: KeywordId -> KeywordId -> Bool
== :: KeywordId -> KeywordId -> Bool
$c== :: KeywordId -> KeywordId -> Bool
Eq, Eq KeywordId
Eq KeywordId
-> (KeywordId -> KeywordId -> Ordering)
-> (KeywordId -> KeywordId -> Bool)
-> (KeywordId -> KeywordId -> Bool)
-> (KeywordId -> KeywordId -> Bool)
-> (KeywordId -> KeywordId -> Bool)
-> (KeywordId -> KeywordId -> KeywordId)
-> (KeywordId -> KeywordId -> KeywordId)
-> Ord KeywordId
KeywordId -> KeywordId -> Bool
KeywordId -> KeywordId -> Ordering
KeywordId -> KeywordId -> KeywordId
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 :: KeywordId -> KeywordId -> KeywordId
$cmin :: KeywordId -> KeywordId -> KeywordId
max :: KeywordId -> KeywordId -> KeywordId
$cmax :: KeywordId -> KeywordId -> KeywordId
>= :: KeywordId -> KeywordId -> Bool
$c>= :: KeywordId -> KeywordId -> Bool
> :: KeywordId -> KeywordId -> Bool
$c> :: KeywordId -> KeywordId -> Bool
<= :: KeywordId -> KeywordId -> Bool
$c<= :: KeywordId -> KeywordId -> Bool
< :: KeywordId -> KeywordId -> Bool
$c< :: KeywordId -> KeywordId -> Bool
compare :: KeywordId -> KeywordId -> Ordering
$ccompare :: KeywordId -> KeywordId -> Ordering
$cp1Ord :: Eq KeywordId
Ord, Typeable KeywordId
DataType
Constr
Typeable KeywordId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> KeywordId -> c KeywordId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c KeywordId)
-> (KeywordId -> Constr)
-> (KeywordId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c KeywordId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeywordId))
-> ((forall b. Data b => b -> b) -> KeywordId -> KeywordId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> KeywordId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> KeywordId -> r)
-> (forall u. (forall d. Data d => d -> u) -> KeywordId -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> KeywordId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> KeywordId -> m KeywordId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> KeywordId -> m KeywordId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> KeywordId -> m KeywordId)
-> Data KeywordId
KeywordId -> DataType
KeywordId -> Constr
(forall b. Data b => b -> b) -> KeywordId -> KeywordId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeywordId -> c KeywordId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeywordId
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) -> KeywordId -> u
forall u. (forall d. Data d => d -> u) -> KeywordId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KeywordId -> m KeywordId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeywordId -> m KeywordId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeywordId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeywordId -> c KeywordId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KeywordId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeywordId)
$cAnnString :: Constr
$cAnnComment :: Constr
$cAnnTypeApp :: Constr
$cAnnSemiSep :: Constr
$cG :: Constr
$tKeywordId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> KeywordId -> m KeywordId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeywordId -> m KeywordId
gmapMp :: (forall d. Data d => d -> m d) -> KeywordId -> m KeywordId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KeywordId -> m KeywordId
gmapM :: (forall d. Data d => d -> m d) -> KeywordId -> m KeywordId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KeywordId -> m KeywordId
gmapQi :: Int -> (forall d. Data d => d -> u) -> KeywordId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> KeywordId -> u
gmapQ :: (forall d. Data d => d -> u) -> KeywordId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> KeywordId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> KeywordId -> r
gmapT :: (forall b. Data b => b -> b) -> KeywordId -> KeywordId
$cgmapT :: (forall b. Data b => b -> b) -> KeywordId -> KeywordId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeywordId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KeywordId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c KeywordId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KeywordId)
dataTypeOf :: KeywordId -> DataType
$cdataTypeOf :: KeywordId -> DataType
toConstr :: KeywordId -> Constr
$ctoConstr :: KeywordId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeywordId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KeywordId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeywordId -> c KeywordId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KeywordId -> c KeywordId
$cp1Data :: Typeable KeywordId
Data)

instance Show KeywordId where
  show :: KeywordId -> String
show (G AnnKeywordId
gc)          = String
"(G " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AnnKeywordId -> String
forall a. Show a => a -> String
show AnnKeywordId
gc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show KeywordId
AnnSemiSep      = String
"AnnSemiSep"
#if __GLASGOW_HASKELL__ >= 900
  show AnnEofPos       = "AnnEofPos"
#endif
#if __GLASGOW_HASKELL__ >= 800
  show KeywordId
AnnTypeApp      = String
"AnnTypeApp"
#endif
  show (AnnComment Comment
dc) = String
"(AnnComment " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Comment -> String
forall a. Show a => a -> String
show Comment
dc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (AnnString String
s)   = String
"(AnnString " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
#if __GLASGOW_HASKELL__ <= 710
  show (AnnUnicode gc) = "(AnnUnicode " ++ show gc ++ ")"
#endif

-- ---------------------------------------------------------------------

instance GHC.Outputable KeywordId where
  ppr :: KeywordId -> SDoc
ppr KeywordId
k     = String -> SDoc
GHC.text (KeywordId -> String
forall a. Show a => a -> String
show KeywordId
k)

instance GHC.Outputable AnnConName where
  ppr :: AnnConName -> SDoc
ppr AnnConName
tr     = String -> SDoc
GHC.text (AnnConName -> String
forall a. Show a => a -> String
show AnnConName
tr)

instance GHC.Outputable Annotation where
  ppr :: Annotation -> SDoc
ppr Annotation
a     = String -> SDoc
GHC.text (Annotation -> String
forall a. Show a => a -> String
show Annotation
a)

instance GHC.Outputable AnnKey where
  ppr :: AnnKey -> SDoc
ppr AnnKey
a     = String -> SDoc
GHC.text (AnnKey -> String
forall a. Show a => a -> String
show AnnKey
a)

instance GHC.Outputable DeltaPos where
  ppr :: DeltaPos -> SDoc
ppr DeltaPos
a     = String -> SDoc
GHC.text (DeltaPos -> String
forall a. Show a => a -> String
show DeltaPos
a)

-- ---------------------------------------------------------------------
--
-- Flag used to control whether we use rigid or normal layout rules.
-- NOTE: check is done via comparison of enumeration order, be careful with any changes
data Rigidity = NormalLayout | RigidLayout deriving (Rigidity -> Rigidity -> Bool
(Rigidity -> Rigidity -> Bool)
-> (Rigidity -> Rigidity -> Bool) -> Eq Rigidity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rigidity -> Rigidity -> Bool
$c/= :: Rigidity -> Rigidity -> Bool
== :: Rigidity -> Rigidity -> Bool
$c== :: Rigidity -> Rigidity -> Bool
Eq, Eq Rigidity
Eq Rigidity
-> (Rigidity -> Rigidity -> Ordering)
-> (Rigidity -> Rigidity -> Bool)
-> (Rigidity -> Rigidity -> Bool)
-> (Rigidity -> Rigidity -> Bool)
-> (Rigidity -> Rigidity -> Bool)
-> (Rigidity -> Rigidity -> Rigidity)
-> (Rigidity -> Rigidity -> Rigidity)
-> Ord Rigidity
Rigidity -> Rigidity -> Bool
Rigidity -> Rigidity -> Ordering
Rigidity -> Rigidity -> Rigidity
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 :: Rigidity -> Rigidity -> Rigidity
$cmin :: Rigidity -> Rigidity -> Rigidity
max :: Rigidity -> Rigidity -> Rigidity
$cmax :: Rigidity -> Rigidity -> Rigidity
>= :: Rigidity -> Rigidity -> Bool
$c>= :: Rigidity -> Rigidity -> Bool
> :: Rigidity -> Rigidity -> Bool
$c> :: Rigidity -> Rigidity -> Bool
<= :: Rigidity -> Rigidity -> Bool
$c<= :: Rigidity -> Rigidity -> Bool
< :: Rigidity -> Rigidity -> Bool
$c< :: Rigidity -> Rigidity -> Bool
compare :: Rigidity -> Rigidity -> Ordering
$ccompare :: Rigidity -> Rigidity -> Ordering
$cp1Ord :: Eq Rigidity
Ord, Int -> Rigidity -> ShowS
[Rigidity] -> ShowS
Rigidity -> String
(Int -> Rigidity -> ShowS)
-> (Rigidity -> String) -> ([Rigidity] -> ShowS) -> Show Rigidity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rigidity] -> ShowS
$cshowList :: [Rigidity] -> ShowS
show :: Rigidity -> String
$cshow :: Rigidity -> String
showsPrec :: Int -> Rigidity -> ShowS
$cshowsPrec :: Int -> Rigidity -> ShowS
Show)
{-

Rigidity logic. The same type is used for two different things

1. As a flag in Annotate to the "SetLayoutFlag" operation, which specifies
   NormalLayout - Layout should be captured unconditionally

   RigidLayout - Layout should be captured or not depending on a parameter kept
                 in the interpreter Read state

2. As the controlling parameter for the optional (Rigid) layout

The nett effect is the following, where flag is the hard-coded flag value in
Annotate, and param is the interpreter param set when the interpreter is run

   flag         |  param       | result
   -------------+--------------+--------------------
   NormalLayout |  either      | layout captured
   RigidLayout  | NormalLayout | layout NOT captured
   RigidLayout  | RigidLayout  | layout captured

The flag is only used on HsIf and HsCase

So

   state                       | HsCase    | HsIf
   ----------------------------|-----------+------
   before rigidity flag (AZ)   | no layout | layout
   param NormalLayout          | no layout | no layout
   param RigidLayout           | layout    | layout
   ----------------------------+-----------+-------
   desired future HaRe         | no layout | layout
   desired future apply-refact | layout    | layout
-}

-- ---------------------------------------------------------------------

data ACS' a = ACS
  { ACS' a -> Map a Int
acs :: !(Map.Map a Int) -- ^ how many levels each AstContext should
                            -- propagate down the AST. Removed when it hits zero
  } deriving (Int -> ACS' a -> ShowS
[ACS' a] -> ShowS
ACS' a -> String
(Int -> ACS' a -> ShowS)
-> (ACS' a -> String) -> ([ACS' a] -> ShowS) -> Show (ACS' a)
forall a. Show a => Int -> ACS' a -> ShowS
forall a. Show a => [ACS' a] -> ShowS
forall a. Show a => ACS' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ACS' a] -> ShowS
$cshowList :: forall a. Show a => [ACS' a] -> ShowS
show :: ACS' a -> String
$cshow :: forall a. Show a => ACS' a -> String
showsPrec :: Int -> ACS' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ACS' a -> ShowS
Show)

#if __GLASGOW_HASKELL__ >= 804
instance Semigroup (ACS' AstContext) where
  <> :: ACS' AstContext -> ACS' AstContext -> ACS' AstContext
(<>) = ACS' AstContext -> ACS' AstContext -> ACS' AstContext
forall a. Monoid a => a -> a -> a
mappend
#endif

instance Monoid (ACS' AstContext) where
  mempty :: ACS' AstContext
mempty = Map AstContext Int -> ACS' AstContext
forall a. Map a Int -> ACS' a
ACS Map AstContext Int
forall a. Monoid a => a
mempty
  -- ACS a `mappend` ACS b = ACS (a `mappend` b)
  ACS Map AstContext Int
a mappend :: ACS' AstContext -> ACS' AstContext -> ACS' AstContext
`mappend` ACS Map AstContext Int
b = Map AstContext Int -> ACS' AstContext
forall a. Map a Int -> ACS' a
ACS ((Int -> Int -> Int)
-> Map AstContext Int -> Map AstContext Int -> Map AstContext Int
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Map AstContext Int
a Map AstContext Int
b)
  -- For Data.Map, mappend == union, which is a left-biased replace for key collisions

type AstContextSet = ACS' AstContext
-- data AstContextSet = ACS
--   { acs :: !(Map.Map AstContext Int) -- ^ how many levels each AstContext should
--                                      -- propagate down the AST. Removed when it
--                                      -- hits zero
--   } deriving (Show)

defaultACS :: AstContextSet
defaultACS :: ACS' AstContext
defaultACS = Map AstContext Int -> ACS' AstContext
forall a. Map a Int -> ACS' a
ACS Map AstContext Int
forall k a. Map k a
Map.empty

-- instance GHC.Outputable AstContextSet where
instance (Show a) => GHC.Outputable (ACS' a) where
  ppr :: ACS' a -> SDoc
ppr ACS' a
x = String -> SDoc
GHC.text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ ACS' a -> String
forall a. Show a => a -> String
show ACS' a
x

data AstContext = LambdaExpr
                | CaseAlt
                | NoPrecedingSpace
                | HasHiding
                | AdvanceLine
                | NoAdvanceLine
                | Intercalate -- This item may have a list separator following
                | InIE -- possible 'type' or 'pattern'
                | PrefixOp
                | PrefixOpDollar
                | InfixOp -- RdrName may be used as an infix operator
                | ListStart -- Identifies first element of a list in layout, so its indentation can me managed differently
                | ListItem -- Identifies subsequent elements of a list in layout
                | TopLevel -- top level declaration
                | NoDarrow
                | AddVbar
                | Deriving
                | Parens -- TODO: Not currently used?
                | ExplicitNeverActive
                | InGadt
                | InRecCon
                | InClassDecl
                | InSpliceDecl
                | LeftMost -- Is this the leftmost operator in a chain of OpApps?
                | InTypeApp -- HsTyVar in a TYPEAPP context. Has AnnAt
                          -- TODO:AZ: do we actually need this?
                          -- TODO:AZ this is actually tight prefix

                -- Next four used to identify current list context
                | CtxOnly
                | CtxFirst
                | CtxMiddle
                | CtxLast
                | CtxPos Int -- 0 for first, increasing for subsequent

                -- Next are used in tellContext to push context up the tree
                | FollowingLine
                deriving (AstContext -> AstContext -> Bool
(AstContext -> AstContext -> Bool)
-> (AstContext -> AstContext -> Bool) -> Eq AstContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AstContext -> AstContext -> Bool
$c/= :: AstContext -> AstContext -> Bool
== :: AstContext -> AstContext -> Bool
$c== :: AstContext -> AstContext -> Bool
Eq, Eq AstContext
Eq AstContext
-> (AstContext -> AstContext -> Ordering)
-> (AstContext -> AstContext -> Bool)
-> (AstContext -> AstContext -> Bool)
-> (AstContext -> AstContext -> Bool)
-> (AstContext -> AstContext -> Bool)
-> (AstContext -> AstContext -> AstContext)
-> (AstContext -> AstContext -> AstContext)
-> Ord AstContext
AstContext -> AstContext -> Bool
AstContext -> AstContext -> Ordering
AstContext -> AstContext -> AstContext
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 :: AstContext -> AstContext -> AstContext
$cmin :: AstContext -> AstContext -> AstContext
max :: AstContext -> AstContext -> AstContext
$cmax :: AstContext -> AstContext -> AstContext
>= :: AstContext -> AstContext -> Bool
$c>= :: AstContext -> AstContext -> Bool
> :: AstContext -> AstContext -> Bool
$c> :: AstContext -> AstContext -> Bool
<= :: AstContext -> AstContext -> Bool
$c<= :: AstContext -> AstContext -> Bool
< :: AstContext -> AstContext -> Bool
$c< :: AstContext -> AstContext -> Bool
compare :: AstContext -> AstContext -> Ordering
$ccompare :: AstContext -> AstContext -> Ordering
$cp1Ord :: Eq AstContext
Ord, Int -> AstContext -> ShowS
[AstContext] -> ShowS
AstContext -> String
(Int -> AstContext -> ShowS)
-> (AstContext -> String)
-> ([AstContext] -> ShowS)
-> Show AstContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AstContext] -> ShowS
$cshowList :: [AstContext] -> ShowS
show :: AstContext -> String
$cshow :: AstContext -> String
showsPrec :: Int -> AstContext -> ShowS
$cshowsPrec :: Int -> AstContext -> ShowS
Show)


data ListContexts = LC { ListContexts -> Set AstContext
lcOnly,ListContexts -> Set AstContext
lcInitial,ListContexts -> Set AstContext
lcMiddle,ListContexts -> Set AstContext
lcLast :: !(Set.Set AstContext) }
  deriving (ListContexts -> ListContexts -> Bool
(ListContexts -> ListContexts -> Bool)
-> (ListContexts -> ListContexts -> Bool) -> Eq ListContexts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContexts -> ListContexts -> Bool
$c/= :: ListContexts -> ListContexts -> Bool
== :: ListContexts -> ListContexts -> Bool
$c== :: ListContexts -> ListContexts -> Bool
Eq,Int -> ListContexts -> ShowS
[ListContexts] -> ShowS
ListContexts -> String
(Int -> ListContexts -> ShowS)
-> (ListContexts -> String)
-> ([ListContexts] -> ShowS)
-> Show ListContexts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContexts] -> ShowS
$cshowList :: [ListContexts] -> ShowS
show :: ListContexts -> String
$cshow :: ListContexts -> String
showsPrec :: Int -> ListContexts -> ShowS
$cshowsPrec :: Int -> ListContexts -> ShowS
Show)

-- ---------------------------------------------------------------------

-- data LayoutContext = FollowingLine -- ^Indicates that an item such as a SigD
--                                    -- should not have blank lines after it
--                 deriving (Eq, Ord, Show)

-- ---------------------------------------------------------------------

declFun :: (forall a . Data a => GHC.Located a -> b) -> GHC.LHsDecl GhcPs -> b

#if __GLASGOW_HASKELL__ > 804
declFun :: (forall a. Data a => Located a -> b) -> LHsDecl GhcPs -> b
declFun forall a. Data a => Located a -> b
f (GHC.L AnnSpan
l HsDecl GhcPs
de) =
  case HsDecl GhcPs
de of
      GHC.TyClD XTyClD GhcPs
_ TyClDecl GhcPs
d       -> Located (TyClDecl GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> TyClDecl GhcPs -> Located (TyClDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l TyClDecl GhcPs
d)
      GHC.InstD XInstD GhcPs
_ InstDecl GhcPs
d       -> Located (InstDecl GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> InstDecl GhcPs -> Located (InstDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l InstDecl GhcPs
d)
      GHC.DerivD XDerivD GhcPs
_ DerivDecl GhcPs
d      -> Located (DerivDecl GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> DerivDecl GhcPs -> Located (DerivDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l DerivDecl GhcPs
d)
      GHC.ValD XValD GhcPs
_ HsBind GhcPs
d        -> Located (HsBind GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> HsBind GhcPs -> Located (HsBind GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l HsBind GhcPs
d)
      GHC.SigD XSigD GhcPs
_ Sig GhcPs
d        -> Located (Sig GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> Sig GhcPs -> Located (Sig GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l Sig GhcPs
d)
#if __GLASGOW_HASKELL__ > 808
      GHC.KindSigD XKindSigD GhcPs
_ StandaloneKindSig GhcPs
d    -> Located (StandaloneKindSig GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan
-> StandaloneKindSig GhcPs -> Located (StandaloneKindSig GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l StandaloneKindSig GhcPs
d)
#endif
      GHC.DefD XDefD GhcPs
_ DefaultDecl GhcPs
d        -> Located (DefaultDecl GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> DefaultDecl GhcPs -> Located (DefaultDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l DefaultDecl GhcPs
d)
      GHC.ForD XForD GhcPs
_ ForeignDecl GhcPs
d        -> Located (ForeignDecl GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> ForeignDecl GhcPs -> Located (ForeignDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l ForeignDecl GhcPs
d)
      GHC.WarningD XWarningD GhcPs
_ WarnDecls GhcPs
d    -> Located (WarnDecls GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> WarnDecls GhcPs -> Located (WarnDecls GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l WarnDecls GhcPs
d)
      GHC.AnnD XAnnD GhcPs
_ AnnDecl GhcPs
d        -> Located (AnnDecl GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> AnnDecl GhcPs -> Located (AnnDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l AnnDecl GhcPs
d)
      GHC.RuleD XRuleD GhcPs
_ RuleDecls GhcPs
d       -> Located (RuleDecls GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> RuleDecls GhcPs -> Located (RuleDecls GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l RuleDecls GhcPs
d)
      GHC.SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
d     -> Located (SpliceDecl GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> SpliceDecl GhcPs -> Located (SpliceDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l SpliceDecl GhcPs
d)
      GHC.DocD XDocD GhcPs
_ DocDecl
d        -> Located DocDecl -> b
forall a. Data a => Located a -> b
f (AnnSpan -> DocDecl -> Located DocDecl
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l DocDecl
d)
      GHC.RoleAnnotD XRoleAnnotD GhcPs
_ RoleAnnotDecl GhcPs
d  -> Located (RoleAnnotDecl GhcPs) -> b
forall a. Data a => Located a -> b
f (AnnSpan -> RoleAnnotDecl GhcPs -> Located (RoleAnnotDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L AnnSpan
l RoleAnnotDecl GhcPs
d)
      GHC.XHsDecl XXHsDecl GhcPs
_       -> String -> b
forall a. HasCallStack => String -> a
error String
"declFun:XHsDecl"
#else
declFun f (GHC.L l de) =
  case de of
      GHC.TyClD d       -> f (GHC.L l d)
      GHC.InstD d       -> f (GHC.L l d)
      GHC.DerivD d      -> f (GHC.L l d)
      GHC.ValD d        -> f (GHC.L l d)
      GHC.SigD d        -> f (GHC.L l d)
      GHC.DefD d        -> f (GHC.L l d)
      GHC.ForD d        -> f (GHC.L l d)
      GHC.WarningD d    -> f (GHC.L l d)
      GHC.AnnD d        -> f (GHC.L l d)
      GHC.RuleD d       -> f (GHC.L l d)
      GHC.VectD d       -> f (GHC.L l d)
      GHC.SpliceD d     -> f (GHC.L l d)
      GHC.DocD d        -> f (GHC.L l d)
      GHC.RoleAnnotD d  -> f (GHC.L l d)
#if __GLASGOW_HASKELL__ < 711
      GHC.QuasiQuoteD d -> f (GHC.L l d)
#endif
#endif

-- ---------------------------------------------------------------------

-- Duplicated here so it can be used in show instances
showGhc :: (GHC.Outputable a) => a -> String
showGhc :: a -> String
showGhc = DynFlags -> a -> String
forall a. Outputable a => DynFlags -> a -> String
GHC.showPpr DynFlags
GHC.unsafeGlobalDynFlags

-- ---------------------------------------------------------------------