beam-th-0.1.0.2: test/Test.hs

{-# LANGUAGE TemplateHaskell #-}
module Main where

import Data.Char (isDigit)
import Language.Haskell.TH
import Test.Tasty
import Test.Tasty.Runners
import Test.Tasty.HUnit

import Database.Beam
import Database.Beam.TH

import TestData

main :: IO ()
main = defaultMainWithIngredients [ consoleTestReporter ] tests

-- To check for equality, remove the uniqueness suffixes (x_12345678) added by the renamer
pruneUniqueVars :: String -> String
pruneUniqueVars = go
  where
    go [] = []
    go (x:xs) = case x of
      '_' -> go . dropWhile isDigit $ xs
      _ -> x : go xs

expectUser, expectOrder :: String
expectUser = "[TySynD User [] (AppT (ConT UserT) (ConT Data.Functor.Identity.Identity)),StandaloneDerivD [] (AppT (ConT GHC.Show.Show) (ConT User)),InstanceD Nothing [] (AppT (ConT Database.Beam.Schema.Tables.Table) (ConT UserT)) [DataInstD [] Database.Beam.Schema.Tables.PrimaryKey [ConT UserT,VarT f] Nothing [NormalC UserId [(Bang NoSourceUnpackedness NoSourceStrictness,AppT (AppT (ConT Database.Beam.Schema.Tables.Columnar) (VarT f)) (ConT Data.Text.Internal.Text))]] [ConT GHC.Generics.Generic],FunD Database.Beam.Schema.Tables.primaryKey [Clause [VarP x] (NormalB (AppE (ConE UserId) (AppE (VarE TestData.userName) (VarE x)))) []]],TySynD UserId [KindedTV f (AppT (AppT ArrowT StarT) StarT)] (AppT (AppT (ConT Database.Beam.Schema.Tables.PrimaryKey) (ConT UserT)) (VarT f)),TySynD UserId' [] (AppT (ConT UserId) (ConT Data.Functor.Identity.Identity)),StandaloneDerivD [] (AppT (ConT GHC.Show.Show) (ConT UserId')),ValD (ConP User [ConP Database.Beam.Schema.Tables.LensFor [VarP userNameC]]) (NormalB (VarE Database.Beam.Schema.Lenses.tableConfigLenses)) []]"
expectOrder = "[TySynD Order [] (AppT (ConT OrderT) (ConT Data.Functor.Identity.Identity)),StandaloneDerivD [] (AppT (ConT GHC.Show.Show) (ConT Order)),InstanceD Nothing [] (AppT (ConT Database.Beam.Schema.Tables.Table) (ConT OrderT)) [DataInstD [] Database.Beam.Schema.Tables.PrimaryKey [ConT OrderT,VarT f] Nothing [NormalC OrderId [(Bang NoSourceUnpackedness NoSourceStrictness,AppT (AppT (ConT Database.Beam.Schema.Tables.Columnar) (VarT f)) (ConT Data.Text.Internal.Text))]] [ConT GHC.Generics.Generic],FunD Database.Beam.Schema.Tables.primaryKey [Clause [VarP x] (NormalB (AppE (ConE OrderId) (AppE (VarE TestData.orderItem) (VarE x)))) []]],TySynD OrderId [KindedTV f (AppT (AppT ArrowT StarT) StarT)] (AppT (AppT (ConT Database.Beam.Schema.Tables.PrimaryKey) (ConT OrderT)) (VarT f)),TySynD OrderId' [] (AppT (ConT OrderId) (ConT Data.Functor.Identity.Identity)),StandaloneDerivD [] (AppT (ConT GHC.Show.Show) (ConT OrderId')),SigD orderIssuerC (AppT (AppT (ConT Lens.Micro.Type.Lens') (AppT (ConT OrderT) (AppT (ConT Database.Beam.Schema.Tables.TableField) (ConT OrderT)))) (AppT (AppT (ConT Database.Beam.Schema.Tables.TableField) (ConT OrderT)) WildCardT)),ValD (ConP Order [ConP Database.Beam.Schema.Tables.LensFor [VarP orderItemC],ConP UserId [ConP Database.Beam.Schema.Tables.LensFor [VarP orderIssuerC]],ConP Database.Beam.Schema.Tables.LensFor [VarP orderAmountC]]) (NormalB (VarE Database.Beam.Schema.Lenses.tableConfigLenses)) []]"

tests :: TestTree
tests = testGroup "Template Haskell boilerpate generation" [ testGroup "Compare Output against Golden Value" [
  testCase "makeTable  ''UserT  'userName" $ do
      let decs = $(stringE . show =<< makeTable ''UserT 'userName)
      assertEqual "" expectUser (pruneUniqueVars decs),
  testCase "makeTable' ''UserT" $ do
      let decs = $(stringE . show =<< makeTable' ''UserT)
      assertEqual "" expectUser (pruneUniqueVars decs),
  testCase "makeTable  ''OrderT 'orderItem" $ do
      let decs = $(stringE . show =<< makeTable ''OrderT 'orderItem)
      assertEqual "" expectOrder (pruneUniqueVars decs),
  testCase "makeTable' ''OrderT" $ do
      let decs = $(stringE . show =<< makeTable' ''OrderT)
      assertEqual "" expectOrder (pruneUniqueVars decs)
           ]]