RegistrySpec.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

module Test.Data.Registry.Internal.RegistrySpec where

import           Data.Dynamic
import           Data.Registry.Internal.Registry
import           Data.Registry.Internal.Stack
import           Data.Registry.Internal.Types
import           Protolude                        as P hiding (show)
import           Test.Data.Registry.Internal.Gens
import           Test.Tasty.Extensions

test_find_no_value = prop "no value can be found if nothing is stored in the registry" $ do
  value  <- forAll $ gen @Int

  (fromValueDyn <$> findValue (valueDynTypeRep (createValue value)) mempty mempty mempty) === (Nothing :: Maybe (Maybe Int))

test_find_value = prop "find a value in a list of values when there are no specializations" $ do
  (value, values) <- forAll genValues

  (fromValueDyn <$> findValue (valueDynTypeRep (createValue value)) mempty mempty values) === Just (Just value)

test_find_specialized_value = prop "find a value in a list of values when there is a specialization for a given context" $ do
  value <- forAll $ gen @Int
  values <- forAll $ gen @Values
  let listTypeRep = dynTypeRep . toDyn $ [value]
  let context = Context [listTypeRep] -- when trying to build a [Int]
  let specializations = Specializations [Specialization (pure listTypeRep) (createValue value)]

  (fromValueDyn <$> findValue (valueDynTypeRep (createValue value)) context specializations values) === Just (Just value)

test_find_no_constructor = prop "no constructor can be found if nothing is stored in the registry" $ do
  value  <- forAll $ gen @Int

  (fromDynamic . funDyn <$> findConstructor (valueDynTypeRep (createValue value)) mempty) === (Nothing :: Maybe (Maybe Int))

test_find_contructor = prop "find a constructor in a list of constructors" $ do
  (TextToInt function) <- forAll $ gen @TextToInt
  functions <- forAll $ (createFunction function `addFunction`) <$> gen @Functions

  let outputType = dynTypeRep (toDyn (1 :: Int))

  (fmap TextToInt <$> (fromDynamic . funDyn <$> findConstructor outputType functions)) ===
    Just (Just (TextToInt function))

test_store_value_no_modifiers = prop "a value can be stored in the list of values" $ do
  (value, values) <- forAll genValues

  let createdValue = createValue value
  let (Right stored) = execStackWithValues values (storeValue mempty createdValue)

  let found = findValue (dynTypeRep . toDyn $ value) mempty mempty stored
  (fromValueDyn <$> found) === Just (Just value)

test_store_value_with_modifiers = prop "a value can be stored in the list of values but modified beforehand" $ do
  (value, values) <- forAll genValues

  let valueType = dynTypeRep . toDyn $ value
  let modifiers = Modifiers [(valueType, createFunction (\(i:: Int) -> i + 1))]
  let createdValue = createValue value
  let (Right stored) = execStackWithValues values (storeValue modifiers createdValue)

  let found = findValue valueType mempty mempty stored
  (fromValueDyn <$> found) === Just (Just (value + 1))

test_store_value_ordered_modifiers = prop "modifiers are applied in a LIFO order" $ do
  (value, values) <- forAll genValues

  let valueType = dynTypeRep . toDyn $ value
  let modifiers = Modifiers [
         (valueType, createFunction (\(i:: Int) -> i * 2))
       , (valueType, createFunction (\(i:: Int) -> i + 1))
       ]
  let createdValue = createValue value
  let (Right stored) = execStackWithValues values (storeValue modifiers createdValue)

  let found = findValue valueType mempty mempty stored
  (fromValueDyn <$> found) === Just (Just ((value * 2) + 1))

-- *

fromValueDyn = fromDynamic . valueDyn

----
tests = $(testGroupGenerator)