OverloadedRecordUpdate.hs

{-# LANGUAGE CPP #-}

#if __GLASGOW_HASKELL__ < 902

module Test.Record.Sanity.OverloadedRecordUpdate (tests) where

import Test.Tasty
import Test.Tasty.HUnit

tests :: TestTree
tests =
    testCaseInfo "Test.Record.Sanity.OverloadedRecordUpdate" $
      return "Skipped for ghc < 9.2"

#else

{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE DuplicateRecordFields  #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE KindSignatures         #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE OverloadedRecordDot    #-}
{-# LANGUAGE OverloadedRecordUpdate #-}
{-# LANGUAGE RebindableSyntax       #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}

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

module Test.Record.Sanity.OverloadedRecordUpdate (tests) where

import Test.Tasty
import Test.Tasty.HUnit

import Data.Record.Generic (Rep)
import Data.Record.Generic.Lens.VL
import Data.Record.Overloading
import Data.Record.Plugin

tests :: TestTree
tests = testGroup "Test.Record.Sanity.OverloadedRecordUpdate" [
      testGroup "get" [
          testCase "simple" test_get_simple
        , testCase "nested" test_get_nested
        ]
    , testGroup "set" [
          testCase "simple" test_set_simple
        , testCase "nested" test_set_nested
        ]
    ]

{-------------------------------------------------------------------------------
  Example records
-------------------------------------------------------------------------------}

{-# ANN type Person largeRecord #-}
data Person = Person {
      name :: String
    , age  :: Int
    }
  deriving (Show, Eq)

{-# ANN type Company largeRecord #-}
data Company = Company {
      name :: String
    , ceo  :: Person
    }
  deriving (Show, Eq)

person :: Person
person = Person {
      name = "John Doe"
    , age  = 30
    }

company :: Company
company = Company {
      name = "Sprockets Inc"
    , ceo  = person
    }

{-------------------------------------------------------------------------------
  Sanity check we really are dealing with a large-record here
-------------------------------------------------------------------------------}

_lensesPerson :: Rep (SimpleRecordLens Person) Person
_lensesPerson = lensesForSimpleRecord

_lensesCompany :: Rep (SimpleRecordLens Company) Company
_lensesCompany = lensesForSimpleRecord

{-------------------------------------------------------------------------------
  Get fields
-------------------------------------------------------------------------------}

test_get_simple :: Assertion
test_get_simple = assertEqual "" 30 $ person.age

test_get_nested :: Assertion
test_get_nested = assertEqual "" 30 $ company.ceo.age

{-------------------------------------------------------------------------------
  Set fields
-------------------------------------------------------------------------------}

test_set_simple :: Assertion
test_set_simple =
    assertEqual "" expected $
      person{age = 31}
  where
    expected :: Person
    expected = Person {
          name = "John Doe"
        , age  = 31
        }

test_set_nested :: Assertion
test_set_nested =
    assertEqual "" expected $
      company{ceo.age = 31}
  where
    expected :: Company
    expected = Company {
          name = "Sprockets Inc"
        , ceo  = Person {
              name = "John Doe"
            , age  = 31
            }
        }

#endif