quickcheck-state-machine-0.7.2: Test monadic programs using state machine based models
Copyright(C) 2017 ATS Advanced Telematic Systems GmbH
LicenseBSD-style (see the file LICENSE)
MaintainerStevan Andjelkovic <stevan.andjelkovic@strath.ac.uk>
Stabilityprovisional
Portabilitynon-portable (GHC extensions)
Safe HaskellSafe-Inferred
LanguageHaskell2010

Test.StateMachine

Description

The main module for state machine based testing, it contains combinators that help you build sequential and parallel properties.

Synopsis

Sequential property combinators

forAllCommands Source #

Arguments

:: Testable prop 
=> (Show (cmd Symbolic), Show (resp Symbolic), Show (model Symbolic)) 
=> (Traversable cmd, Foldable resp) 
=> StateMachine model cmd m resp 
-> Maybe Int

Minimum number of commands.

-> (Commands cmd resp -> prop)

Predicate.

-> Property 

existsCommands Source #

Arguments

:: forall model cmd m resp prop. (Testable prop, Foldable resp) 
=> (Show (model Symbolic), Show (cmd Symbolic), Show (resp Symbolic)) 
=> StateMachine model cmd m resp 
-> [model Symbolic -> Gen (cmd Symbolic)]

Generators.

-> (Commands cmd resp -> prop)

Predicate.

-> Property 

Generate commands from a list of generators.

runCommands :: (Show (cmd Concrete), Show (resp Concrete)) => (Traversable cmd, Foldable resp) => (MonadMask m, MonadIO m) => StateMachine model cmd m resp -> Commands cmd resp -> PropertyM m (History cmd resp, model Concrete, Reason) Source #

runCommandsWithSetup :: (Show (cmd Concrete), Show (resp Concrete)) => (Traversable cmd, Foldable resp) => (MonadMask m, MonadIO m) => m (StateMachine model cmd m resp) -> Commands cmd resp -> PropertyM m (History cmd resp, model Concrete, Reason) Source #

prettyCommands :: (MonadIO m, ToExpr (model Concrete)) => (Show (cmd Concrete), Show (resp Concrete)) => StateMachine model cmd m resp -> History cmd resp -> Property -> PropertyM m () Source #

prettyCommands' :: (MonadIO m, ToExpr (model Concrete), ToExpr tag) => (Show (cmd Concrete), Show (resp Concrete)) => StateMachine model cmd m resp -> ([Event model cmd resp Symbolic] -> [tag]) -> Commands cmd resp -> History cmd resp -> Property -> PropertyM m () Source #

Variant of prettyCommands that also prints the tags covered by each command.

checkCommandNames :: forall cmd resp. CommandNames cmd => Commands cmd resp -> Property -> Property Source #

Print the percentage of each command used. The prefix check is an unfortunate remaining for backwards compatibility.

coverCommandNames :: forall cmd resp. CommandNames cmd => Commands cmd resp -> Property -> Property Source #

Fail if some commands have not been executed.

commandNames :: forall cmd resp. CommandNames cmd => Commands cmd resp -> [(String, Int)] Source #

commandNamesInOrder :: forall cmd resp. CommandNames cmd => Commands cmd resp -> [String] Source #

saveCommands :: (Show (cmd Symbolic), Show (resp Symbolic)) => FilePath -> Commands cmd resp -> Property -> Property Source #

runSavedCommands :: (Show (cmd Concrete), Show (resp Concrete)) => (Traversable cmd, Foldable resp) => (MonadMask m, MonadIO m) => (Read (cmd Symbolic), Read (resp Symbolic)) => StateMachine model cmd m resp -> FilePath -> PropertyM m (Commands cmd resp, History cmd resp, model Concrete, Reason) Source #

showLabelledExamples :: (Show tag, Show (model Symbolic)) => (Show (cmd Symbolic), Show (resp Symbolic)) => (Traversable cmd, Foldable resp) => StateMachine model cmd m resp -> ([Event model cmd resp Symbolic] -> [tag]) -> IO () Source #

showLabelledExamples' Source #

Arguments

:: (Show tag, Show (model Symbolic)) 
=> (Show (cmd Symbolic), Show (resp Symbolic)) 
=> (Traversable cmd, Foldable resp) 
=> StateMachine model cmd m resp 
-> Maybe Int

Seed

-> Int

Number of tests to run to find examples

-> ([Event model cmd resp Symbolic] -> [tag]) 
-> (tag -> Bool)

Tag filter (can be const True)

