it-has-0.1.0.0: test/Spec.hs

{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia        #-}
{-# LANGUAGE TemplateHaskell    #-}

import           Control.Monad (void)
import           Data.Has
import           GHC.Generics    (Generic)
import           Test.QuickCheck (Arbitrary, quickCheckAll)

newtype LogConfig =
  LogConfig String
  deriving (Show, Eq)
  deriving (Arbitrary) via (String)

newtype SomeUrl =
  SomeUrl String
  deriving (Show, Eq)
  deriving (Arbitrary) via (String)

newtype ConnectionString =
  ConnectionString String
  deriving (Show, Eq)
  deriving (Arbitrary) via (String)

newtype DatabaseConfig =
  DatabaseConfig String
  deriving (Show, Eq)
  deriving (Arbitrary) via (String)

data SomeConfig =
  SomeConfig
    { someConfigLogConfig      :: LogConfig
    , someConfigDatabaseConfig :: DatabaseConfig
    , someConfigSomeUrl        :: SomeUrl
    } deriving
      ( Eq
      , Generic
      , Has LogConfig
      , Has DatabaseConfig
      , Has SomeUrl )

newtype ErrorText =
  ErrorText String
  deriving (Show, Eq)
  deriving (Arbitrary) via (String)

data Error =
  ValidationError ErrorText |
  Unauthorized ErrorText
  deriving (Generic, Has ErrorText)

prop_returnsSetValuesForRecord :: LogConfig -> DatabaseConfig -> SomeUrl -> Bool
prop_returnsSetValuesForRecord logConfig dbConfig someUrl =
  let config = SomeConfig logConfig dbConfig someUrl
  in getter config == logConfig &&
     getter config == dbConfig &&
     getter config == someUrl

prop_setsCorrectValues :: (LogConfig, DatabaseConfig, SomeUrl) -> (LogConfig, DatabaseConfig, SomeUrl) -> Bool
prop_setsCorrectValues (logConfig, dbConfig, someUrl) (newLogConfig, newDbConfig, newSomeUrl) =
  let config = SomeConfig logConfig dbConfig someUrl
      expectedConfig = SomeConfig newLogConfig newDbConfig newSomeUrl
      updatedConfig = modifier (const newLogConfig) . modifier (const newDbConfig) . modifier (const newSomeUrl) $ config
  in updatedConfig == expectedConfig

prop_returnsForcedFieldsForSumType :: ErrorText -> ErrorText -> Bool
prop_returnsForcedFieldsForSumType firstErrorText secondErrorText =
  let firstError = ValidationError firstErrorText
      secondError = Unauthorized secondErrorText
  in getter firstError == firstErrorText &&
     getter secondError == secondErrorText

return []

main :: IO ()
main = void runTests

runTests :: IO Bool
runTests = $quickCheckAll