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

import Prelude hiding ((<>))

import GHC
import GHC.Utils.Outputable
import GHC.Types.Id
import GHC.Tc.Utils.TcType
import GHC.Runtime.Eval
import GHC.Types.Unique.Supply (uniqFromTag)
import GHC.Types.Name.Env

-- | 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 -> 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
  -- | A positional index is an index from 1 to inf
  = PositionalIndex Int
  -- | A labeled field indexes a datacon fields by name
  | LabeledField Name
  deriving (PathFragment -> PathFragment -> Bool
(PathFragment -> PathFragment -> Bool)
-> (PathFragment -> PathFragment -> Bool) -> Eq PathFragment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathFragment -> PathFragment -> Bool
== :: PathFragment -> PathFragment -> Bool
$c/= :: PathFragment -> PathFragment -> Bool
/= :: PathFragment -> PathFragment -> Bool
Eq, Eq PathFragment
Eq PathFragment =>
(PathFragment -> PathFragment -> Ordering)
-> (PathFragment -> PathFragment -> Bool)
-> (PathFragment -> PathFragment -> Bool)
-> (PathFragment -> PathFragment -> Bool)
-> (PathFragment -> PathFragment -> Bool)
-> (PathFragment -> PathFragment -> PathFragment)
-> (PathFragment -> PathFragment -> PathFragment)
-> Ord PathFragment
PathFragment -> PathFragment -> Bool
PathFragment -> PathFragment -> Ordering
PathFragment -> PathFragment -> PathFragment
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
$ccompare :: PathFragment -> PathFragment -> Ordering
compare :: PathFragment -> PathFragment -> Ordering
$c< :: PathFragment -> PathFragment -> Bool
< :: PathFragment -> PathFragment -> Bool
$c<= :: PathFragment -> PathFragment -> Bool
<= :: PathFragment -> PathFragment -> Bool
$c> :: PathFragment -> PathFragment -> Bool
> :: PathFragment -> PathFragment -> Bool
$c>= :: PathFragment -> PathFragment -> Bool
>= :: PathFragment -> PathFragment -> Bool
$cmax :: PathFragment -> PathFragment -> PathFragment
max :: PathFragment -> PathFragment -> PathFragment
$cmin :: PathFragment -> PathFragment -> PathFragment
min :: PathFragment -> PathFragment -> PathFragment
Ord)

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
last_p) = PathFragment -> SDoc
forall a. Outputable a => a -> SDoc
ppr PathFragment
last_p

instance Outputable PathFragment where
  ppr :: PathFragment -> 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 Name
n)    = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n

-- | >>> unconsTermKey (FromPath (FromPath (FromId hi) (Pos 1)) (Pos 2))
-- (hi, [1, 2])
unconsTermKey :: TermKey -> (Id, [PathFragment])
unconsTermKey :: TermKey -> (Id, [PathFragment])
unconsTermKey = [PathFragment] -> TermKey -> (Id, [PathFragment])
go [] where
  go :: [PathFragment] -> TermKey -> (Id, [PathFragment])
go [PathFragment]
acc (FromId Id
i) = (Id
i, [PathFragment] -> [PathFragment]
forall a. [a] -> [a]
reverse [PathFragment]
acc)
  go [PathFragment]
acc (FromPath TermKey
k PathFragment
p) = [PathFragment] -> TermKey -> (Id, [PathFragment])
go (PathFragment
pPathFragment -> [PathFragment] -> [PathFragment]
forall a. a -> [a] -> [a]
:[PathFragment]
acc) TermKey
k