-> IO () 

Show minimal examples for each of the generated tags.

noCleanup :: Monad m => model Concrete -> m () Source #

Parallel property combinators

forAllParallelCommands Source #

Arguments

:: Testable prop 
=> (Show (cmd Symbolic), Show (resp Symbolic), Show (model Symbolic)) 
=> (Traversable cmd, Foldable resp) 
=> StateMachine model cmd m resp 
-> Maybe Int 
-> (ParallelCommands cmd resp -> prop)

Predicate.

-> Property 

forAllNParallelCommands Source #

Arguments

:: Testable prop 
=> (Show (cmd Symbolic), Show (resp Symbolic), Show (model Symbolic)) 
=> (Traversable cmd, Foldable resp) 
=> StateMachine model cmd m resp 
-> Int

Number of threads

-> (NParallelCommands cmd resp -> prop)

Predicate.

-> Property 

runNParallelCommands :: (Show (cmd Concrete), Show (resp Concrete)) => (Traversable cmd, Foldable resp) => (MonadMask m, MonadUnliftIO m) => StateMachine model cmd m resp -> NParallelCommands cmd resp -> PropertyM m [(History cmd resp, model Concrete, Logic)] Source #

runNParallelCommandsWithSetup :: (Show (cmd Concrete), Show (resp Concrete)) => (Traversable cmd, Foldable resp) => (MonadMask m, MonadUnliftIO m) => m (StateMachine model cmd m resp) -> NParallelCommands cmd resp -> PropertyM m [(History cmd resp, model Concrete, Logic)] Source #

runParallelCommands :: (Show (cmd Concrete), Show (resp Concrete)) => (Traversable cmd, Foldable resp) => (MonadMask m, MonadUnliftIO m) => StateMachine model cmd m resp -> ParallelCommands cmd resp -> PropertyM m [(History cmd resp, model Concrete, Logic)] Source #

runParallelCommandsWithSetup :: (Show (cmd Concrete), Show (resp Concrete)) => (Traversable cmd, Foldable resp) => (MonadMask m, MonadUnliftIO m) => m (StateMachine model cmd m resp) -> ParallelCommands cmd resp -> PropertyM m [(History cmd resp, model Concrete, Logic)] Source #

runParallelCommands' :: (Show (cmd Concrete), Show (resp Concrete)) => (Traversable cmd, Foldable resp) => (MonadMask m, MonadUnliftIO m) => m (StateMachine model cmd m resp) -> (cmd Concrete -> resp Concrete) -> ParallelCommands cmd resp -> PropertyM m [(History cmd resp, model Concrete, Logic)] Source #

runParallelCommandsNTimes Source #

Arguments

:: (Show (cmd Concrete), Show (resp Concrete)) 
=> (Traversable cmd, Foldable resp) 
=> (MonadMask m, MonadUnliftIO m) 
=> Int

How many times to execute the parallel program.

-> StateMachine model cmd m resp 
-> ParallelCommands cmd resp 
-> PropertyM m [(History cmd resp, model Concrete, Logic)] 

runParallelCommandsNTimesWithSetup Source #

Arguments

:: (Show (cmd Concrete), Show (resp Concrete)) 
=> (Traversable cmd, Foldable resp) 
=> (MonadMask m, MonadUnliftIO m) 
=> Int

How many times to execute the parallel program.

-> m (StateMachine model cmd m resp) 
-> ParallelCommands cmd resp 
-> PropertyM m [(History cmd resp, model Concrete, Logic)] 

runNParallelCommandsNTimes' Source #

Arguments

:: (Show (cmd Concrete), Show (resp Concrete)) 
=> (Traversable cmd, Foldable resp) 
=> (MonadMask m, MonadUnliftIO m) 
=> Int

How many times to execute the parallel program.

-> m (StateMachine model cmd m resp) 
-> (cmd Concrete -> resp Concrete) 
-> NParallelCommands cmd resp 
-> PropertyM m [(History cmd resp, model Concrete, Logic)] 

runParallelCommandsNTimes' Source #

Arguments

:: (Show (cmd Concrete), Show (resp Concrete)) 
=> (Traversable cmd, Foldable resp) 
=> (MonadMask m, MonadUnliftIO m) 
=> Int

How many times to execute the parallel program.

-> m (StateMachine model cmd m resp) 
-> (cmd Concrete -> resp Concrete) 
-> ParallelCommands cmd resp 
-> PropertyM m [(History cmd resp, model Concrete, Logic)] 

