
As per user guide one of the restriction in annotating value is . The binder being annotated must be declared in the current module But when I use TH to generate the annotation above restriction is not respected. Below is the minimal test case to reproduce the issue ---- Ann.hs {-# LANGUAGE TemplateHaskell #-} module Ann where import Language.Haskell.TH -- {-# Ann id "Orphan Ann for id" #-} -- *Rightly produces error "Not in scope: ‘id’"* $(pragAnnD (ValueAnnotation 'id) [|"Orphan Ann for id"|] >>= return . return) --* Ideally this should have produced same error as above* ---- End of Ann.hs ---- Main.hs {-# LANGUAGE TemplateHaskell #-} module Main where import Ann () import Language.Haskell.TH ann :: [String] ann = $((reifyAnnotations (AnnLookupName 'id) :: Q [String]) >>= (\anns -> [|anns|])) --err = 'a' && True -- Uncomment to introduce compile error main :: IO () main = print ann ---- End of Main.hs Also there is another bug in reifying the Orphan Annotations. In the above example Main.hs depends on Ann.hs which defines Annotation for `id` When Main.hs compiles fine in the first go, its is able to retrieve the annotation for `id` Instead, if Ann.hs compiled successfully and Main.hs failed to compile and when you later fix the Main.hs error, it is not able to retrieve that annotation without recompiling Ann.hs Regards, Magesh B