Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

refactor: remove unnecessary instance and use of unsafeCoerce #4518

Merged
merged 1 commit into from
Mar 20, 2025
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
22 changes: 10 additions & 12 deletions ghcide/src/Development/IDE/Types/Shake.hs
Original file line number Diff line number Diff line change
Expand Up @@ -33,10 +33,9 @@ import GHC.Generics
import HieDb.Types (HieDb)
import qualified StmContainers.Map as STM
import Type.Reflection (SomeTypeRep (SomeTypeRep),
pattern App, pattern Con,
typeOf, typeRep,
typeRepTyCon)
import Unsafe.Coerce (unsafeCoerce)
eqTypeRep, pattern App,
type (:~~:) (HRefl),
typeOf, typeRep)

-- | Intended to represent HieDb calls wrapped with (currently) retry
-- functionality
Expand Down Expand Up @@ -86,11 +85,12 @@ fromKey (Key k)

-- | fromKeyType (Q (k,f)) = (typeOf k, f)
fromKeyType :: Key -> Maybe (SomeTypeRep, NormalizedFilePath)
fromKeyType (Key k) = case typeOf k of
App (Con tc) a | tc == typeRepTyCon (typeRep @Q)
-> case unsafeCoerce k of
Q (_ :: (), f) -> Just (SomeTypeRep a, f)
_ -> Nothing
fromKeyType (Key k)
| App tc a <- typeOf k
, Just HRefl <- tc `eqTypeRep` (typeRep @Q)
, Q (_, f) <- k
= Just (SomeTypeRep a, f)
| otherwise = Nothing

toNoFileKey :: (Show k, Typeable k, Eq k, Hashable k) => k -> Key
toNoFileKey k = newKey $ Q (k, emptyFilePath)
Expand All @@ -101,13 +101,11 @@ newtype Q k = Q (k, NormalizedFilePath)
instance Show k => Show (Q k) where
show (Q (k, file)) = show k ++ "; " ++ fromNormalizedFilePath file

-- | Invariant: the 'v' must be in normal form (fully evaluated).
-- | Invariant: the @v@ must be in normal form (fully evaluated).
-- Otherwise we keep repeatedly 'rnf'ing values taken from the Shake database
newtype A v = A (Value v)
deriving Show

instance NFData (A v) where rnf (A v) = v `seq` ()

-- In the Shake database we only store one type of key/result pairs,
-- namely Q (question) / A (answer).
type instance RuleResult (Q k) = A (RuleResult k)
Expand Down
Loading