runNParallelCommandsNTimes Source #

Arguments

:: (Show (cmd Concrete), Show (resp Concrete)) 
=> (Traversable cmd, Foldable resp) 
=> (MonadMask m, MonadUnliftIO m) 
=> Int

How many times to execute the parallel program.

-> StateMachine model cmd m resp 
-> NParallelCommands cmd resp 
-> PropertyM m [(History cmd resp, model Concrete, Logic)] 

runNParallelCommandsNTimesWithSetup Source #

Arguments

:: (Show (cmd Concrete), Show (resp Concrete)) 
=> (Traversable cmd, Foldable resp) 
=> (MonadMask m, MonadUnliftIO m) 
=> Int

How many times to execute the parallel program.

-> m (StateMachine model cmd m resp) 
-> NParallelCommands cmd resp 
-> PropertyM m [(History cmd resp, model Concrete, Logic)] 

prettyNParallelCommands Source #

Arguments

:: (Show (cmd Concrete), Show (resp Concrete)) 
=> MonadIO m 
=> Foldable cmd 
=> NParallelCommands cmd resp 
-> [(History cmd resp, a, Logic)]

Output of runNParallelCommands.

-> PropertyM m () 

prettyParallelCommands Source #

Arguments

:: (Show (cmd Concrete), Show (resp Concrete)) 
=> MonadIO m 
=> Foldable cmd 
=> ParallelCommands cmd resp 
-> [(History cmd resp, a, Logic)]

Output of runNParallelCommands.

-> PropertyM m () 

prettyParallelCommandsWithOpts Source #

Arguments

:: (MonadIO m, Foldable cmd) 
=> (Show (cmd Concrete), Show (resp Concrete)) 
=> ParallelCommands cmd resp 
-> Maybe GraphOptions 
-> [(History cmd resp, a, Logic)]

Output of runParallelCommands.

-> PropertyM m () 

Takes the output of parallel program runs and pretty prints a counterexample if any of the runs fail.

prettyNParallelCommandsWithOpts Source #

Arguments

:: (Show (cmd Concrete), Show (resp Concrete)) 
=> MonadIO m 
=> Foldable cmd 
=> NParallelCommands cmd resp 
-> Maybe GraphOptions 
-> [(History cmd resp, a, Logic)]

Output of runNParallelCommands.

-> PropertyM m () 

Takes the output of parallel program runs and pretty prints a counterexample if any of the runs fail.

checkCommandNamesParallel :: forall cmd resp t. Foldable t => CommandNames cmd => ParallelCommandsF t cmd resp -> Property -> Property Source #

Print the percentage of each command used. The prefix check is an unfortunate remaining for backwards compatibility.

coverCommandNamesParallel :: forall cmd resp t. Foldable t => CommandNames cmd => ParallelCommandsF t cmd resp -> Property -> Property Source #

Fail if some commands have not been executed.

commandNamesParallel :: forall cmd resp t. Foldable t => CommandNames cmd => ParallelCommandsF t cmd resp -> [(String, Int)] Source #

Types

data StateMachine model cmd m resp Source #

Constructors

StateMachine (forall r. model r) (forall r. (Show1 r, Ord1 r) => model r -> cmd r -> resp r -> model r) (model Symbolic -> cmd Symbolic -> Logic) (model Concrete -> cmd Concrete -> resp Concrete -> Logic) (Maybe (model Concrete -> Logic)) (model Symbolic -> Maybe (Gen (cmd Symbolic))) (model Symbolic -> cmd Symbolic -> [cmd Symbolic]) (cmd Concrete -> m (resp Concrete)) (model Symbolic -> cmd Symbolic -> GenSym (resp Symbolic)) (model Concrete -> m ()) 

data Concrete a Source #

Instances

Instances details
Eq1 Concrete Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

liftEq :: (a -> b -> Bool) -> Concrete a -> Concrete b -> Bool #

Ord1 Concrete Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

liftCompare :: (a -> b -> Ordering) -> Concrete a -> Concrete b -> Ordering #

Show1 Concrete Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Concrete a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Concrete a] -> ShowS #

