[Template-haskell] tuple (Int) == or != Int ?

Marc Weber marco-oweber at gmx.de
Sun Jun 29 17:01:46 EDT 2008


Does ghc make difference beteen a tuple "(Int)" and a no tuple "Int" ?
I'm confused about this error:

-- packages: template-haskell
{-# OPTIONS_GHC -XTemplateHaskell #-}
module Main where 
import Language.Haskell.TH
import System.IO
import Language.Haskell.TH.Syntax

class PrimaryKey tableRow pk | tableRow -> pk where pk :: tableRow -> pk

data Row = Row {
  idV :: Int
  , b :: String
}

$( do let pks = ["idV"]
      row <- newName "row"
      {-
      || instance PrimaryKey Row ((GHC.Base.Int))
      ||     where pk row_0 = (idV row_0)
      test.hs|15 col 3 error| 
      ||     Couldn't match expected type `(Int)' against inferred type `Int'
      ||     In the expression: idV row[a1eY]
      ||     In the definition of `pk': pk row[a1eY] = idV row[a1eY]
      ||     In the definition for method `pk'
      -}
      i <- instanceD (cxt []) (appT (appT (conT $ mkName $ "PrimaryKey") (conT $ ''Row)) (appT (tupleT (length pks)) (conT ''Int)))
              [funD  (mkName "pk") [clause [varP row] (normalB (tupE (map (\k -> (appE (varE $ mkName $ k) (varE row))) pks))) []]]
      runIO $ do putStrLn $ pprint $ i
                 hFlush stdout
      return [i]
 )
main = return ()

Marc Weber


More information about the template-haskell mailing list