{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} module Test.Sanity.Discovery (tests) where import Data.Either (fromRight) import Data.Record.Generic import Data.Record.Anon import qualified Data.Record.Anon.Simple as S import qualified Data.Record.Anon.Advanced as A import Test.Tasty import Test.Tasty.HUnit import Test.Infra.Discovery import Test.Infra.DynRecord import Test.Infra.MarkStrictness import qualified Test.Infra.DynRecord.Simple as Dyn.S import qualified Test.Infra.DynRecord.Advanced as Dyn.A {------------------------------------------------------------------------------- Tests proper -------------------------------------------------------------------------------} tests :: TestTree tests = testGroup "Test.Sanity.Discovery" [ testGroup "Simple" [ testCase "inferType" test_simple_inferType , testCase "toLens" test_simple_toLens ] , testGroup "Advanced" [ testCase "inferType" test_advanced_inferType , testCase "toLens" test_advanced_toLens ] ] {------------------------------------------------------------------------------- Tests for the simple API (kind Type) -------------------------------------------------------------------------------} type ExpectedSimple = [ "a" := Int, "c" := Char ] test_simple_inferType :: Assertion test_simple_inferType = case Dyn.S.inferType example1 of Dyn.S.SomeRecord r -> do assertEqual "show" expected $ show r -- The comparison test implies that we are parsing one record, then -- using the result to parse another /in the same shape/ assertEqual "compare" (Right r) $ Dyn.S.toRecord r example2 where expected :: String expected = "ANON {a = 1, b = True, c = 'a'}" test_simple_toLens :: Assertion test_simple_toLens = do assertEqual "get" expectedGet $ show get assertEqual "set" example1' $ set (S.set #c 'b' get) assertEqual "missingField" expectedMissingField . fmap (const ()) $ Dyn.S.toLens (Proxy @ExpectedSimple) exampleMissingField assertEqual "wrongType" expectedWrongType . fmap (const ()) $ Dyn.S.toLens (Proxy @ExpectedSimple) exampleWrongType where get :: S.Record ExpectedSimple set :: S.Record ExpectedSimple -> DynRecord (get, set) = fromRight (error "unexpected error") $ Dyn.S.toLens (Proxy @ExpectedSimple) example1 expectedGet :: String expectedGet = "ANON {a = 1, c = 'a'}" expectedMissingField :: Either NotSubRow () expectedMissingField = Left ["c"] -- TODO: For now we don't get more information in case of a type error expectedWrongType :: Either NotSubRow () expectedWrongType = Left ["c"] {------------------------------------------------------------------------------- Tests for the advanced API (kind other than Type) These follow the same structure as the tests for the simple API. We don't explicitly test the error cases again here ('NotSubRow'), since the projection and parsing machinery is the same for the simple and the advanced case. -------------------------------------------------------------------------------} type ExpectedAdvanced = [ "a" := Strict Int, "c" := Lazy Char ] test_advanced_inferType :: Assertion test_advanced_inferType = case Dyn.A.inferType example1 :: Dyn.A.SomeRecord Boxed of Dyn.A.SomeRecord r -> do assertEqual "show" expected $ show r -- The comparison test implies that we are parsing one record, then -- using the result to parse another /in the same shape/ assertEqual "compare" (Right r) $ Dyn.A.toRecord r example2 where expected :: String expected = "ANON_F {a = 1, b = True, c = 'a'}" test_advanced_toLens :: Assertion test_advanced_toLens = do assertEqual "get" expectedGet $ show get assertEqual "set" example1' $ set (A.set #c (BoxLazy 'b') get) where get :: A.Record Boxed ExpectedAdvanced set :: A.Record Boxed ExpectedAdvanced -> DynRecord (get, set) = fromRight (error "unexpected error") $ Dyn.A.toLens (Proxy @ExpectedAdvanced) example1 expectedGet :: String expectedGet = "ANON_F {a = 1, c = 'a'}" {------------------------------------------------------------------------------- Example 'DynRecord' values These are used both for the simple and the advanced tests (which of course interpret them differently). TODO: We should have a test with some shadowing. TODO: We should not have all fields alphabetical. -------------------------------------------------------------------------------} -- | Main running example example1 :: DynRecord example1 = DynRecord [ ("a", VI 1) , ("b", VB True) , ("c", VC 'a') ] -- | Like 'example1', but one field updated example1' :: DynRecord example1' = DynRecord [ ("a", VI 1) , ("b", VB True) , ("c", VC 'b') ] -- | Equal to 'example1', but with some additional fields -- -- We should be able to parse this according to the type inferred for -- 'example1'. example2 :: DynRecord example2 = DynRecord [ ("a", VI 1) , ("b", VB True) , ("c", VC 'a') , ("d", VI 2) ] -- | Example that does not conform to 'Expected': field missing exampleMissingField :: DynRecord exampleMissingField = DynRecord [ ("a", VI 1) ] -- | Example that does not conform to 'Expected': wrong field type exampleWrongType :: DynRecord exampleWrongType = DynRecord [ ("a", VI 1) , ("b", VB True) , ("c", VB False) ]