Show a => Show (Concrete a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

showsPrec :: Int -> Concrete a -> ShowS #

show :: Concrete a -> String #

showList :: [Concrete a] -> ShowS #

ToExpr a => ToExpr (Concrete a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

toExpr :: Concrete a -> Expr #

listToExpr :: [Concrete a] -> Expr #

(ToExpr (MockState t), All (And ToExpr (Compose ToExpr (MockHandle t))) (RealHandles t)) => ToExpr (Model t Concrete) Source # 
Instance details

Defined in Test.StateMachine.Lockstep.NAry

All (And ToExpr (Compose ToExpr (MockHandle t))) (RealHandles t) => ToExpr (Refss t Concrete) Source # 
Instance details

Defined in Test.StateMachine.Lockstep.NAry

(ToExpr a, ToExpr (MockHandle t a)) => ToExpr (Refs t Concrete a) Source # 
Instance details

Defined in Test.StateMachine.Lockstep.NAry

Methods

toExpr :: Refs t Concrete a -> Expr #

listToExpr :: [Refs t Concrete a] -> Expr #

data Symbolic a Source #

Instances

Instances details
Eq1 Symbolic Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

liftEq :: (a -> b -> Bool) -> Symbolic a -> Symbolic b -> Bool #

Ord1 Symbolic Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

liftCompare :: (a -> b -> Ordering) -> Symbolic a -> Symbolic b -> Ordering #

Show1 Symbolic Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Symbolic a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Symbolic a] -> ShowS #

Typeable a => Read (Symbolic a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Show (Symbolic a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

showsPrec :: Int -> Symbolic a -> ShowS #

show :: Symbolic a -> String #

showList :: [Symbolic a] -> ShowS #

Eq (Symbolic a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

(==) :: Symbolic a -> Symbolic a -> Bool #

(/=) :: Symbolic a -> Symbolic a -> Bool #

Ord (Symbolic a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

compare :: Symbolic a -> Symbolic a -> Ordering #

(<) :: Symbolic a -> Symbolic a -> Bool #

(<=) :: Symbolic a -> Symbolic a -> Bool #

(>) :: Symbolic a -> Symbolic a -> Bool #

(>=) :: Symbolic a -> Symbolic a -> Bool #

max :: Symbolic a -> Symbolic a -> Symbolic a #

min :: Symbolic a -> Symbolic a -> Symbolic a #

ToExpr a => ToExpr (Symbolic a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

toExpr :: Symbolic a -> Expr #

listToExpr :: [Symbolic a] -> Expr #

Typeable a => Read (Reference a Symbolic) Source # 
Instance details

Defined in Test.StateMachine.Types.References

data Reference a r Source #

Instances

Instances details
Foldable (Reference a :: (Type -> Type) -> Type) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

foldMap :: Monoid m => (forall (x :: k). p x -> m) -> Reference a p -> m Source #

Functor (Reference a :: (Type -> Type) -> Type) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

fmap :: (forall (x :: k). p x -> q x) -> Reference a p -> Reference a q Source #

Traversable (Reference a :: (Type -> Type) -> Type) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

traverse :: Applicative f => (forall (a0 :: k). p a0 -> f (q a0)) -> Reference a p -> f (Reference a q) Source #

Generic (Reference a r) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Associated Types

type Rep (Reference a r) :: Type -> Type #

Methods

from :: Reference a r -> Rep (Reference a r) x #

to :: Rep (Reference a r) x -> Reference a r #

Typeable a => Read (Reference a Symbolic) Source # 
Instance details

Defined in Test.StateMachine.Types.References

(Show1 r, Show a) => Show (Reference a r) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

showsPrec :: Int -> Reference a r -> ShowS #

show :: Reference a r -> String #

showList :: [Reference a r] -> ShowS #

(Eq a, Eq1 r) => Eq (Reference a r) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

(==) :: Reference a r -> Reference a r -> Bool #

(/=) :: Reference a r -> Reference a r -> Bool #

(Ord a, Ord1 r) => Ord (Reference a r) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

compare :: Reference a r -> Reference a r -> Ordering #

(<) :: Reference a r -> Reference a r -> Bool #

(<=) :: Reference a r -> Reference a r -> Bool #

(>) :: Reference a r -> Reference a r -> Bool #

(>=) :: Reference a r -> Reference a r -> Bool #

max :: Reference a r -> Reference a r -> Reference a r #

min :: Reference a r -> Reference a r -> Reference a r #

ToExpr (r a) => ToExpr (Reference a r) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

toExpr :: Reference a r -> Expr #

listToExpr :: [Reference a r] -> Expr #

type Rep (Reference a r) Source # 
Instance details

Defined in Test.StateMachine.Types.References

type Rep (Reference a r) = D1 ('MetaData "Reference" "Test.StateMachine.Types.References" "quickcheck-state-machine-0.7.2-FX39IRBervmEF0sah0Vq4p" 'True) (C1 ('MetaCons "Reference" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (r a))))

newtype Opaque a Source #

Constructors

Opaque 

Fields

Instances

Instances details
Show (Opaque a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

showsPrec :: Int -> Opaque a -> ShowS #

show :: Opaque a -> String #

showList :: [Opaque a] -> ShowS #

Eq a => Eq (Opaque a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

(==) :: Opaque a -> Opaque a -> Bool #

(/=) :: Opaque a -> Opaque a -> Bool #

Ord a => Ord (Opaque a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

compare :: 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 #

max :: Opaque a -> Opaque a -> Opaque a #

min :: Opaque a -> Opaque a -> Opaque a #

ToExpr (Opaque a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

toExpr :: Opaque a -> Expr #

listToExpr :: [Opaque a] -> Expr #

data GenSym a Source #

Instances

Instances details
Applicative GenSym Source # 
Instance details

Defined in Test.StateMachine.Types.GenSym

Methods

pure :: a -> GenSym a #

(<*>) :: GenSym (a -> b) -> GenSym a -> GenSym b #

liftA2 :: (a -> b -> c) -> GenSym a -> GenSym b -> GenSym c #

(*>) :: GenSym a -> GenSym b -> GenSym b #

(<*) :: GenSym a -> GenSym b -> GenSym a #

Functor GenSym Source # 
Instance details

Defined in Test.StateMachine.Types.GenSym

Methods

fmap :: (a -> b) -> GenSym a -> GenSym b #

(<$) :: a -> GenSym b -> GenSym a #

Monad GenSym Source # 
Instance details

Defined in Test.StateMachine.Types.GenSym

Methods

(>>=) :: GenSym a -> (a -> GenSym b) -> GenSym b #

(>>) :: GenSym a -> GenSym b -> GenSym b #

return :: a -> GenSym a #

class CommandNames (cmd :: k -> Type) where Source #

The names of all possible commands

This is used for things like tagging, coverage checking, etc.

Minimal complete definition

Nothing

Methods

cmdName :: cmd r -> String Source #

Name of this particular command

default cmdName :: (Generic1 cmd, CommandNames (Rep1 cmd)) => cmd r -> String Source #

cmdNames :: Proxy (cmd r) -> [String] Source #

Name of all possible commands

default cmdNames :: forall r. CommandNames (Rep1 cmd) => Proxy (cmd r) -> [String] Source #

Instances

Instances details
CommandNames (U1 :: k -> Type) Source # 
Instance details

Defined in Test.StateMachine.ConstructorName

Methods

cmdName :: forall (r :: k0). U1 r -> String Source #

cmdNames :: forall (r :: k0). Proxy (U1 r) -> [String] Source #

CommandNames f => CommandNames (Rec1 f :: k -> Type) Source # 
Instance details

Defined in Test.StateMachine.ConstructorName

Methods

cmdName :: forall (r :: k0). Rec1 f r -> String Source #

cmdNames :: forall (r :: k0). Proxy (Rec1 f r) -> [String] Source #

(CommandNames f, CommandNames g) => CommandNames (f :*: g :: k -> Type) Source # 
Instance details

Defined in Test.StateMachine.ConstructorName

Methods

cmdName :: forall (r :: k0). (f :*: g) r -> String Source #

cmdNames :: forall (r :: k0). Proxy ((f :*: g) r) -> [String] Source #

(CommandNames f, CommandNames g) => CommandNames (f :+: g :: k -> Type) Source # 
Instance details

Defined in Test.StateMachine.ConstructorName

Methods

cmdName :: forall (r :: k0). (f :+: g) r -> String Source #

cmdNames :: forall (r :: k0). Proxy ((f :+: g) r) -> [String] Source #

CommandNames (K1 i c :: k -> Type) Source # 
Instance details

Defined in Test.StateMachine.ConstructorName

Methods

cmdName :: forall (r :: k0). K1 i c r -> String Source #

cmdNames :: forall (r :: k0). Proxy (K1 i c r) -> [String] Source #

Constructor c => CommandNames (M1 C c f :: k -> Type) Source # 
Instance details

Defined in Test.StateMachine.ConstructorName

Methods

cmdName :: forall (r :: k0). M1 C c f r -> String Source #

cmdNames :: forall (r :: k0). Proxy (M1 C c f r) -> [String] Source #

CommandNames f => CommandNames (M1 D c f :: k -> Type) Source # 
Instance details

Defined in Test.StateMachine.ConstructorName

Methods

cmdName :: forall (r :: k0). M1 D c f r -> String Source #

cmdNames :: forall (r :: k0). Proxy (M1 D c f r) -> [String] Source #

CommandNames f => CommandNames (M1 S c f :: k -> Type) Source # 
Instance details

Defined in Test.StateMachine.ConstructorName

Methods

cmdName :: forall (r :: k0). M1 S c f r -> String Source #

cmdNames :: forall (r :: k0). Proxy (M1 S c f r) -> [String] Source #

Re-export

class ToExpr a #

toExpr converts a Haskell value into untyped Haskell-like syntax tree, Expr.

>>> toExpr ((1, Just 2) :: (Int, Maybe Int))
App "_\215_" [App "1" [],App "Just" [App "2" []]]

Instances

Instances details
ToExpr Key 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Key -> Expr #

listToExpr :: [Key] -> Expr #

ToExpr Value 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Value -> Expr #

listToExpr :: [Value] -> Expr #

ToExpr Void 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Void -> Expr #

listToExpr :: [Void] -> Expr #

ToExpr Int16 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Int16 -> Expr #

listToExpr :: [Int16] -> Expr #

ToExpr Int32 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Int32 -> Expr #

listToExpr :: [Int32] -> Expr #

ToExpr Int64 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Int64 -> Expr #

listToExpr :: [Int64] -> Expr #

ToExpr Int8 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Int8 -> Expr #

listToExpr :: [Int8] -> Expr #

ToExpr Word16 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Word16 -> Expr #

listToExpr :: [Word16] -> Expr #

ToExpr Word32 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Word32 -> Expr #

listToExpr :: [Word32] -> Expr #

ToExpr Word64 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Word64 -> Expr #

listToExpr :: [Word64] -> Expr #

ToExpr Word8 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Word8 -> Expr #

listToExpr :: [Word8] -> Expr #

ToExpr ByteString
>>> traverse_ (print . prettyExpr . toExpr . BS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
""
"\n"
"foo"
"foo\n"
BS.concat ["foo\n", "bar"]
BS.concat ["foo\n", "bar\n"]
Instance details

Defined in Data.TreeDiff.Class

ToExpr ByteString
>>> traverse_ (print . prettyExpr . toExpr . LBS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
""
"\n"
"foo"
"foo\n"
LBS.concat ["foo\n", "bar"]
LBS.concat ["foo\n", "bar\n"]
Instance details

Defined in Data.TreeDiff.Class

ToExpr ShortByteString
>>> traverse_ (print . prettyExpr . toExpr . SBS.toShort . BS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
""
"\n"
"foo"
"foo\n"
mconcat ["foo\n", "bar"]
mconcat ["foo\n", "bar\n"]
Instance details

Defined in Data.TreeDiff.Class

ToExpr IntSet 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: IntSet -> Expr #

listToExpr :: [IntSet] -> Expr #

ToExpr ByteArray

Since: tree-diff-0.2.2

Instance details

Defined in Data.TreeDiff.Class

ToExpr Ordering 
Instance details

Defined in Data.TreeDiff.Class

ToExpr Var Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

toExpr :: Var -> Expr #

listToExpr :: [Var] -> Expr #

ToExpr Scientific
>>> prettyExpr $ toExpr (123.456 :: Scientific)
scientific 123456 `-3`
Instance details

Defined in Data.TreeDiff.Class

ToExpr Text
>>> traverse_ (print . prettyExpr . toExpr . T.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
""
"\n"
"foo"
"foo\n"
T.concat ["foo\n", "bar"]
T.concat ["foo\n", "bar\n"]
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Text -> Expr #

listToExpr :: [Text] -> Expr #

ToExpr Text
>>> traverse_ (print . prettyExpr . toExpr . LT.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
""
"\n"
"foo"
"foo\n"
LT.concat ["foo\n", "bar"]
LT.concat ["foo\n", "bar\n"]
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Text -> Expr #

listToExpr :: [Text] -> Expr #

ToExpr Day
>>> prettyExpr $ toExpr $ ModifiedJulianDay 58014
Day "2017-09-18"
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Day -> Expr #

listToExpr :: [Day] -> Expr #

ToExpr UTCTime 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: UTCTime -> Expr #

listToExpr :: [UTCTime] -> Expr #

ToExpr Expr 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Expr -> Expr #

listToExpr :: [Expr] -> Expr #

ToExpr UUID
>>> prettyExpr $ toExpr UUID.nil
UUID "00000000-0000-0000-0000-000000000000"
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: UUID -> Expr #

listToExpr :: [UUID] -> Expr #

ToExpr Integer 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Integer -> Expr #

listToExpr :: [Integer] -> Expr #

ToExpr Natural 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Natural -> Expr #

listToExpr :: [Natural] -> Expr #

ToExpr () 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: () -> Expr #

listToExpr :: [()] -> Expr #

ToExpr Bool 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Bool -> Expr #

listToExpr :: [Bool] -> Expr #

ToExpr Char
>>> prettyExpr $ toExpr 'a'
'a'
>>> prettyExpr $ toExpr "Hello world"
"Hello world"
>>> prettyExpr $ toExpr "Hello\nworld"
concat ["Hello\n", "world"]
>>> traverse_ (print . prettyExpr . toExpr) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
""
"\n"
"foo"
"foo\n"
concat ["foo\n", "bar"]
concat ["foo\n", "bar\n"]
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Char -> Expr #

listToExpr :: [Char] -> Expr #

ToExpr Double 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Double -> Expr #

listToExpr :: [Double] -> Expr #

ToExpr Float 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Float -> Expr #

listToExpr :: [Float] -> Expr #

ToExpr Int 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Int -> Expr #

listToExpr :: [Int] -> Expr #

ToExpr Word 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Word -> Expr #

listToExpr :: [Word] -> Expr #

ToExpr a => ToExpr (KeyMap a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: KeyMap a -> Expr #

listToExpr :: [KeyMap a] -> Expr #

ToExpr a => ToExpr (ZipList a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: ZipList a -> Expr #

listToExpr :: [ZipList a] -> Expr #

ToExpr a => ToExpr (Identity a)
>>> prettyExpr $ toExpr $ Identity 'a'
Identity 'a'
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Identity a -> Expr #

listToExpr :: [Identity a] -> Expr #

ToExpr a => ToExpr (First a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: First a -> Expr #

listToExpr :: [First a] -> Expr #

ToExpr a => ToExpr (Last a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Last a -> Expr #

listToExpr :: [Last a] -> Expr #

ToExpr a => ToExpr (First a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: First a -> Expr #

listToExpr :: [First a] -> Expr #

ToExpr a => ToExpr (Last a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Last a -> Expr #

listToExpr :: [Last a] -> Expr #

ToExpr a => ToExpr (Max a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Max a -> Expr #

listToExpr :: [Max a] -> Expr #

ToExpr a => ToExpr (Min a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Min a -> Expr #

listToExpr :: [Min a] -> Expr #

ToExpr a => ToExpr (Dual a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Dual a -> Expr #

listToExpr :: [Dual a] -> Expr #

ToExpr a => ToExpr (Product a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Product a -> Expr #

listToExpr :: [Product a] -> Expr #

ToExpr a => ToExpr (Sum a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Sum a -> Expr #

listToExpr :: [Sum a] -> Expr #

(ToExpr a, Integral a) => ToExpr (Ratio a)
>>> prettyExpr $ toExpr (3 % 12 :: Rational)
_%_ 1 4
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Ratio a -> Expr #

listToExpr :: [Ratio a] -> Expr #

ToExpr v => ToExpr (IntMap v) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: IntMap v -> Expr #

listToExpr :: [IntMap v] -> Expr #

ToExpr v => ToExpr (Seq v) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Seq v -> Expr #

listToExpr :: [Seq v] -> Expr #

ToExpr k => ToExpr (Set k) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Set k -> Expr #

listToExpr :: [Set k] -> Expr #

ToExpr a => ToExpr (Tree a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Tree a -> Expr #

listToExpr :: [Tree a] -> Expr #

ToExpr a => ToExpr (Hashed a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Hashed a -> Expr #

listToExpr :: [Hashed a] -> Expr #

ToExpr a => ToExpr (Concrete a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

toExpr :: Concrete a -> Expr #

listToExpr :: [Concrete a] -> Expr #

ToExpr (Opaque a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

toExpr :: Opaque a -> Expr #

listToExpr :: [Opaque a] -> Expr #

ToExpr a => ToExpr (Symbolic a) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

toExpr :: Symbolic a -> Expr #

listToExpr :: [Symbolic a] -> Expr #

ToExpr a => ToExpr (Maybe a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Maybe a -> Expr #

listToExpr :: [Maybe a] -> Expr #

ToExpr k => ToExpr (HashSet k) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: HashSet k -> Expr #

listToExpr :: [HashSet k] -> Expr #

ToExpr a => ToExpr (Vector a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Vector a -> Expr #

listToExpr :: [Vector a] -> Expr #

(ToExpr a, Prim a) => ToExpr (Vector a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Vector a -> Expr #

listToExpr :: [Vector a] -> Expr #

(ToExpr a, Storable a) => ToExpr (Vector a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Vector a -> Expr #

listToExpr :: [Vector a] -> Expr #

(ToExpr a, Unbox a) => ToExpr (Vector a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Vector a -> Expr #

listToExpr :: [Vector a] -> Expr #

ToExpr a => ToExpr (NonEmpty a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: NonEmpty a -> Expr #

listToExpr :: [NonEmpty a] -> Expr #

ToExpr a => ToExpr (Maybe a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Maybe a -> Expr #

listToExpr :: [Maybe a] -> Expr #

ToExpr a => ToExpr [a] 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: [a] -> Expr #

listToExpr :: [[a]] -> Expr #

(ToExpr a, ToExpr b) => ToExpr (Either a b) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Either a b -> Expr #

listToExpr :: [Either a b] -> Expr #

HasResolution a => ToExpr (Fixed a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Fixed a -> Expr #

listToExpr :: [Fixed a] -> Expr #

ToExpr (Proxy a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Proxy a -> Expr #

listToExpr :: [Proxy a] -> Expr #

(ToExpr k, ToExpr v) => ToExpr (Map k v) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Map k v -> Expr #

listToExpr :: [Map k v] -> Expr #

(ToExpr (MockState t), All (And ToExpr (Compose ToExpr (MockHandle t))) (RealHandles t)) => ToExpr (Model t Concrete) Source # 
Instance details

Defined in Test.StateMachine.Lockstep.NAry

All (And ToExpr (Compose ToExpr (MockHandle t))) (RealHandles t) => ToExpr (Refss t Concrete) Source # 
Instance details

Defined in Test.StateMachine.Lockstep.NAry

ToExpr (r a) => ToExpr (Reference a r) Source # 
Instance details

Defined in Test.StateMachine.Types.References

Methods

toExpr :: Reference a r -> Expr #

listToExpr :: [Reference a r] -> Expr #

(ToExpr a, ToExpr b) => ToExpr (Either a b) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Either a b -> Expr #

listToExpr :: [Either a b] -> Expr #

(ToExpr a, ToExpr b) => ToExpr (These a b) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: These a b -> Expr #

listToExpr :: [These a b] -> Expr #

(ToExpr a, ToExpr b) => ToExpr (Pair a b) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Pair a b -> Expr #

listToExpr :: [Pair a b] -> Expr #

(ToExpr a, ToExpr b) => ToExpr (These a b) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: These a b -> Expr #

listToExpr :: [These a b] -> Expr #

(ToExpr k, ToExpr v) => ToExpr (HashMap k v) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: HashMap k v -> Expr #

listToExpr :: [HashMap k v] -> Expr #

(ToExpr a, ToExpr b) => ToExpr (a, b) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: (a, b) -> Expr #

listToExpr :: [(a, b)] -> Expr #

ToExpr a => ToExpr (Const a b) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Const a b -> Expr #

listToExpr :: [Const a b] -> Expr #

(ToExpr a, ToExpr (MockHandle t a)) => ToExpr (Refs t Concrete a) Source # 
Instance details

Defined in Test.StateMachine.Lockstep.NAry

Methods

toExpr :: Refs t Concrete a -> Expr #

listToExpr :: [Refs t Concrete a] -> Expr #

ToExpr a => ToExpr (Tagged t a) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: Tagged t a -> Expr #

listToExpr :: [Tagged t a] -> Expr #

(ToExpr a, ToExpr b, ToExpr c) => ToExpr (a, b, c) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: (a, b, c) -> Expr #

listToExpr :: [(a, b, c)] -> Expr #

(ToExpr a, ToExpr b, ToExpr c, ToExpr d) => ToExpr (a, b, c, d) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: (a, b, c, d) -> Expr #

listToExpr :: [(a, b, c, d)] -> Expr #

(ToExpr a, ToExpr b, ToExpr c, ToExpr d, ToExpr e) => ToExpr (a, b, c, d, e) 
Instance details

Defined in Data.TreeDiff.Class

Methods

toExpr :: (a, b, c, d, e) -> Expr #

listToExpr :: [(a, b, c, d, e)] -> Expr #

toExpr :: ToExpr a => a -> Expr #