HooksBroken.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Unsafe.Coerce
import Data.List ( find )
import Data.Typeable

data Hook = forall a. Hook TypeRep a

hasTag :: Typeable a => Hook -> a -> Bool
hasTag (Hook t _) t' = t == typeOf t'

data Foo = Foo deriving Typeable
data Bar = Bar deriving Typeable

type family HookType a
type instance HookType Foo = Int -> Int
type instance HookType Bar = Bool -> Bool

makeHookMaker :: forall a. Typeable a => a -> (HookType a -> Hook, [Hook] -> Maybe (HookType a))
makeHookMaker tag =
  (\h -> Hook (typeOf tag) h,
   \hs ->
     case find (`hasTag` tag) hs of
       Nothing -> Nothing
       Just (Hook _ any) -> Just (unsafeCoerce any :: HookType a))

(makeFoo :: (Int -> Int) -> Hook, lookupFoo) = makeHookMaker Foo
(makeBar :: (Bool -> Bool) -> Hook, lookupBar) = makeHookMaker Bar


test =
  let h1 = makeFoo (+3)
      Just h1' = lookupFoo [h1]
      h2 = makeBar not
      Just h2' = lookupBar [h1,h2]
  in
   (h1' 4, h2' False)

main = print test