{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf           #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns         #-}

module Language.Haskell.GHC.ExactPrint.Types
  where

import GHC hiding (EpaComment)
import GHC.Utils.Outputable hiding ( (<>) )
import Data.Data (Data, toConstr,cast)

import qualified Data.Map as Map

-- ---------------------------------------------------------------------
-- | 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 RealSrcSpan 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, Typeable AnnKey
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 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> AnnKey -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AnnKey -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> AnnKey -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AnnKey -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, 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
Ord)

-- More compact Show instance
instance Show AnnKey where
  show :: AnnKey -> String
show (AnnKey RealSrcSpan
ss AnnConName
cn) = String
"AnnKey " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RealSrcSpan -> String
forall a. Outputable a => a -> String
showPprUnsafe RealSrcSpan
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

mkAnnKeyPrim :: (Data a) => Located a -> AnnKey
mkAnnKeyPrim :: forall a. Data a => Located a -> AnnKey
mkAnnKeyPrim (L SrcSpan
l a
a) = RealSrcSpan -> AnnConName -> AnnKey
AnnKey (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) (a -> AnnConName
forall a. Data a => a -> AnnConName
annGetConstr a
a)

mkAnnKeyPrimA :: (Data a) => LocatedA a -> AnnKey
mkAnnKeyPrimA :: forall a. Data a => LocatedA a -> AnnKey
mkAnnKeyPrimA (L SrcSpanAnnA
l a
a) = RealSrcSpan -> AnnConName -> AnnKey
AnnKey (SrcSpan -> RealSrcSpan
realSrcSpan (SrcSpan -> RealSrcSpan) -> SrcSpan -> RealSrcSpan
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) (a -> AnnConName
forall a. Data a => a -> AnnConName
annGetConstr a
a)

-- 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
Ord, Typeable AnnConName
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 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> AnnConName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AnnConName -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> AnnConName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AnnConName -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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 :: forall a. Data a => 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)

-- |Make an unwrapped @AnnKey@ for the @LHsDecl@ case, a normal one otherwise.
mkAnnKey :: (Data a) => Located a -> AnnKey
mkAnnKey :: forall a. Data a => Located a -> AnnKey
mkAnnKey Located a
ld =
  case Located a -> Maybe (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Located a
ld :: Maybe (LHsDecl GhcPs) of
    Just XRec GhcPs (HsDecl GhcPs)
d -> (forall a. Data a => LocatedA a -> AnnKey)
-> XRec GhcPs (HsDecl GhcPs) -> AnnKey
forall b.
(forall a. Data a => LocatedA a -> b)
-> XRec GhcPs (HsDecl GhcPs) -> b
declFun forall a. Data a => LocatedA a -> AnnKey
mkAnnKeyPrimA XRec GhcPs (HsDecl GhcPs)
d
    Maybe (XRec GhcPs (HsDecl GhcPs))
Nothing -> Located a -> AnnKey
forall a. Data a => Located a -> AnnKey
mkAnnKeyPrim Located a
ld


type Pos = (Int,Int)

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

annNone :: Annotation
annNone :: Annotation
annNone = DeltaPos
-> [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)]
-> [(KeywordId, DeltaPos)]
-> Maybe [RealSrcSpan]
-> Maybe AnnKey
-> Annotation
Ann (Int -> DeltaPos
SameLine Int
0) [] [] [] Maybe [RealSrcSpan]
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.
  , Annotation -> Maybe [RealSrcSpan]
annSortKey         :: !(Maybe [RealSrcSpan])
    -- ^ 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 (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)

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

declFun :: (forall a . Data a => LocatedA a -> b) -> LHsDecl GhcPs -> b
declFun :: forall b.
(forall a. Data a => LocatedA a -> b)
-> XRec GhcPs (HsDecl GhcPs) -> b
declFun forall a. Data a => LocatedA a -> b
f (L SrcSpanAnnA
l HsDecl GhcPs
de) =
  case HsDecl GhcPs
de of
      TyClD XTyClD GhcPs
