{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
module Test.StateMachine.Types.References
( Var(Var)
, Symbolic(Symbolic)
, Concrete(Concrete)
, Reference(Reference)
, reference
, concrete
, opaque
, Opaque(Opaque)
, unOpaque
)
where
import Data.Functor.Classes
(Eq1, Ord1, Show1, compare1, eq1, liftCompare,
liftEq, liftShowsPrec, showsPrec1)
import Data.TreeDiff
(Expr(App), ToExpr, toExpr)
import Data.Typeable
(Typeable)
import GHC.Generics
(Generic)
import Prelude
import qualified Test.StateMachine.Types.Rank2 as Rank2
newtype Var = Var Int
deriving stock (Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c== :: Var -> Var -> Bool
Eq, Eq Var
Eq Var
-> (Var -> Var -> Ordering)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Var)
-> (Var -> Var -> Var)
-> Ord Var
Var -> Var -> Bool
Var -> Var -> Ordering
Var -> Var -> Var
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Var -> Var -> Var
$cmin :: Var -> Var -> Var
max :: Var -> Var -> Var
$cmax :: Var -> Var -> Var
>= :: Var -> Var -> Bool
$c>= :: Var -> Var -> Bool
> :: Var -> Var -> Bool
$c> :: Var -> Var -> Bool
<= :: Var -> Var -> Bool
$c<= :: Var -> Var -> Bool
< :: Var -> Var -> Bool
$c< :: Var -> Var -> Bool
compare :: Var -> Var -> Ordering
$ccompare :: Var -> Var -> Ordering
$cp1Ord :: Eq Var
Ord, Int -> Var -> ShowS
[Var] -> ShowS
Var -> String
(Int -> Var -> ShowS)
-> (Var -> String) -> ([Var] -> ShowS) -> Show Var
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Var] -> ShowS
$cshowList :: [Var] -> ShowS
show :: Var -> String
$cshow :: Var -> String
showsPrec :: Int -> Var -> ShowS
$cshowsPrec :: Int -> Var -> ShowS
Show, (forall x. Var -> Rep Var x)
-> (forall x. Rep Var x -> Var) -> Generic Var
forall x. Rep Var x -> Var
forall x. Var -> Rep Var x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Var x -> Var
$cfrom :: forall x. Var -> Rep Var x
Generic, ReadPrec [Var]
ReadPrec Var
Int -> ReadS Var
ReadS [Var]
(Int -> ReadS Var)
-> ReadS [Var] -> ReadPrec Var -> ReadPrec [Var] -> Read Var
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Var]
$creadListPrec :: ReadPrec [Var]
readPrec :: ReadPrec Var
$creadPrec :: ReadPrec Var
readList :: ReadS [Var]
$creadList :: ReadS [Var]
readsPrec :: Int -> ReadS Var
$creadsPrec :: Int -> ReadS Var
Read)
deriving newtype ([Var] -> Expr
Var -> Expr
(Var -> Expr) -> ([Var] -> Expr) -> ToExpr Var
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
listToExpr :: [Var] -> Expr
$clistToExpr :: [Var] -> Expr
toExpr :: Var -> Expr
$ctoExpr :: Var -> Expr
ToExpr)
data Symbolic a where
Symbolic :: Typeable a => Var -> Symbolic a
deriving stock instance Show (Symbolic a)
deriving stock instance Typeable a => Read (Symbolic a)
deriving stock instance Eq (Symbolic a)
deriving stock instance Ord (Symbolic a)
instance Show1 Symbolic where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Symbolic a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ Int
p (Symbolic Var
x) =
Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"Symbolic " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> Var -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Var
x
where
appPrec :: Int
appPrec = Int
10
instance ToExpr a => ToExpr (Symbolic a) where
toExpr :: Symbolic a -> Expr
toExpr (Symbolic Var
x) = Var -> Expr
forall a. ToExpr a => a -> Expr
toExpr Var
x
instance Eq1 Symbolic where
liftEq :: (a -> b -> Bool) -> Symbolic a -> Symbolic b -> Bool
liftEq a -> b -> Bool
_ (Symbolic Var
x) (Symbolic Var
y) = Var
x Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
y
instance Ord1 Symbolic where
liftCompare :: (a -> b -> Ordering) -> Symbolic a -> Symbolic b -> Ordering
liftCompare a -> b -> Ordering
_ (Symbolic Var
x) (Symbolic Var
y) = Var -> Var -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Var
x Var
y
data Concrete a where
Concrete :: Typeable a => a -> Concrete a
deriving stock instance Show a => Show (Concrete a)
instance Show1 Concrete where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Concrete a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
p (Concrete a
x) =
Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"Concrete " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> a -> ShowS
sp (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x
where
appPrec :: Int
appPrec = Int
10
instance Eq1 Concrete where
liftEq :: (a -> b -> Bool) -> Concrete a -> Concrete b -> Bool
liftEq a -> b -> Bool
eq (Concrete a
x) (Concrete b
y) = a -> b -> Bool
eq a
x b
y
instance Ord1 Concrete where
liftCompare :: (a -> b -> Ordering) -> Concrete a -> Concrete b -> Ordering
liftCompare a -> b -> Ordering
comp (Concrete a
x) (Concrete b
y) = a -> b -> Ordering
comp a
x b
y
instance ToExpr a => ToExpr (Concrete a) where
toExpr :: Concrete a -> Expr
toExpr (Concrete a
x) = a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x
newtype Reference a r = Reference (r a)
deriving stock (forall x. Reference a r -> Rep (Reference a r) x)
-> (forall x. Rep (Reference a r) x -> Reference a r)
-> Generic (Reference a r)
forall x. Rep (Reference a r) x -> Reference a r
forall x. Reference a r -> Rep (Reference a r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a (r :: * -> *) x. Rep (Reference a r) x -> Reference a r
forall a (r :: * -> *) x. Reference a r -> Rep (Reference a r) x
$cto :: forall a (r :: * -> *) x. Rep (Reference a r) x -> Reference a r
$cfrom :: forall a (r :: * -> *) x. Reference a r -> Rep (Reference a r) x
Generic
deriving stock instance Typeable a => Read (Reference a Symbolic)
instance ToExpr (r a) => ToExpr (Reference a r)
instance Rank2.Functor (Reference a) where
fmap :: (forall x. p x -> q x) -> Reference a p -> Reference a q
fmap forall x. p x -> q x
f (Reference p a
r) = q a -> Reference a q
forall a (r :: * -> *). r a -> Reference a r
Reference (p a -> q a
forall x. p x -> q x
f p a
r)
instance Rank2.Foldable (Reference a) where
foldMap :: (forall x. p x -> m) -> Reference a p -> m
foldMap forall x. p x -> m
f (Reference p a
r) = p a -> m
forall x. p x -> m
f p a
r
instance Rank2.Traversable (Reference a) where
traverse :: (forall a. p a -> f (q a)) -> Reference a p -> f (Reference a q)
traverse forall a. p a -> f (q a)
f (Reference p a
r) = q a -> Reference a q
forall a (r :: * -> *). r a -> Reference a r
Reference (q a -> Reference a q) -> f (q a) -> f (Reference a q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a -> f (q a)
forall a. p a -> f (q a)
f p a
r
instance (Eq a, Eq1 r) => Eq (Reference a r) where
Reference r a
x == :: Reference a r -> Reference a r -> Bool
== Reference r a
y = r a -> r a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1 r a
x r a
y
instance (Ord a, Ord1 r) => Ord (Reference a r) where
compare :: Reference a r -> Reference a r -> Ordering
compare (Reference r a
x) (Reference r a
y) = r a -> r a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 r a
x r a
y
instance (Show1 r, Show a) => Show (Reference a r) where
showsPrec :: Int -> Reference a r -> ShowS
showsPrec Int
p (Reference r a
v) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"Reference " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> r a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
p r a
v
where
appPrec :: Int
appPrec = Int
10
reference :: Typeable a => a -> Reference a Concrete
reference :: a -> Reference a Concrete
reference = Concrete a -> Reference a Concrete
forall a (r :: * -> *). r a -> Reference a r
Reference (Concrete a -> Reference a Concrete)
-> (a -> Concrete a) -> a -> Reference a Concrete
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concrete a
forall a. Typeable a => a -> Concrete a
Concrete
concrete :: Reference a Concrete -> a
concrete :: Reference a Concrete -> a
concrete (Reference (Concrete a
x)) = a
x
opaque :: Reference (Opaque a) Concrete -> a
opaque :: Reference (Opaque a) Concrete -> a
opaque (Reference (Concrete (Opaque a
x))) = a
x
newtype Opaque a = Opaque
{ Opaque a -> a
unOpaque :: a }
deriving stock (Opaque a -> Opaque a -> Bool
(Opaque a -> Opaque a -> Bool)
-> (Opaque a -> Opaque a -> Bool) -> Eq (Opaque a)
forall a. Eq a => Opaque a -> Opaque a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Opaque a -> Opaque a -> Bool
$c/= :: forall a. Eq a => Opaque a -> Opaque a -> Bool
== :: Opaque a -> Opaque a -> Bool
$c== :: forall a. Eq a => Opaque a -> Opaque a -> Bool
Eq, Eq (Opaque a)
Eq (Opaque a)
-> (Opaque a -> Opaque a -> Ordering)
-> (Opaque a -> Opaque a -> Bool)
-> (Opaque a -> Opaque a -> Bool)
-> (Opaque a -> Opaque a -> Bool)
-> (Opaque a -> Opaque a -> Bool)
-> (Opaque a -> Opaque a -> Opaque a)
-> (Opaque a -> Opaque a -> Opaque a)
-> Ord (Opaque a)
Opaque a -> Opaque a -> Bool
Opaque a -> Opaque a -> Ordering
Opaque a -> Opaque a -> Opaque a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Opaque a)
forall a. Ord a => Opaque a -> Opaque a -> Bool
forall a. Ord a => Opaque a -> Opaque a -> Ordering
forall a. Ord a => Opaque a -> Opaque a -> Opaque a
min :: Opaque a -> Opaque a -> Opaque a
$cmin :: forall a. Ord a => Opaque a -> Opaque a -> Opaque a
max :: Opaque a -> Opaque a -> Opaque a
$cmax :: forall a. Ord a => Opaque a -> Opaque a -> Opaque a
>= :: Opaque a -> Opaque a -> Bool
$c>= :: forall a. Ord a => Opaque a -> Opaque a -> Bool
> :: Opaque a -> Opaque a -> Bool
$c> :: forall a. Ord a => Opaque a -> Opaque a -> Bool
<= :: Opaque a -> Opaque a -> Bool
$c<= :: forall a. Ord a => Opaque a -> Opaque a -> Bool
< :: Opaque a -> Opaque a -> Bool
$c< :: forall a. Ord a => Opaque a -> Opaque a -> Bool
compare :: Opaque a -> Opaque a -> Ordering
$ccompare :: forall a. Ord a => Opaque a -> Opaque a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Opaque a)
Ord)
instance Show (Opaque a) where
showsPrec :: Int -> Opaque a -> ShowS
showsPrec Int
_ (Opaque a
_) = String -> ShowS
showString String
"Opaque"
instance ToExpr (Opaque a) where
toExpr :: Opaque a -> Expr
toExpr Opaque a
_ = String -> [Expr] -> Expr
App String
"Opaque" []