RecordLens.hs

{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TypeOperators    #-}

{-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-}

module Test.Sanity.RecordLens (tests) where

import Test.Tasty
import Test.Tasty.HUnit

import Data.Record.Anon
import Data.Record.Anon.Advanced (Record)
import qualified Data.Record.Anon.Advanced as Anon

tests :: TestTree
tests = testGroup "Test.Sanity.RecordLens" [
      testGroup "Isomorphic projections" [
          testCase "id"      test_id
        , testCase "reorder" test_reorder
        , testCase "merge"   test_merge
        ]
    , testGroup "General lenses" [
          testCase "lens" test_lens
        ]
    ]

{-------------------------------------------------------------------------------
  Example values
-------------------------------------------------------------------------------}

recordA :: Record I [ "a" := Bool, "b" := Char, "c" := Int ]
recordA =
      Anon.insert #a (I True)
    $ Anon.insert #b (I 'a')
    $ Anon.insert #c (I 1)
    $ Anon.empty

recordA' :: Record I [ "b" := Char, "a" := Bool, "c" := Int ]
recordA' =
      Anon.insert #b (I 'a')
    $ Anon.insert #a (I True)
    $ Anon.insert #c (I 1)
    $ Anon.empty

recordWithMerge :: Record I (Merge '[ "a" := Bool ] [ "b" := Char, "c" := Int ])
recordWithMerge =
    Anon.merge
      ( Anon.insert #a (I True)
      $ Anon.empty
      )
      ( Anon.insert #b (I 'a')
      $ Anon.insert #c (I 1)
      $ Anon.empty
      )

recordB :: Record I [ "c" := Int, "b" := Char ]
recordB =
      Anon.insert #c (I 1)
    $ Anon.insert #b (I 'a')
    $ Anon.empty

{-------------------------------------------------------------------------------
  Tests for isomorphic projections
-------------------------------------------------------------------------------}

test_id :: Assertion
test_id = assertEqual "" recordA $ Anon.project recordA

test_reorder :: Assertion
test_reorder = assertEqual "" recordA' $ Anon.project recordA

test_merge :: Assertion
test_merge = assertEqual "" recordA $ Anon.project recordWithMerge

{-------------------------------------------------------------------------------
  Test for more general lenses
-------------------------------------------------------------------------------}

test_lens :: Assertion
test_lens = do
    let (getter, setter) = Anon.lens recordA
    assertEqual "get" recordB $
      getter
    assertEqual "set" (Anon.set #c (I 2) recordA) $
      setter (Anon.set #c (I 2) recordB)