{-# LANGUAGE GADTs, ViewPatterns, DataKinds #-}
module GHC.Debugger.Runtime.Term.Key where

import Prelude hiding ((<>))

import GHC
import GHC.Utils.Outputable
import GHC.Runtime.Eval

-- | A 'TermKey' serves to fetch a Term in a Debugger session.
-- Note: A 'TermKey' is only valid in the stopped context it was created in.
data TermKey where
  -- | Obtain a term from an Id.
  FromId :: Id -> TermKey

  -- | Append a PathFragment to the current Term Key. Used to construct keys
  -- for indexed and labeled fields.
  FromPath :: TermKey -> PathFragment False -> TermKey

  -- | Use a custom term, by custom name, along a TermKey path, rather than
  -- reconstructing one from the 'FromId' root.
  FromCustomTerm :: TermKey -> String -> Term -> TermKey

-- | A term may be identified by an 'Id' (such as a local variable) plus a list
-- of 'PathFragment's to an arbitrarily nested field.
data PathFragment (b :: Bool {- whether allow custom field -}) where
  -- | A positional index is an index from 1 to inf
  PositionalIndex :: Int -> PathFragment b
  -- | A labeled field indexes a datacon fields by name
  -- The position is given by the 'Int'
  -- The name is cosmetic.
  LabeledField    :: Int -> Name -> PathFragment b
deriving instance Eq (PathFragment b)
deriving instance Ord (PathFragment b)

instance Outputable TermKey where
  ppr :: TermKey -> SDoc
ppr (FromId Id
i)             = Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
i
  ppr (FromPath TermKey
_ PathFragment 'False
last_p)    = PathFragment 'False -> SDoc
forall a. Outputable a => a -> SDoc
ppr PathFragment 'False
last_p
  ppr (FromCustomTerm TermKey
_ String
s Term
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
s

instance Outputable (PathFragment b) where
  ppr :: PathFragment b -> SDoc
ppr (PositionalIndex Int
i) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"_" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
i
  ppr (LabeledField Int
_ Name
n)    = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n