model-0.4: test/Test/Data.hs
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-
A collection of data types used for testing.
-}
module Test.Data where
import Data.Data
import Data.Int
import Data.Word
import GHC.Generics
import qualified Test.Data2 as D2
import Test.Tasty.QuickCheck
data Void deriving Generic
data X = X X deriving Generic
data Unit = Unit deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Un = Un {un::Bool} deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data D2 = D2 Bool N deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data D4 = D4 Bool N Unit N3 deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- Enumeration
data N3 = N1 | N2 | N3
deriving (Eq, Ord, Read, Show, Typeable, Data, Generic,Enum)
data N = One
| Two
| Three
| Four
| Five
deriving (Eq, Ord, Read, Show, Typeable, Data, Generic, Enum)
-- toForestD :: Forest a -> ForestD (Tr2 a)
-- toForestD (Forest lt) = undefined -- Forest2 (ForestD (map (\t -> let Tr2 tt = treeConv t in tt) . toList $ lt))
-- toForestD (Forest lt) = undefined -- Forest2 (ForestD (map (\t -> let Tr2 tt = treeConv t in tt) . toList $ lt))
toForest2 :: Forest a -> Forest2 a
toForest2 (Forest f) = Forest2 (ForestD $ fmap toTr f)
toTr :: Tr a -> TrD (Forest2 a) a
toTr (Tr a f) = TrD a (toForest2 f)
toTr2 :: Tr a -> Tr2 a
toTr2 (Tr a (Forest f)) = Tr2 (TrD a (ForestD $ fmap toTr2 f))
-- tying the recursive knot, equivalent to Forest/Tree
data Forest2 a = Forest2 (ForestD (TrD (Forest2 a) a)) deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Tr2 a = Tr2 (TrD (ForestD (Tr2 a)) a) deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- First-order non mutually recursive
data ForestD t = ForestD (List t) deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data TrD f a = TrD a f deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- Explicit mutually recursive
data Forest a = Forest (List (Tr a)) deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Tr a = Tr a (Forest a) deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Words = Words Word8 Word16 Word32 Word64
deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Ints = Ints Int8 Int16 Int32 Int64
deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- non-recursive data type
data Various = V1 (Maybe Bool)
-- | V2 Bool (Either Bool (Maybe Bool)) (N,N,N)
| V2 Bool (Either Bool (Maybe Bool))
| VF Float Double Double
| VW Word Word8 Word16 Word32 Word64
| VI Int Int8 Int16 Int32 Int64
| VII Integer Integer Integer
deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- Phantom type
data Phantom a = Phantom deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- Recursive data types
data RR a b c = RN {rna::a, rnb::b ,rnc::c}
| RA a (RR a a c) b
| RAB a (RR c b a) b
deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Expr = ValB Bool | Or Expr Expr | If Expr Expr Expr deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data List a = C a (List a)
| N
deriving (Eq, Ord, Read, Show, Typeable, Traversable, Data, Generic ,Generic1,Functor,Foldable)
data ListS a = Nil | Cons a (ListS a)
deriving (Eq, Ord, Read, Show, Typeable, Functor, Foldable, Traversable, Data, Generic ,Generic1)
-- non-regular Haskell datatypes like:
-- Binary instances but no Model
data Nest a = NilN | ConsN (a, Nest (a, a)) deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data TN a = LeafT a | BranchT (TN (a,a)) deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Bush a = NilB | ConsB (a, Bush (Bush a)) deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- Perfectly balanced binary tree
data Perfect a = ZeroP a | SuccP (Perfect (Fork a)) deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Fork a = Fork a a deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- non regular with higher-order kind parameters
-- no Binary/Model instances
data PerfectF f α = NilP | ConsP α (PerfectF f (f α)) deriving (Typeable,Generic) -- No Data
data Pr f g a = Pr (f a (g a))
data Higher f a = Higher (f a) deriving (Typeable,Generic,Data)
-- data Pr2 (f :: * -> *) a = Pr2 (f )
data Free f a = Pure a | Roll (f (Free f a)) deriving (Typeable,Generic)
-- mutual references
data A = A B | AA Int deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data B = B A | BB Char deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- recursive sets:
-- Prob: ghc will just explode on this
-- data MM1 = MM1 MM2 MM4 MM0 deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- data MM0 = MM0 deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- data MM2 = MM2 MM3 Bool deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- data MM3 = MM3 MM4 Bool deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- data MM4 = MM4 MM4 MM2 MM5 deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- data MM5 = MM5 Unit MM6 deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- data MM6 = MM6 MM5 deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data A0 = A0 B0 B0 D0 Bool
| A1 (List Bool) (List Unit) (D2.List Bool) (D2.List Bool)
deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data B0 = B0 C0 | B1 deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data C0 = C0 A0 | C1 deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data D0 = D0 E0 | D1 deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data E0 = E0 D0 | E1 deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Even = Zero | SuccE Odd
data Odd = SuccO Even
-- Existential types
-- data Fold a b = forall x. Fold (x -> a -> x) x (x -> b)
-- data Some :: (* -> *) -> * where
-- Some :: f a -> Some f
-- data Dict (c :: Constraint) where
-- Dict :: c => Dict c
data Direction = North | South | Center | East | West
deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Stream a = Stream a (Stream a)
deriving (Eq, Ord, Read, Show, Typeable, Data, Generic,Functor,Foldable,Traversable)
data Tree a = Node (Tree a) (Tree a) | Leaf a
deriving (Eq, Ord, Read, Show, Typeable, Data, Generic, Foldable)
-- Example schema from: http://mechanical-sympathy.blogspot.co.uk/2014/05/simple-binary-encoding.html
data Car = Car {
serialNumber::Word64
,modelYear::Word16
,available::Bool
,code::CarModel
,someNumbers::[Int32]
,vehicleCode::String
,extras::[OptionalExtra]
,engine::Engine
,fuelFigures::[Consumption]
,performanceFigures :: [(OctaneRating,[Acceleration])]
,make::String
,carModel::String
} deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Acceleration = Acceleration {mph::Word16,seconds::Float} deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
type OctaneRating = Word8 -- minValue="90" maxValue="110"
data Consumption = Consumption {cSpeed::Word16,cMpg::Float} deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data CarModel = ModelA | ModelB | ModelC deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data OptionalExtra = SunRoof | SportsPack | CruiseControl deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
data Engine = Engine {
capacity :: Word16
,numCylinders:: Word8
,maxRpm:: Word16 -- constant 9000
,manufacturerCode :: String
,fuel::String -- constant Petrol
} deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
-- To generate Arbitrary instances while avoiding a direct dependency on 'derive' (that is not supported by Eta), run in the project directory: derive -a test/Test/Data.hs
{-!
deriving instance Arbitrary N
deriving instance Arbitrary Tree
deriving instance Arbitrary List
deriving instance Arbitrary Unit
deriving instance Arbitrary Un
deriving instance Arbitrary A
deriving instance Arbitrary B
!-}
-- GENERATED START
instance () => Arbitrary N where
arbitrary
= do x <- choose (0 :: Int, 4)
case x of
0 -> return One
1 -> return Two
2 -> return Three
3 -> return Four
4 -> return Five
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
instance (Arbitrary a) => Arbitrary (Tree a) where
arbitrary
= do x <- choose (0 :: Int, 1)
case x of
0 -> do x1 <- arbitrary
x2 <- arbitrary
return (Node x1 x2)
1 -> do x1 <- arbitrary
return (Leaf x1)
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
instance (Arbitrary a) => Arbitrary (List a) where
arbitrary
= do x <- choose (0 :: Int, 1)
case x of
0 -> do x1 <- arbitrary
x2 <- arbitrary
return (C x1 x2)
1 -> return N
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
instance () => Arbitrary Unit where
arbitrary = return Unit
instance () => Arbitrary Un where
arbitrary
= do x1 <- arbitrary
return (Un x1)
instance () => Arbitrary A where
arbitrary
= do x <- choose (0 :: Int, 1)
case x of
0 -> do x1 <- arbitrary
return (A x1)
1 -> do x1 <- arbitrary
return (AA x1)
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
instance () => Arbitrary B where
arbitrary
= do x <- choose (0 :: Int, 1)
case x of
0 -> do x1 <- arbitrary
return (B x1)
1 -> do x1 <- arbitrary
return (BB x1)
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
-- GENERATED STOP