54 lines
2.8 KiB
Haskell
54 lines
2.8 KiB
Haskell
{-# LANGUAGE Safe #-}
|
|
{-# LANGUAGE StandaloneDeriving #-} -- to specify instance contexts
|
|
{-# LANGUAGE UndecidableInstances #-} -- for the instance constraints containing the functor
|
|
{-# LANGUAGE InstanceSigs #-}
|
|
module Language.Scalie.Core.Expression (Expression(..)) where
|
|
|
|
import Prelude (Integer, Integral (div))
|
|
import Data.Kind (Type)
|
|
import Text.Show (Show)
|
|
import Text.Read (Read)
|
|
import Data.Eq (Eq)
|
|
import Data.Ratio (Rational)
|
|
import Data.Text (Text)
|
|
import Data.List.NonEmpty (NonEmpty)
|
|
import Language.Scalie.Core.Expression.PatternMatchCase (PatternMatchCase)
|
|
import Test.QuickCheck (Arbitrary (arbitrary), oneof, UnicodeString (getUnicodeString), NonEmptyList (getNonEmpty))
|
|
import Test.QuickCheck.Gen (Gen)
|
|
import Data.Functor ((<$>), Functor)
|
|
import Control.Category ((.))
|
|
import Data.Text qualified as Text
|
|
import Language.Scalie.Core.Expression.VariableIdentifier (VariableIdentifier)
|
|
import Control.Applicative ((<*>))
|
|
import Data.List.NonEmpty qualified as NonEmpty
|
|
import Test.QuickCheck qualified as Gen
|
|
|
|
type Expression :: (Type -> Type) -> Type
|
|
type role Expression nominal
|
|
data Expression f
|
|
= RawInt (f Integer)
|
|
| RawRational (f Rational)
|
|
| RawString (f Text)
|
|
| PatternMatch (f (NonEmpty (PatternMatchCase f)))
|
|
| Lambda (f VariableIdentifier) (f (Expression f))
|
|
|
|
-- to me, this looks incredibly dangerous, because of Show (f (Expression f)) => Show (Expression f)
|
|
-- let's hope UndecidableInstances won't have the compiler diverge
|
|
deriving stock instance (Show (f Integer), Show (f Rational), Show (f Text), Show (f (NonEmpty (PatternMatchCase f))), Show (f VariableIdentifier), Show (f (Expression f))) => Show (Expression f)
|
|
deriving stock instance (Read (f Integer), Read (f Rational), Read (f Text), Read (f (NonEmpty (PatternMatchCase f))), Read (f VariableIdentifier), Read (f (Expression f))) => Read (Expression f)
|
|
deriving stock instance (Eq (f Integer), Eq (f Rational), Eq (f Text), Eq (f (NonEmpty (PatternMatchCase f))), Eq (f VariableIdentifier), Eq (f (Expression f))) => Eq (Expression f)
|
|
|
|
instance (Arbitrary (f Integer), Arbitrary (f Rational), Arbitrary (f UnicodeString), Functor f, Arbitrary (f (Expression f)), Arbitrary (f VariableIdentifier), Arbitrary (f (NonEmptyList (PatternMatchCase f))) ) => Arbitrary (Expression f) where
|
|
arbitrary :: Gen (Expression f)
|
|
arbitrary = oneof
|
|
[ RawInt <$> arbitrary
|
|
, RawRational <$> arbitrary
|
|
, RawString . (Text.pack . getUnicodeString <$>) <$> arbitrary
|
|
, PatternMatch . (NonEmpty.fromList . getNonEmpty <$>) <$> Gen.scale (`div` 2) arbitrary -- scale the recursive case down
|
|
, Lambda <$> arbitrary <*> Gen.scale (`div` 2) arbitrary -- scale the recursive case down
|
|
]
|
|
|
|
-- >>> import Test.QuickCheck
|
|
-- >>> import Data.Functor.Identity
|
|
-- >>> sample (arbitrary :: Gen (Expression Identity))
|
|
|