dynamic-resolution-0.1.0.0: Utilities for 'compiling' trees of Dynamics into statically typed values

Safe HaskellNone
LanguageHaskell2010

Data.Dynamic.Resolve

Contents

Synopsis

Types and Typeclasses

class Parameter a where Source #

The Parameter typeclass is used to represent dynamic functions and their parameters.

Minimal complete definition

values

Methods

values :: a -> NonEmpty Dynamic Source #

values provides a way of extracting the possible values for a given parameter

Instances
Parameter Dynamic Source # 
Instance details

Defined in Data.Dynamic.Resolve

Parameter (NonEmpty Dynamic) Source # 
Instance details

Defined in Data.Dynamic.Resolve

data Tree a Source #

Tree is a simple "leafy" tree, used to build and express chains of function applications. Note that it is non-empty by construction.

Constructors

Leaf a

a single value

(Tree a) :*: (Tree a)

a branch connecting two subtrees

Instances
Monad Tree Source # 
Instance details

Defined in Data.Dynamic.Resolve

Methods

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

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

return :: a -> Tree a #

fail :: String -> Tree a #

Functor Tree Source # 
Instance details

Defined in Data.Dynamic.Resolve

Methods

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

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

Applicative Tree Source # 
Instance details

Defined in Data.Dynamic.Resolve

Methods

pure :: a -> Tree a #

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

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

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

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

Foldable Tree Source # 
Instance details

Defined in Data.Dynamic.Resolve

Methods

fold :: Monoid m => Tree m -> m #

foldMap :: Monoid m => (a -> m) -> Tree a -> m #

foldr :: (a -> b -> b) -> b -> Tree a -> b #

foldr' :: (a -> b -> b) -> b -> Tree a -> b #

foldl :: (b -> a -> b) -> b -> Tree a -> b #

foldl' :: (b -> a -> b) -> b -> Tree a -> b #

foldr1 :: (a -> a -> a) -> Tree a -> a #

foldl1 :: (a -> a -> a) -> Tree a -> a #

toList :: Tree a -> [a] #

null :: Tree a -> Bool #

length :: Tree a -> Int #

elem :: Eq a => a -> Tree a -> Bool #

maximum :: Ord a => Tree a -> a #

minimum :: Ord a => Tree a -> a #

sum :: Num a => Tree a -> a #

product :: Num a => Tree a -> a #

Traversable Tree Source # 
Instance details

Defined in Data.Dynamic.Resolve

Methods

traverse :: Applicative f => (a -> f b) -> Tree a -> f (Tree b) #

sequenceA :: Applicative f => Tree (f a) -> f (Tree a) #

mapM :: Monad m => (a -> m b) -> Tree a -> m (Tree b) #

sequence :: Monad m => Tree (m a) -> m (Tree a) #

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

Defined in Data.Dynamic.Resolve

Methods

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

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

Read a => Read (Tree a) Source # 
Instance details

Defined in Data.Dynamic.Resolve

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

Defined in Data.Dynamic.Resolve

Methods

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

show :: Tree a -> String #

showList :: [Tree a] -> ShowS #

Generic (Tree a) Source # 
Instance details

Defined in Data.Dynamic.Resolve

Associated Types

type Rep (Tree a) :: * -> * #

Methods

from :: Tree a -> Rep (Tree a) x #

to :: Rep (Tree a) x -> Tree a #

Semigroup (Tree a) Source # 
Instance details

Defined in Data.Dynamic.Resolve

Methods

(<>) :: Tree a -> Tree a -> Tree a #

sconcat :: NonEmpty (Tree a) -> Tree a #

stimes :: Integral b => b -> Tree a -> Tree a #

type Rep (Tree a) Source # 
Instance details

Defined in Data.Dynamic.Resolve

drawTree :: Show a => Tree a -> String Source #

Utility function to give a visual representation of the Tree's structure.

foldi Source #

Arguments

:: (a -> b -> b)

accumulating function

-> (b -> b -> b)

function to combine the values of two evaluated subtrees, taking the left branch as the first argument and the right branch as the second

-> b

initial accumulator value

-> Tree a 
-> b 

An "inward" fold on a Tree where subtrees of each branch are fully evaluated, and then those values are combined with the given binary operation.

foldi1 :: (a -> a -> a) -> Tree a -> a Source #

An "inward" fold on a Tree where subtrees of each branch are fully evaluated, and then those values are combined with the accumulating function. Uses the values at each leaf for initial accumulators.

fromListL :: NonEmpty a -> Tree a Source #

Left-associatively builds up a Tree from a non-empty list.

data Ap a Source #

Ap represents a chain of successful function applications.

Constructors

Ap 

Fields

Instances
Show a => Show (Ap a) Source # 
Instance details

Defined in Data.Dynamic.Resolve

Methods

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

show :: Ap a -> String #

showList :: [Ap a] -> ShowS #

