1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
module InitOnce.Types (Location, location', TypedAny(TypedAny), getTypedAny) where
import Language.Haskell.TH (Q, location, Loc(loc_start, loc_package, loc_module))
import Language.Haskell.TH.Syntax (CharPos, Lift)
import Type.Reflection (Typeable, TypeRep, (:~~:)(HRefl), pattern TypeRep, eqTypeRep)
data Location = Location
String -- package
String -- module
CharPos -- position in source file (line)
deriving (Eq, Ord, Lift)
location' :: Q Location
location' = locationFromLoc <$> location
where locationFromLoc loc = Location (loc_package loc) (loc_module loc) (loc_start loc)
data TypedAny = forall a. TypedAny (TypeRep a) a
getTypedAny :: forall a. Typeable a => TypedAny -> a
getTypedAny (TypedAny rep x) =
case eqTypeRep (TypeRep @a) rep of
Just HRefl -> x
Nothing ->
error $ "InitOnce: Type mismatch: requested " ++ show (TypeRep @a) ++ ", got " ++ show rep
|
