summaryrefslogtreecommitdiff
path: root/src/InitOnce/Types.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/InitOnce/Types.hs')
-rw-r--r--src/InitOnce/Types.hs30
1 files changed, 30 insertions, 0 deletions
diff --git a/src/InitOnce/Types.hs b/src/InitOnce/Types.hs
new file mode 100644
index 0000000..05d5c9c
--- /dev/null
+++ b/src/InitOnce/Types.hs
@@ -0,0 +1,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