Generic (Ap a) Source # 
Instance details

Defined in Data.Dynamic.Resolve

Associated Types

type Rep (Ap a) :: * -> * #

Methods

from :: Ap a -> Rep (Ap a) x #

to :: Rep (Ap a) x -> Ap a #

type Rep (Ap a) Source # 
Instance details

Defined in Data.Dynamic.Resolve

type Rep (Ap a) = D1 (MetaData "Ap" "Data.Dynamic.Resolve" "dynamic-resolution-0.1.0.0-EDdpoqUrAPbJ0BSuZMlv6Q" False) (C1 (MetaCons "Ap" PrefixI True) (S1 (MetaSel (Just "result") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (NonEmpty Dynamic)) :*: S1 (MetaSel (Just "applicationTree") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Tree a))))

data ApResult (env :: * -> *) a Source #

ApResult represents a chain of function applications (in the "env" monad) that may have failed.

Constructors

Success (Ap a)

successful application and the resulting value

Failure (Ap a, Ap a)

failed application, the initial value, and the value attempted to be applied

Instances
Show a => Show (ApResult env a) Source # 
Instance details

Defined in Data.Dynamic.Resolve

Methods

showsPrec :: Int -> ApResult env a -> ShowS #

show :: ApResult env a -> String #

showList :: [ApResult env a] -> ShowS #

Generic (ApResult env a) Source # 
Instance details

Defined in Data.Dynamic.Resolve

Associated Types

type Rep (ApResult env a) :: * -> * #

Methods

from :: ApResult env a -> Rep (ApResult env a) x #

to :: Rep (ApResult env a) x -> ApResult env a #

type Rep (ApResult env a) Source # 
Instance details

Defined in Data.Dynamic.Resolve

type Rep (ApResult env a) = D1 (MetaData "ApResult" "Data.Dynamic.Resolve" "dynamic-resolution-0.1.0.0-EDdpoqUrAPbJ0BSuZMlv6Q" False) (C1 (MetaCons "Success" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Ap a))) :+: C1 (MetaCons "Failure" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Ap a, Ap a))))

type ApResultPure a = ApResult Identity a Source #

ApResult specialized to pure funtcion applications

Resolution functions

papply Source #

Arguments

:: (Parameter a, Monad env, Typeable env) 
=> ApResult env a

function

-> ApResult env a

argument

-> ApResult env a 

Attempts to apply the values inside one ApResult to another. Returns successfully with all successful applications if both arguments are Successes and at least one application was successful, and Failure otherwise.

applyTree :: forall env a. (Parameter a, Monad env, Typeable env) => Tree a -> ApResult env a Source #

Evaluates a Tree of Parameters to a single ApResult. Will automatically lift Dynamic functions and arguments into the env monad (must be specified with visible type application) as needed—if this is undesirable use pureApplyTree.

pureApplyTree :: Parameter a => Tree a -> ApResultPure a Source #

Evaluates a Tree of Parameters to a single ApResult.

applyList Source #

Arguments

:: (Parameter a, Monad env, Typeable env) 
=> a

function

-> [a]

arguments

-> ApResult env a 

Evaluates a list of Parameters to a single ApResult. Will automatically lift Dynamic functions and arguments into the env monad (must be specified with visible type application) as needed—if this is undesirable use 'pureApplyList.

pureApplyList Source #

Arguments

:: Parameter a 
=> a

function

-> [a]

arguments

-> ApResultPure a 

Evaluates the given function (as a Parameter) applied to a list of arguments (also as Parameters) to a single ApResult.

reifyTree :: forall env result a. (Parameter a, Monad env, Typeable env, Typeable result) => Tree a -> Either (ApResult env a) (NonEmpty (env result)) Source #

Evaluates a Tree of Parameters to a value of type "env result" if successful, or the application information if not. Will automatically lift Dynamic functions and arguments into the env monad as needed—if this is undesirable use pureReifyTree.

pureReifyTree :: forall result a. (Parameter a, Typeable result) => Tree a -> Either (ApResultPure a) (NonEmpty result) Source #

Evaluates a Tree of Parameters to a value of type "result" if successful, or the application information if not.

reifyList Source #

Arguments

:: (Parameter a, Monad env, Typeable env, Typeable result) 
=> a

function

-> [a]

arguments

-> Either (ApResult env a) (NonEmpty (env result)) 

Evaluates the given function (as a Parameter) applied to a list of arguments (also as Parameters) to a value of type "env result" if successful, or the application information if not. Will automatically lift Dynamic functions and arguments into the env monad as needed—if this is undesirable use pureReifyList.

pureReifyList :: forall result a. (Parameter a, Typeable result) => a -> [a] -> Either (ApResultPure a) (NonEmpty result) Source #

Evaluates the given function (as a Parameter) applied to a list of arguments (also as Parameters) to a value of type "result" if successful, or the application information if not.