_ TyClDecl GhcPs
d       -> LocatedA (TyClDecl GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> TyClDecl GhcPs -> LocatedA (TyClDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l TyClDecl GhcPs
d)
      InstD XInstD GhcPs
_ InstDecl GhcPs
d       -> LocatedA (InstDecl GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> InstDecl GhcPs -> LocatedA (InstDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l InstDecl GhcPs
d)
      DerivD XDerivD GhcPs
_ DerivDecl GhcPs
d      -> LocatedA (DerivDecl GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> DerivDecl GhcPs -> LocatedA (DerivDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l DerivDecl GhcPs
d)
      ValD XValD GhcPs
_ HsBind GhcPs
d        -> LocatedA (HsBind GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> HsBind GhcPs -> LocatedA (HsBind GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsBind GhcPs
d)
      SigD XSigD GhcPs
_ Sig GhcPs
d        -> LocatedA (Sig GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> Sig GhcPs -> LocatedA (Sig GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l Sig GhcPs
d)
      KindSigD XKindSigD GhcPs
_ StandaloneKindSig GhcPs
d    -> LocatedA (StandaloneKindSig GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA
-> StandaloneKindSig GhcPs -> LocatedA (StandaloneKindSig GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l StandaloneKindSig GhcPs
d)
      DefD XDefD GhcPs
_ DefaultDecl GhcPs
d        -> LocatedA (DefaultDecl GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> DefaultDecl GhcPs -> LocatedA (DefaultDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l DefaultDecl GhcPs
d)
      ForD XForD GhcPs
_ ForeignDecl GhcPs
d        -> LocatedA (ForeignDecl GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> ForeignDecl GhcPs -> LocatedA (ForeignDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ForeignDecl GhcPs
d)
      WarningD XWarningD GhcPs
_ WarnDecls GhcPs
d    -> LocatedA (WarnDecls GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> WarnDecls GhcPs -> LocatedA (WarnDecls GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l WarnDecls GhcPs
d)
      AnnD XAnnD GhcPs
_ AnnDecl GhcPs
d        -> LocatedA (AnnDecl GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> AnnDecl GhcPs -> LocatedA (AnnDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l AnnDecl GhcPs
d)
      RuleD XRuleD GhcPs
_ RuleDecls GhcPs
d       -> LocatedA (RuleDecls GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> RuleDecls GhcPs -> LocatedA (RuleDecls GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l RuleDecls GhcPs
d)
      SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
d     -> LocatedA (SpliceDecl GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> SpliceDecl GhcPs -> LocatedA (SpliceDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l SpliceDecl GhcPs
d)
      DocD XDocD GhcPs
_ DocDecl
d        -> LocatedA DocDecl -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA -> DocDecl -> LocatedA DocDecl
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l DocDecl
d)
      RoleAnnotD XRoleAnnotD GhcPs
_ RoleAnnotDecl GhcPs
d  -> LocatedA (RoleAnnotDecl GhcPs) -> b
forall a. Data a => LocatedA a -> b
f (SrcSpanAnnA
-> RoleAnnotDecl GhcPs -> LocatedA (RoleAnnotDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l RoleAnnotDecl GhcPs
d)

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

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
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)



-- | 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 -> Anchor
commentAnchor :: !Anchor
    , Comment -> Maybe AnnKeywordId
commentOrigin :: !(Maybe 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

instance Show Comment where
  show :: Comment -> String
show (Comment String
cs Anchor
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]
++ Anchor -> String
forall a. Outputable a => a -> String
showPprUnsafe Anchor
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 Ord Comment where
  -- When we have CPP injected comments with a fake filename, or LINE
  -- pragma, the file name changes, so we need to compare the
  -- locations only, with out the filename.
  compare :: Comment -> Comment -> Ordering
compare (Comment String
_ Anchor
ss1 Maybe AnnKeywordId
_) (Comment String
_ Anchor
ss2 Maybe AnnKeywordId
_) = (Int, Int) -> (Int, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RealSrcSpan -> (Int, Int)
ss2pos (RealSrcSpan -> (Int, Int)) -> RealSrcSpan -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
anchor Anchor
ss1) (RealSrcSpan -> (Int, Int)
ss2pos (RealSrcSpan -> (Int, Int)) -> RealSrcSpan -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Anchor -> RealSrcSpan
anchor Anchor
ss2)
    where
      ss2pos :: RealSrcSpan -> (Int, Int)
ss2pos RealSrcSpan
ss = (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
ss,RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ss)

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

-- | The different syntactic elements which are not represented in the
-- AST.
data KeywordId = G AnnKeywordId  -- ^ A normal keyword
               | AnnSemiSep          -- ^ A separating comma
               | AnnTypeApp          -- ^ Visible type application annotation
               | AnnComment Comment
               | AnnString String    -- ^ Used to pass information from
                                     -- Delta to Print when we have to work
                                     -- out details from the original
                                     -- SrcSpan.
               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)

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"
  show KeywordId
AnnTypeApp      = String
"AnnTypeApp"
  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
")"

-- | 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
")"
-- ---------------------------------------------------------------------

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