legal: add license `BSD-3-Clause`

[haskell/symantic-parser.git] / src / Language / Haskell / TH / HideName.hs

diff --git a/src/Language/Haskell/TH/HideName.hs b/src/Language/Haskell/TH/HideName.hs
index e3a06af571b3724a4a4e02d50b3114d71dd2e8eb..2ba3c7a2e35d75f831ebb172db207b1631fa0222 100644 (file)
--- a/src/Language/Haskell/TH/HideName.hs
+++ b/src/Language/Haskell/TH/HideName.hs
@@ -1,13 +1,32 @@
+{-# LANGUAGE AllowAmbiguousTypes #-} -- For hideableShow
+-- | This module enables to 'hideName'
+-- to get reproductible dumps of TemplateHaskell slices.
 module Language.Haskell.TH.HideName where
 
+import Data.Bool (Bool(..))
+import Data.Function (id)
 import Data.Functor ((<$>))
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax
 import Prelude (undefined)
 
+-- ** Type 'HideableName'
+-- | Useful on golden unit tests because 'Name's
+-- change often when changing unrelated source code
+-- or even when changing basic GHC or executable flags.
+class HideableName (showNames::Bool) where
+  hideableName :: HideName a => a -> a
+-- | Like 'id'.
+instance HideableName 'True where
+  hideableName = id
+-- | Like 'hideName'.
+instance HideableName 'False where
+  hideableName = hideName
+
+-- * Class 'HideName'
 class HideName a where
   -- | Map all 'Name's to a constant in order to overcome
-  -- cases where reseting 'TH.counter' is not enough
+  -- cases where resetting 'TH.counter' is not enough
   -- to get deterministic 'TH.Name's.
   hideName :: a -> a
 instance HideName Body where
@@ -131,3 +150,5 @@ instance HideName Pat where
   hideName (VarP v) = VarP (hideName v)
   hideName (ViewP e p) = ViewP (hideName e) (hideName p)
   hideName WildP = WildP
+instance HideName a => HideName [a] where
+  hideName = (hideName <$>)