Translating linearization functions to Haskell: move a common record type to PGF.Haskell

Move the Haskell representation of the common linearization type {s:T} to the
shared module PGF.Haskell, so that the same overloaded projection function
proj_s can be used for all concrete syntaxes.

1 files changed, 19 insertions, 1 deletions

diff --git a/src/runtime/haskell/PGF/Haskell.hs b/src/runtime/haskell/PGF/Haskell.hs
index 8f5021bfe..e09f6635e 100644
--- a/src/runtime/haskell/PGF/Haskell.hs
+++ b/src/runtime/haskell/PGF/Haskell.hs
@@ -1,10 +1,14 @@
 -- | Auxiliary types and functions for use with grammars translated to Haskell
--- with gf -output-format=haskell -haskell=concrete
+-- with @gf -output-format=haskell -haskell=concrete@
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
 module PGF.Haskell where
+import Control.Applicative((<$>))
 import Data.Char(toUpper)
 import Data.List(isPrefixOf)
 import qualified Data.Map as M
 
+-- ** Concrete syntax
+
 -- | For enumerating parameter values used in tables
 class EnumAll a where enumAll :: [a]
 
@@ -42,3 +46,17 @@ fromStr = from False False
     toUpper1 s     = s
 
     pick alts def r = head ([str|(ps,str)<-alts,any (`isPrefixOf` r) ps]++[def])
+
+-- *** Common record types
+
+-- | Overloaded function to project the @s@ field from any record type
+class Has_s r a | r -> a where proj_s :: r -> a
+
+-- | Haskell representation of the GF record type @{s:t}@
+data R_s t = R_s t deriving (Eq,Ord,Show)
+instance (EnumAll t) => EnumAll (R_s t) where
+    enumAll = (R_s <$> enumAll)
+instance Has_s (R_s t) t where proj_s (R_s t) = t
+
+-- | Coerce from any record type @{...,s:t,...}@ field to the supertype @{s:t}@
+to_R_s r = R_s (proj_s r)