{-# 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