hasklepias-0.21.0: embedded DSL for defining epidemiologic cohorts
Copyright(c) NoviSci Inc 2020
LicenseBSD3
Maintainerbsaul@novisci.com
Safe HaskellNone
LanguageHaskell2010

Hasklepias

Description

 
Synopsis

Documentation

Hasklepias is an embedded domain specific language (eDSL) written in Haskell. To get started, then, you'll need to install the Haskell toolchain, especially the Glasgow Haskell Compiler (GHC) and the building and packaging system cabal, for which you can use the ghcup utility.

You can use any development environment you choose, but for maximum coding pleasure, you should install the Haskell language server (hsl). This can be installed using ghcup. Some integrated development environments, such as [Visual Studio Code](https:/code.visualstudio.com, have [excellent hsl integration](https:/marketplace.visualstudio.comitems?itemName=haskell.haskell).

In summary,

  curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
  • Inspect your toolchain installation using ghcup list. You will need ghc (>= 8.10.4) , hls (>= 1.2), and cabal (>= 3.4) installed.
  • Upgrade toolchain components as necesarry. For example:
  ghcup install ghc {ghcVersion}
  ghcup set ghc {ghcVersion}
  ghcup install cabal {cabalVersion}
  ghcup set cabal {cabalVersion} 
  • Setup your IDE. (e.g. in Visual Studio, you'll want to install the Haskell extension.

Getting started in Haskell

Since Hasklepias is written in Haskell, you'll need to understand the syntax of Haskell function and a few concepts. The Haskell language is over 30 years old and has many, many features. Here are a few resources:

Interacting with the examples (using GHCi)

To run the examples interactively, open a ghci session with:

cabal repl hasklepias:examples 

In ghci you have access to all exposed functions in hasklepias, interval-algebra, and those in the examples folder.

Event Data

Events depend heavily on the interval-algebra library. See that pacakge's documentation for information about the types and functions for working with intervals.

module EventData

Working with Features

A Feature is a type parametrized by two types: name and d. The type d here stands for "data", which then parametrizes the FeatureData type which is the singular value which a Feature contains. The d here can be almost anything and need not be a scalar, for example, all the following are valid types for d:

The name type a bit special: it does not appear on the right-hand side of the `=`. In type-theory parlance, name is a phantom type. We'll see in a bit how this can be useful. For now, think of the name as the name of a variable as you would in most programming languages. To summarize, a Feature 's type constructor takes two arguments (name and d), but its *value* constructor (MkFeature) takes a single value of type FeatureData d.

Values of the FeatureData type contain the data we're ultimately interested in analyzing or passing along to downstream applications. However, a FeatureData value does not simply contain data of type d. The type allows for the possibility of missingness, failures, or errors by using the Either type. A value of a FeatureData, then, is either a Left MissingReason or a Right d.

The use of Either has important implications when defining Features, as we will see. Now that we know the internals of a Feature, how do we create Feature s? There are two ways to create features: (1) purely lifting data into a Feature or (2) writing a Definition: a function that defines a Feature based on other Features.

The first method is a way to get data directly into a Feature. Fhe following function takes a list of Events and makes a Feature of them:

allEvents :: [Event Day] -> Feature "allEvents" [Event Day]
allEvents = pure

The pure lifting is generally used to lift a subject's input data into a Feature, so that other features can be defined from a subject's data. Feature s are derived from other Features by the Definition type. Specifically, Definition is a type which contains a function which maps Feature inputs to a Feature output, for example:

myDef :: Definition (Feature "a" Int -> Feature "b" Bool)
myDef = define (x -> if x > 0 then True else False)

A Definition is created by the define (or defineA) function. One may ask why define is necessary, and we don't directly define the function (Feature "a" Int -> Feature "b" Bool) directly. What may not be obvious in the above, is that x is type Int not Feature "a" Int and the return type is Bool not Feature "b" Bool. The define function and Definition type do the magic of lifting these types to the Feature level. To see this, in the following, myDef2 is equivalent to myDef:

intToBool :: Int -> Bool
intToBool x = if x > 0 then True else False)

myDef2 :: Definition (Feature "a" Int -> Feature "b" Bool)
myDef2 = define intToBoo

The define function, then, let's us focus on the *logic* of our Features without needing to worry handling the error cases. If we were to write a function with signature Feature "a" Int -> Feature "b" Bool directly, it would look something like:

myFeat :: Feature "a" Int -> Feature "b" Bool
myFeat (MkFeature (MkFeatureData (Left r))) = MkFeature (MkFeatureData (Left r))
myFeat (MkFeature (MkFeatureData (Right x))) = MkFeature (MkFeatureData (Right $ intToBool x))

One would need to pattern match all the possible types of inputs, which gets more complicated as the number of inputs increases. As an aside, since Features are [Functors]( https://hackage.haskell.org/package/base-4.15.0.0/docs/Data-Functor.html), one could instead write:

myFeat :: Feature "a" Int -> Feature "b" Bool
myFeat = fmap intToBool

This would require understanding how Functors and similar structures are used. The define and defineA functions provide a common interface to these structures without needing to understand the details.

Evaluating Definitions

To evaluate a Definition, we use the eval function. Consider the following example. The input data is a list of Ints if the list is empty (null), this is considered an error in feat1. If the list has more than 3 elements, then in feat2, the sum is computed; otherwise 0 is returned.

featInts :: [Int] -> Feature "someInts" [Int]
featInts = pure

feat1 :: Definition (Feature "someInts" [Int] -> Feature "hasMoreThan3" Bool)
feat1 = defineA
  (ints -> if null ints then makeFeature (missingBecause $ Other "no data")
           else makeFeature $ featureDataR (length ints > 3))

feat2 :: Definition (
      Feature "hasMoreThan3" Bool
  -> Feature "someInts" [Int]
  -> Feature "sum" Int)
feat2 = define (b ints -> if b then sum ints else 0)

ex0 = featInts []
ex0a = eval feat1 ex0 -- MkFeature (MkFeatureData (Left (Other "no data")))
ex0b = eval feat2 (ex0a, ex0) -- MkFeature (MkFeatureData (Left (Other "no data")))

ex1 = featInts [3, 8]
ex1a = eval feat1 ex1 -- MkFeature (MkFeatureData (Right False))
ex1b = eval feat2 (ex1a, ex1) -- MkFeature (MkFeatureData (Right 0))

ex2 = featInts [1..4]
ex2a = eval feat1 ex2 -- MkFeature (MkFeatureData (Right True))
ex2b = eval feat2 (ex2a, ex2) -- MkFeature (MkFeatureData (Right 10))

Note the value of ex0b. It is a Left because the value of ex0a is a Left; in other words, errors propogate along Features. If a given Feature's dependency is a Left then that Feature will also be Left. A Feature's internal Either structure has important implications for designing Features and performance. Capturing an error in a Left is a way to prevent downstream dependencies from needing to be computed.

Type Safety of Features

In describing the Feature type, the utility of having the name as a type may not have been clear. To clarify, consider the following example:

x :: Feature "someInt" Natural
x = pure 39

y :: Feature "age" Natural
y = pure 43

f :: Definition (Feature "age" Natural -> Feature "isOld" Bool)
f = define (>= 39)

fail = eval f x 
pass = eval f y

In the example, fail does not compile because "someInt" is not "age", even though both the data type are Natural.

Creating Features

Features and FeatureData

data FeatureData d Source #

The FeatureData type is a container for an (almost) arbitrary type d that can have a "failed" or "missing" state. The failure is represented by the Left of an Either, while the data d is contained in the Either's Right.

To construct a successful value, use featureDataR. A missing value can be constructed with featureDataL or its synonym missingBecause.

Instances

Instances details
Monad FeatureData Source # 
Instance details

Defined in Features.Compose

Methods

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

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

return :: a -> FeatureData a #

Functor FeatureData Source #

Transform (fmap) FeatureData of one type to another.

>>> x = featureDataR (1 :: P.Int)
>>> :type x
>>> :type ( fmap show x )
x :: FeatureData Int
( fmap show x ) :: FeatureData String

Note that Left values are carried along while the type changes:

>>> x = ( featureDataL InsufficientData ) :: FeatureData P.Int
>>> :type x
>>> x
>>> :type ( fmap show x )
>>> fmap show x
x :: FeatureData Int
MkFeatureData {getFeatureData = Left InsufficientData}
( fmap show x ) :: FeatureData String
MkFeatureData {getFeatureData = Left InsufficientData}
Instance details

Defined in Features.Compose

Methods

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

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

Applicative FeatureData Source # 
Instance details

Defined in Features.Compose

Methods

pure :: a -> FeatureData a #

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

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

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

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

Foldable FeatureData Source # 
Instance details

Defined in Features.Compose

Methods

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

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

foldMap' :: Monoid m => (a -> m) -> FeatureData a -> m #

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

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

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

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

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

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

toList :: FeatureData a -> [a] #

null :: FeatureData a -> Bool #

length :: FeatureData a -> Int #

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

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

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

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

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

Traversable FeatureData Source # 
Instance details

Defined in Features.Compose

Methods

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

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

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

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

Eq d => Eq (FeatureData d) Source # 
Instance details

Defined in Features.Compose

Show d => Show (FeatureData d) Source # 
Instance details

Defined in Features.Compose

Generic (FeatureData d) Source # 
Instance details

Defined in Features.Compose

Associated Types

type Rep (FeatureData d) :: Type -> Type #

Methods

from :: FeatureData d -> Rep (FeatureData d) x #

to :: Rep (FeatureData d) x -> FeatureData d #

ToJSON d => ToJSON (FeatureData d) Source # 
Instance details

Defined in Features.Output

type Rep (FeatureData d) Source # 
Instance details

Defined in Features.Compose

type Rep (FeatureData d) = D1 ('MetaData "FeatureData" "Features.Compose" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkFeatureData" 'PrefixI 'True) (S1 ('MetaSel ('Just "getFeatureData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Either MissingReason d))))

data MissingReason Source #

Defines the reasons that a FeatureData value may be missing. Can be used to indicate the reason that a Feature's data was unable to be derived or does not need to be derived.

Constructors

InsufficientData

Insufficient information available to derive data.

Other Text

User provided reason for missingness

Instances

Instances details
Eq MissingReason Source # 
Instance details

Defined in Features.Compose

Show MissingReason Source # 
Instance details

Defined in Features.Compose

Generic MissingReason Source # 
Instance details

Defined in Features.Compose

Associated Types

type Rep MissingReason :: Type -> Type #

ToJSON MissingReason Source # 
Instance details

Defined in Features.Output

type Rep MissingReason Source # 
Instance details

Defined in Features.Compose

type Rep MissingReason = D1 ('MetaData "MissingReason" "Features.Compose" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "InsufficientData" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Other" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

data KnownSymbol name => Feature name d Source #

The Feature is an abstraction for named data, where the name is a *type*. Essentially, it is a container for FeatureData that assigns a name to the data.

Except when using pure to lift data into a Feature, Features can only be derived from other Feature via a Definition.

Instances

Instances details
Define a (Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

define :: a -> Definition (Feature n0 a) Source #

Monad (Feature name) Source # 
Instance details

Defined in Features.Compose

Methods

(>>=) :: Feature name a -> (a -> Feature name b) -> Feature name b #

(>>) :: Feature name a -> Feature name b -> Feature name b #

return :: a -> Feature name a #

Functor (Feature name) Source # 
Instance details

Defined in Features.Compose

Methods

fmap :: (a -> b) -> Feature name a -> Feature name b #

(<$) :: a -> Feature name b -> Feature name a #

Applicative (Feature name) Source # 
Instance details

Defined in Features.Compose

Methods

pure :: a -> Feature name a #

(<*>) :: Feature name (a -> b) -> Feature name a -> Feature name b #

liftA2 :: (a -> b -> c) -> Feature name a -> Feature name b -> Feature name c #

(*>) :: Feature name a -> Feature name b -> Feature name b #

(<*) :: Feature name a -> Feature name b -> Feature name a #

Foldable (Feature name) Source # 
Instance details

Defined in Features.Compose

Methods

fold :: Monoid m => Feature name m -> m #

foldMap :: Monoid m => (a -> m) -> Feature name a -> m #

foldMap' :: Monoid m => (a -> m) -> Feature name a -> m #

foldr :: (a -> b -> b) -> b -> Feature name a -> b #

foldr' :: (a -> b -> b) -> b -> Feature name a -> b #

foldl :: (b -> a -> b) -> b -> Feature name a -> b #

foldl' :: (b -> a -> b) -> b -> Feature name a -> b #

foldr1 :: (a -> a -> a) -> Feature name a -> a #

foldl1 :: (a -> a -> a) -> Feature name a -> a #

toList :: Feature name a -> [a] #

null :: Feature name a -> Bool #

length :: Feature name a -> Int #

elem :: Eq a => a -> Feature name a -> Bool #

maximum :: Ord a => Feature name a -> a #

minimum :: Ord a => Feature name a -> a #

sum :: Num a => Feature name a -> a #

product :: Num a => Feature name a -> a #

Traversable (Feature name) Source # 
Instance details

Defined in Features.Compose

Methods

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

sequenceA :: Applicative f => Feature name (f a) -> f (Feature name a) #

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

sequence :: Monad m => Feature name (m a) -> m (Feature name a) #

Eq d => Eq (Feature name d) Source # 
Instance details

Defined in Features.Compose

Methods

(==) :: Feature name d -> Feature name d -> Bool #

(/=) :: Feature name d -> Feature name d -> Bool #

(KnownSymbol name, Show a) => Show (Feature name a) Source # 
Instance details

Defined in Features.Compose

Methods

showsPrec :: Int -> Feature name a -> ShowS #

show :: Feature name a -> String #

showList :: [Feature name a] -> ShowS #

(Typeable d, KnownSymbol n, ToJSON d, HasAttributes n d) => ToJSON (Feature n d) Source # 
Instance details

Defined in Features.Output

(KnownSymbol n, Show d, ToJSON d, Typeable d, HasAttributes n d) => ShapeOutput (Feature n d) Source # 
Instance details

Defined in Features.Output

DefineA (e -> d -> c -> b -> Feature n0 a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

defineA :: (e -> d -> c -> b -> Feature n0 a) -> Definition (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

DefineA (d -> c -> b -> Feature n0 a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

defineA :: (d -> c -> b -> Feature n0 a) -> Definition (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

DefineA (c -> b -> Feature n0 a) (Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

defineA :: (c -> b -> Feature n0 a) -> Definition (Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

DefineA (b -> Feature n0 a) (Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

defineA :: (b -> Feature n0 a) -> Definition (Feature n1 b -> Feature n0 a) Source #

Define (e -> d -> c -> b -> a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

define :: (e -> d -> c -> b -> a) -> Definition (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

Define (d -> c -> b -> a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

define :: (d -> c -> b -> a) -> Definition (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

Define (c -> b -> a) (Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

define :: (c -> b -> a) -> Definition (Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

Define (b -> a) (Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

define :: (b -> a) -> Definition (Feature n1 b -> Feature n0 a) Source #

type F n a = Feature n a Source #

Type synonym for Feature.

data FeatureN d Source #

The FeatureN type is similar to Feature where the name is included as a Text field. This type is mainly for internal purposes in order to collect Features of the same type d into a homogeneous container like a List.

Instances

Instances details
Eq d => Eq (FeatureN d) Source # 
Instance details

Defined in Features.Compose

Methods

(==) :: FeatureN d -> FeatureN d -> Bool #

(/=) :: FeatureN d -> FeatureN d -> Bool #

Show d => Show (FeatureN d) Source # 
Instance details

Defined in Features.Compose

Methods

showsPrec :: Int -> FeatureN d -> ShowS #

show :: FeatureN d -> String #

showList :: [FeatureN d] -> ShowS #

featureDataL :: MissingReason -> FeatureData d Source #

Creates a missing FeatureData.

>>> featureDataL (Other "no good reason") :: FeatureData P.Int
MkFeatureData (Left (Other "no good reason"))
>>> featureDataL (Other "no good reason") :: FeatureData Text
MkFeatureData (Left (Other "no good reason"))

featureDataR :: d -> FeatureData d Source #

Creates a non-missing FeatureData. Since FeatureData is an instance of Applicative, pure is also a synonym of for featureDataR.

>>> featureDataR "aString"
MkFeatureData (Right "aString")
>>> featureDataR (1 :: P.Int)
MkFeatureData (Right 1)
>>> featureDataR ("aString", (1 :: P.Int))
MkFeatureData (Right ("aString",1))

makeFeature :: KnownSymbol name => FeatureData d -> Feature name d Source #

A utility for constructing a Feature from FeatureData. Since name is a type, you may need to annotate the type when using this function.

>>> makeFeature (pure "test") :: Feature "dummy" Text
"dummy": MkFeatureData {getFeatureData = Right "test"}

getFeatureData :: FeatureData d -> Either MissingReason d Source #

Unwrap FeatureData.

getFData :: Feature name d -> FeatureData d Source #

Gets the FeatureData from a Feature.

getData :: Feature n d -> Either MissingReason d Source #

A utility for getting the (inner) FeatureData content of a Feature.

getDataN :: FeatureN d -> FeatureData d Source #

Get the data of a FeatureN

getNameN :: FeatureN d -> Text Source #

Get the name of a FeatureN.

nameFeature :: forall name d. KnownSymbol name => Feature name d -> FeatureN d Source #

A utility for converting a Feature to FeatureN.

Feature Definitions

data Definition d where Source #

A Definition can be thought of as a lifted function. Specifically, the define function takes an arbitrary function (currently up to three arguments) and returns a Defintion where the arguments have been lifted to a new domain.

For example, here we take f and lift to to a function of Features.

f :: Int -> String -> Bool
f i s 
  | 1 "yes" = True
  | otherwise = FALSE

myFeature :: Definition (Feature A Int -> Feature B String -> Feature C Bool )
myFeature = define f

See eval for evaluating Defintions.

Constructors

Pure :: a -> Definition (F n0 a) 
D1 :: (b -> a) -> Definition (F n1 b -> F n0 a) 
D1A :: (b -> F n0 a) -> Definition (F n1 b -> F n0 a) 
D1C :: (a2 -> a1 -> a) -> Definition (F n1 b -> F n02 a2) -> Definition (F n1 b -> F n01 a1) -> Definition (F n1 b -> F n0 a) 
D2 :: (c -> b -> a) -> Definition (F n2 c -> F n1 b -> F n0 a) 
D2A :: (c -> b -> F n0 a) -> Definition (F n2 c -> F n1 b -> F n0 a) 
D2C :: (a2 -> a1 -> a) -> Definition (F n2 c -> F n1 b -> F n02 a2) -> Definition (F n2 c -> F n1 b -> F n01 a1) -> Definition (F n2 c -> F n1 b -> F n0 a) 
D3 :: (d -> c -> b -> a) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a) 
D3A :: (d -> c -> b -> F n0 a) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a) 
D3C :: (a2 -> a1 -> a) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n02 a2) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n01 a1) -> Definition (F n3 d -> F n2 c -> F n1 b -> F n0 a) 
D4 :: (e -> d -> c -> b -> a) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a) 
D4A :: (e -> d -> c -> b -> F n0 a) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a) 
D4C :: (a2 -> a1 -> a) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n02 a2) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n01 a1) -> Definition (F n4 e -> F n3 d -> F n2 c -> F n1 b -> F n0 a) 

class Define inputs def | def -> inputs where Source #

Define (and 'DefineA) provide a means to create new Definitions via define (defineA). The define function takes a single function input and returns a lifted function. For example,

f :: Int -> String -> Bool
f i s 
  | 1 "yes" = True
  | otherwise = FALSE

myFeature :: Definition (Feature A Int -> Feature B String -> Feature C Bool )
myFeature = define f

The defineA function is similar, except that the return type of the input function is already lifted. In the example below, an input of Nothing is considered a missing state:

f :: Int -> Maybe String -> Feature C Bool
f i s 
  | 1 (Just "yes")   = pure True
  | _ (Just _ )      = pure False -- False for any Int and any (Just String)
  | otherwise        = pure $ missingBecause InsufficientData -- missing if no string

myFeature :: Definition (Feature A Int -> Feature B String -> Feature C Bool )
myFeature = defineA f

Methods

define :: inputs -> Definition def Source #

Instances

Instances details
Define a (Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

define :: a -> Definition (Feature n0 a) Source #

Define (e -> d -> c -> b -> a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

define :: (e -> d -> c -> b -> a) -> Definition (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

Define (d -> c -> b -> a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

define :: (d -> c -> b -> a) -> Definition (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

Define (c -> b -> a) (Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

define :: (c -> b -> a) -> Definition (Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

Define (b -> a) (Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

define :: (b -> a) -> Definition (Feature n1 b -> Feature n0 a) Source #

class DefineA inputs def | def -> inputs where Source #

See Define.

Methods

defineA :: inputs -> Definition def Source #

Instances

Instances details
DefineA (e -> d -> c -> b -> Feature n0 a) (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

defineA :: (e -> d -> c -> b -> Feature n0 a) -> Definition (Feature n4 e -> Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

DefineA (d -> c -> b -> Feature n0 a) (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

defineA :: (d -> c -> b -> Feature n0 a) -> Definition (Feature n3 d -> Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

DefineA (c -> b -> Feature n0 a) (Feature n2 c -> Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

defineA :: (c -> b -> Feature n0 a) -> Definition (Feature n2 c -> Feature n1 b -> Feature n0 a) Source #

DefineA (b -> Feature n0 a) (Feature n1 b -> Feature n0 a) Source # 
Instance details

Defined in Features.Compose

Methods

defineA :: (b -> Feature n0 a) -> Definition (Feature n1 b -> Feature n0 a) Source #

type Def d = Definition d Source #

Type synonym for Definition.

eval :: Definition d -> d Source #

Evaluate a Definition. Note that (currently), the second argument of eval is a *tuple* of inputs. For example,

f :: Int -> String -> Bool
f i s 
  | 1 "yes" = True
  | otherwise = FALSE

myFeature :: Definition (Feature A Int -> Feature B String -> Feature C Bool )
myFeature = define f

a :: Feature A Int
a = pure 1

b :: Feature B String
b = pure "yes"

c = eval myFeature a b

Adding Attributes to Features

data Attributes Source #

A data type for holding attritbutes of Features. This type and the HasAttributes are likely to change in future versions.

Instances

Instances details
Eq Attributes Source # 
Instance details

Defined in Features.Attributes

Show Attributes Source # 
Instance details

Defined in Features.Attributes

Generic Attributes Source # 
Instance details

Defined in Features.Attributes

Associated Types

type Rep Attributes :: Type -> Type #

ToJSON Attributes Source # 
Instance details

Defined in Features.Output

type Rep Attributes Source # 
Instance details

Defined in Features.Attributes

type Rep Attributes = D1 ('MetaData "Attributes" "Features.Attributes" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "MkAttributes" 'PrefixI 'True) ((S1 ('MetaSel ('Just "getShortLabel") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "getLongLabel") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)) :*: (S1 ('MetaSel ('Just "getDerivation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "getPurpose") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Purpose))))

data Role Source #

A type to identify a feature's role in a research study.

Instances

Instances details
Eq Role Source # 
Instance details

Defined in Features.Attributes

Methods

(==) :: Role -> Role -> Bool #

(/=) :: Role -> Role -> Bool #

Ord Role Source # 
Instance details

Defined in Features.Attributes

Methods

compare :: Role -> Role -> Ordering #

(<) :: Role -> Role -> Bool #

(<=) :: Role -> Role -> Bool #

(>) :: Role -> Role -> Bool #

(>=) :: Role -> Role -> Bool #

max :: Role -> Role -> Role #

min :: Role -> Role -> Role #

Show Role Source # 
Instance details

Defined in Features.Attributes

Methods

showsPrec :: Int -> Role -> ShowS #

show :: Role -> String #

showList :: [Role] -> ShowS #

Generic Role Source # 
Instance details

Defined in Features.Attributes

Associated Types

type Rep Role :: Type -> Type #

Methods

from :: Role -> Rep Role x #

to :: Rep Role x -> Role #

ToJSON Role Source # 
Instance details

Defined in Features.Output

type Rep Role Source # 
Instance details

Defined in Features.Attributes

type Rep Role = D1 ('MetaData "Role" "Features.Attributes" "hasklepias-0.21.0-inplace" 'False) ((C1 ('MetaCons "Outcome" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Covariate" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Exposure" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Competing" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Weight" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Intermediate" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Unspecified" 'PrefixI 'False) (U1 :: Type -> Type))))

data Purpose Source #

A type to identify a feature's purpose

Constructors

MkPurpose 

Fields

Instances

Instances details
Eq Purpose Source # 
Instance details

Defined in Features.Attributes

Methods

(==) :: Purpose -> Purpose -> Bool #

(/=) :: Purpose -> Purpose -> Bool #

Show Purpose Source # 
Instance details

Defined in Features.Attributes

Generic Purpose Source # 
Instance details

Defined in Features.Attributes

Associated Types

type Rep Purpose :: Type -> Type #

Methods

from :: Purpose -> Rep Purpose x #

to :: Rep Purpose x -> Purpose #

ToJSON Purpose Source # 
Instance details

Defined in Features.Output

type Rep Purpose Source # 
Instance details

Defined in Features.Attributes

type Rep Purpose = D1 ('MetaData "Purpose" "Features.Attributes" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "MkPurpose" 'PrefixI 'True) (S1 ('MetaSel ('Just "getRole") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set Role)) :*: S1 ('MetaSel ('Just "getTags") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set Text))))

class KnownSymbol name => HasAttributes name d where Source #

A typeclass providing a single method for defining Attributes for a Feature.

Minimal complete definition

Nothing

Methods

getAttributes :: f name d -> Attributes Source #

emptyAttributes :: Attributes Source #

An empty attributes value.

basicAttributes Source #

Arguments

:: Text

short label

-> Text

long label

-> [Role]

purpose roles

-> [Text]

purpose tags

-> Attributes 

Create attributes with just short label, long label, roles, and tags.

emptyPurpose :: Purpose Source #

An empty purpose value.

Exporting Features

data Featureable Source #

Existential type to hold features, which allows for Features to be put into a homogeneous list.

Constructors

forall d.(Show d, ToJSON d, ShapeOutput d) => MkFeatureable d Attributes 

packFeature :: (KnownSymbol n, Show d, ToJSON d, Typeable d, HasAttributes n d) => Feature n d -> Featureable Source #

Pack a feature into a Featurable.

getFeatureableAttrs :: Featureable -> Attributes Source #

Get the Attributes from a Featureable.

data Featureset Source #

A Featureset is a (non-empty) list of Featureable.

newtype FeaturesetList Source #

A newtype wrapper for a NonEmpty Featureset.

Instances

Instances details
Show FeaturesetList Source # 
Instance details

Defined in Features.Featureset

featureset :: NonEmpty Featureable -> Featureset Source #

Constructor of a Featureset.

getFeatureset :: Featureset -> NonEmpty Featureable Source #

Constructor of a Featureset.

getFeaturesetAttrs :: Featureset -> NonEmpty Attributes Source #

Gets a list of Attributes from a Featureset, one Attributes per Featureable.

getFeaturesetList :: FeaturesetList -> NonEmpty Featureset Source #

Constructor of a Featureset.

tpose :: FeaturesetList -> FeaturesetList Source #

Transpose a FeaturesetList

class ToJSON a => ShapeOutput a where Source #

A class that provides methods for transforming some type to an OutputShape.

data OutputShape d Source #

A type used to determine the output shape of a Feature.

Instances

Instances details
Show (OutputShape a) Source # 
Instance details

Defined in Features.Output

ToJSON (OutputShape a) Source # 
Instance details

Defined in Features.Output

Feature definition builders

A collection of pre-defined functions which build common feature definitions used in epidemiologic cohorts.

buildIsEnrolled Source #

Arguments

:: (Intervallic i0 a, Monoid (container (Interval a)), Applicative container, Witherable container) 
=> Predicate (Event a)

The predicate to filter to Enrollment events (e.g. isEnrollment)

-> Definition (Feature indexName (Index i0 a) -> Feature eventsName (container (Event a)) -> Feature varName Status) 

Is Enrolled

TODO: describe this

buildContinuousEnrollment Source #

Arguments

:: (Monoid (container (Interval a)), Monoid (container (Maybe (Interval a))), Applicative container, Witherable container, IntervalSizeable a b) 
=> (Index i0 a -> AssessmentInterval a)

function which maps index interval to interval in which to assess enrollment

-> Predicate (Event a)

The predicate to filter to Enrollment events (e.g. isEnrollment)

-> b

duration of allowable gap between enrollment intervals

-> Definition (Feature indexName (Index i0 a) -> Feature eventsName (container (Event a)) -> Feature prevName Status -> Feature varName Status) 

Continuous Enrollment

TODO: describe this

buildNofX Source #

Arguments

:: (Intervallic i a, Witherable container) 
=> (Bool -> outputType)

casting function

-> Natural

minimum number of cases

-> (Index i a -> AssessmentInterval a)

function to transform a Index to an AssessmentInterval

-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)

interval predicate

-> Predicate (Event a)

a predicate on events

-> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName outputType) 

Do N events relating to the AssessmentInterval in some way the satisfy the given predicate?

buildNofXBool Source #

Arguments

:: (Intervallic i a, Witherable container) 
=> Natural

minimum number of cases

-> (Index i a -> AssessmentInterval a)

function to transform a Index to an AssessmentInterval

-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)

interval predicate

-> Predicate (Event a)

a predicate on events

-> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Bool) 

buildNofX specialized to return Bool.

buildNofXBinary :: (Intervallic i a, Witherable container) => Natural -> (Index i a -> AssessmentInterval a) -> ComparativePredicateOf2 (AssessmentInterval a) (Event a) -> Predicate (Event a) -> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Binary) Source #

buildNofX specialized to return Binary.

buildNofXBinaryConcurBaseline Source #

Arguments

:: (Intervallic i0 a, Witherable t, IntervalSizeable a b, Baseline i0 a) 
=> Natural

minimum number of events.

-> b

duration of baseline (passed to makeBaselineFromIndex)

-> Predicate (Event a) 
-> Definition (Feature indexName (Index i0 a) -> Feature eventsName (t (Event a)) -> Feature varName Binary) 

buildNofXBinary specialized to filter to events that concur with an AssessmentInterval created by makeBaselineFromIndex of a specified duration and a provided Predicate.

buildNofConceptsBinaryConcurBaseline Source #

Arguments

:: (Intervallic i0 a, Witherable t, IntervalSizeable a b, Baseline i0 a) 
=> Natural

minimum number of events.

-> b

duration of baseline (passed to makeBaselineFromIndex)

-> [Text]

list of Concepts passed to containsConcepts

-> Definition (Feature indexName (Index i0 a) -> Feature eventsName (t (Event a)) -> Feature varName Binary) 

buildNofXBinary specialized to filter to events that concur with an AssessmentInterval created by makeBaselineFromIndex of a specified duration and that have a given set of Concepts.

buildNofXWithGap Source #

Arguments

:: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) 
=> (Bool -> outputType) 
-> Natural

the minimum number of gaps

-> b

the minimum duration of a gap

-> (Index i a -> AssessmentInterval a) 
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a) 
-> Predicate (Event a) 
-> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName outputType) 

Are there N gaps of at least the given duration between any pair of events that relate to the AssessmentInterval by the given relation and the satisfy the given predicate?

buildNofXWithGapBool Source #

Arguments

:: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) 
=> Natural

the minimum number of gaps

-> b

the minimum duration of a gap

-> (Index i a -> AssessmentInterval a) 
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a) 
-> Predicate (Event a) 
-> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Bool) 

buildNofXWithGap specialized to return Bool.

buildNofXWithGapBinary Source #

Arguments

:: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) 
=> Natural

the minimum number of gaps

-> b

the minimum duration of a gap

-> (Index i a -> AssessmentInterval a) 
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a) 
-> Predicate (Event a) 
-> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Binary) 

buildNofXWithGap specialized to return Binary.

buildNofXOrNofYWithGap Source #

Arguments

:: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) 
=> (outputType -> outputType -> outputType) 
-> (Bool -> outputType) 
-> Natural

count passed to buildNofX

-> Predicate (Event a) 
-> Natural

the minimum number of gaps passed to buildNofXWithGap

-> b

the minimum duration of a gap passed to buildNofXWithGap

-> (Index i a -> AssessmentInterval a) 
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a) 
-> Predicate (Event a) 
-> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName outputType) 

Is either buildNofX or buildNofXWithGap satisfied

buildNofXOrNofYWithGapBool Source #

Arguments

:: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) 
=> Natural

count passed to buildNofX

-> Predicate (Event a) 
-> Natural

the minimum number of gaps passed to buildNofXWithGap

-> b

the minimum duration of a gap passed to buildNofXWithGap

-> (Index i a -> AssessmentInterval a) 
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a) 
-> Predicate (Event a) 
-> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Bool) 

buildNofXOrNofYWithGap specialized to return Bool.

buildNofXOrNofYWithGapBinary Source #

Arguments

:: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a, Witherable container) 
=> Natural

count passed to buildNofX

-> Predicate (Event a) 
-> Natural

the minimum number of gaps passed to buildNofXWithGap

-> b

the minimum duration of a gap passed to buildNofXWithGap

-> (Index i a -> AssessmentInterval a) 
-> ComparativePredicateOf2 (AssessmentInterval a) (Event a) 
-> Predicate (Event a) 
-> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName Binary) 

buildNofXOrNofYWithGap specialized to return Binary.

buildNofUniqueBegins Source #

Arguments

:: (Intervallic i a, IntervalSizeable a b, Witherable container) 
=> (Index i a -> AssessmentInterval a)

function to transform a Index to an AssessmentInterval

-> ComparativePredicateOf2 (AssessmentInterval a) (Event a)

interval predicate

-> Predicate (Event a)

a predicate on events

-> Definition (Feature indexName (Index i a) -> Feature eventsName (container (Event a)) -> Feature varName [(EventTime b, Count)]) 

Do N events relating to the AssessmentInterval in some way the satisfy the given predicate?

Utilities for defining Features from Events

Much of logic needed to define features from events depends on the interval-algebra library. Its main functions and types are re-exported in Hasklepias, but the documentation can be found on hackage.

Container predicates

isNotEmpty :: [a] -> Bool Source #

Is the input list empty?

atleastNofX Source #

Arguments

:: Int

n

-> [Text]

x

-> Events a 
-> Bool 

Does Events have at least n events with any of the Concept in x.

anyGapsWithinAtLeastDuration Source #

Arguments

:: (IntervalSizeable a b, Intervallic i0 a, IntervalCombinable i1 a, Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))), Applicative t, Witherable t) 
=> b

duration of gap

-> i0 a

within this interval

-> t (i1 a) 
-> Bool 

Within a provided spanning interval, are there any gaps of at least the specified duration among the input intervals?

allGapsWithinLessThanDuration Source #

Arguments

:: (IntervalSizeable a b, Intervallic i0 a, IntervalCombinable i1 a, Monoid (t (Interval a)), Monoid (t (Maybe (Interval a))), Applicative t, Witherable t) 
=> b

duration of gap

-> i0 a

within this interval

-> t (i1 a) 
-> Bool 

Within a provided spanning interval, are all gaps less than the specified duration among the input intervals?

>>> allGapsWithinLessThanDuration 30 (beginerval 100 (0::Int)) [beginerval 5 (-1), beginerval 99 10]
True

Finding occurrences of concepts

nthConceptOccurrence Source #

Arguments

:: Filterable f 
=> (f (Event a) -> Maybe (Event a))

function used to select a single event

-> [Text] 
-> f (Event a) 
-> Maybe (Event a) 

Filter Events to a single Maybe Event, based on a provided function, with the provided concepts. For example, see firstConceptOccurrence and lastConceptOccurrence.

firstConceptOccurrence :: Witherable f => [Text] -> f (Event a) -> Maybe (Event a) Source #

Finds the *first* occurrence of an Event with at least one of the concepts. Assumes the input Events list is appropriately sorted.

Reshaping containers

allPairs :: Applicative f => f a -> f b -> f (a, b) Source #

Generate all pair-wise combinations from two lists.

pairs :: [a] -> [(a, a)] Source #

Generate all pair-wise combinations of a single list.

splitByConcepts :: Filterable f => [Text] -> [Text] -> f (Event a) -> (f (Event a), f (Event a)) Source #

Split an Events a into a pair of Events a. The first element contains events have any of the concepts in the first argument, similarly for the second element.

Create filters

makeConceptsFilter Source #

Arguments

:: Filterable f 
=> [Text]

the list of concepts by which to filter

-> f (Event a) 
-> f (Event a) 

Filter Events to those that have any of the provided concepts.

makePairedFilter :: Ord a => ComparativePredicateOf2 (i0 a) (PairedInterval b a) -> i0 a -> (b -> Bool) -> [PairedInterval b a] -> [PairedInterval b a] Source #

 

Manipulating Dates

yearFromDay :: Day -> Year Source #

Gets the Year from a Day.

Functions for manipulating intervals

lookback Source #

Arguments

:: (Intervallic i a, IntervalSizeable a b) 
=> b

lookback duration

-> i a 
-> Interval a 

Creates a new Interval of a provided lookback duration ending at the begin of the input interval.

>>> lookback 4 (beginerval 10 (1 :: Int))
(-3, 1)

lookahead Source #

Arguments

:: (Intervallic i a, IntervalSizeable a b) 
=> b

lookahead duration

-> i a 
-> Interval a 

Creates a new Interval of a provided lookahead duration beginning at the end of the input interval.

>>> lookahead 4 (beginerval 1 (1 :: Int))
(2, 6)

Misc functions

computeAgeAt :: Day -> Day -> Integer Source #

Compute the "age" in years between two calendar days. The difference between the days is rounded down.

pairGaps :: (Intervallic i a, IntervalSizeable a b, IntervalCombinable i a) => [i a] -> [Maybe b] Source #

Gets the durations of gaps (via 'IntervalAlgebra.(><)') between all pairs of the input.

newtype Occurrence what when Source #

A type containing the time and when something occurred

Constructors

MkOccurrence (what, EventTime when) 

Instances

Instances details
(Eq what, Eq when) => Eq (Occurrence what when) Source # 
Instance details

Defined in Hasklepias.Misc

Methods

(==) :: Occurrence what when -> Occurrence what when -> Bool #

(/=) :: Occurrence what when -> Occurrence what when -> Bool #

(OccurrenceReason r, Ord b) => Ord (Occurrence r b) Source # 
Instance details

Defined in Hasklepias.Misc

Methods

compare :: Occurrence r b -> Occurrence r b -> Ordering #

(<) :: Occurrence r b -> Occurrence r b -> Bool #

(<=) :: Occurrence r b -> Occurrence r b -> Bool #

(>) :: Occurrence r b -> Occurrence r b -> Bool #

(>=) :: Occurrence r b -> Occurrence r b -> Bool #

max :: Occurrence r b -> Occurrence r b -> Occurrence r b #

min :: Occurrence r b -> Occurrence r b -> Occurrence r b #

(Show what, Show when) => Show (Occurrence what when) Source # 
Instance details

Defined in Hasklepias.Misc

Methods

showsPrec :: Int -> Occurrence what when -> ShowS #

show :: Occurrence what when -> String #

showList :: [Occurrence what when] -> ShowS #

Generic (Occurrence what when) Source # 
Instance details

Defined in Hasklepias.Misc

Associated Types

type Rep (Occurrence what when) :: Type -> Type #

Methods

from :: Occurrence what when -> Rep (Occurrence what when) x #

to :: Rep (Occurrence what when) x -> Occurrence what when #

type Rep (Occurrence what when) Source # 
Instance details

Defined in Hasklepias.Misc

type Rep (Occurrence what when) = D1 ('MetaData "Occurrence" "Hasklepias.Misc" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkOccurrence" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (what, EventTime when))))

makeOccurrence :: OccurrenceReason what => what -> EventTime b -> Occurrence what b Source #

Create an Occurrence

getOccurrenceReason :: Occurrence what b -> what Source #

Get the reason for an Occurrence.

getOccurrenceTime :: Occurrence what b -> EventTime b Source #

Get the time of an Occurrence.

data CensoringReason cr or Source #

Sum type for possible censoring and outcome reasons, including administrative censoring.

Constructors

AdminCensor 
C cr 
O or 

Instances

Instances details
(Eq cr, Eq or) => Eq (CensoringReason cr or) Source # 
Instance details

Defined in Hasklepias.Misc

Methods

(==) :: CensoringReason cr or -> CensoringReason cr or -> Bool #

(/=) :: CensoringReason cr or -> CensoringReason cr or -> Bool #

(Show cr, Show or) => Show (CensoringReason cr or) Source # 
Instance details

Defined in Hasklepias.Misc

Generic (CensoringReason cr or) Source # 
Instance details

Defined in Hasklepias.Misc

Associated Types

type Rep (CensoringReason cr or) :: Type -> Type #

Methods

from :: CensoringReason cr or -> Rep (CensoringReason cr or) x #

to :: Rep (CensoringReason cr or) x -> CensoringReason cr or #

type Rep (CensoringReason cr or) Source # 
Instance details

Defined in Hasklepias.Misc

type Rep (CensoringReason cr or) = D1 ('MetaData "CensoringReason" "Hasklepias.Misc" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "AdminCensor" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "C" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 cr)) :+: C1 ('MetaCons "O" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 or))))

class (Ord a, Show a) => OccurrenceReason a Source #

A simple typeclass for making a type a "reason" for an event.

data CensoredOccurrence censors outcomes b Source #

A type to represent censored Occurrence.

Constructors

MkCensoredOccurrence 

Fields

Instances

Instances details
(Eq censors, Eq outcomes, Eq b) => Eq (CensoredOccurrence censors outcomes b) Source # 
Instance details

Defined in Hasklepias.Misc

Methods

(==) :: CensoredOccurrence censors outcomes b -> CensoredOccurrence censors outcomes b -> Bool #

(/=) :: CensoredOccurrence censors outcomes b -> CensoredOccurrence censors outcomes b -> Bool #

(OccurrenceReason c, OccurrenceReason o, Show b) => Show (CensoredOccurrence c o b) Source # 
Instance details

Defined in Hasklepias.Misc

Generic (CensoredOccurrence censors outcomes b) Source # 
Instance details

Defined in Hasklepias.Misc

Associated Types

type Rep (CensoredOccurrence censors outcomes b) :: Type -> Type #

Methods

from :: CensoredOccurrence censors outcomes b -> Rep (CensoredOccurrence censors outcomes b) x #

to :: Rep (CensoredOccurrence censors outcomes b) x -> CensoredOccurrence censors outcomes b #

type Rep (CensoredOccurrence censors outcomes b) Source # 
Instance details

Defined in Hasklepias.Misc

type Rep (CensoredOccurrence censors outcomes b) = D1 ('MetaData "CensoredOccurrence" "Hasklepias.Misc" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "MkCensoredOccurrence" 'PrefixI 'True) (S1 ('MetaSel ('Just "reason") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (CensoringReason censors outcomes)) :*: S1 ('MetaSel ('Just "time") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (MaybeCensored (EventTime b)))))

adminCensor :: EventTime b -> CensoredOccurrence c o b Source #

Creates an administratively censored occurrence.

Specifying and building cohorts

Defining Cohorts

newtype Subject d Source #

A subject is just a pair of ID and data.

Constructors

MkSubject (ID, d) 

Instances

Instances details
Functor Subject Source # 
Instance details

Defined in Cohort.Core

Methods

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

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

Eq d => Eq (Subject d) Source # 
Instance details

Defined in Cohort.Core

Methods

(==) :: Subject d -> Subject d -> Bool #

(/=) :: Subject d -> Subject d -> Bool #

Show d => Show (Subject d) Source # 
Instance details

Defined in Cohort.Core

Methods

showsPrec :: Int -> Subject d -> ShowS #

show :: Subject d -> String #

showList :: [Subject d] -> ShowS #

Generic (Subject d) Source # 
Instance details

Defined in Cohort.Core

Associated Types

type Rep (Subject d) :: Type -> Type #

Methods

from :: Subject d -> Rep (Subject d) x #

to :: Rep (Subject d) x -> Subject d #

FromJSON d => FromJSON (Subject d) Source # 
Instance details

Defined in Cohort.Core

type Rep (Subject d) Source # 
Instance details

Defined in Cohort.Core

type Rep (Subject d) = D1 ('MetaData "Subject" "Cohort.Core" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkSubject" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ID, d))))

type ID = Text Source #

A subject identifier. Currently, simply Text.

newtype Population d Source #

A population is a list of Subjects

Constructors

MkPopulation [Subject d] 

Instances

Instances details
Functor Population Source # 
Instance details

Defined in Cohort.Core

Methods

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

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

Eq d => Eq (Population d) Source # 
Instance details

Defined in Cohort.Core

Methods

(==) :: Population d -> Population d -> Bool #

(/=) :: Population d -> Population d -> Bool #

Show d => Show (Population d) Source # 
Instance details

Defined in Cohort.Core

Generic (Population d) Source # 
Instance details

Defined in Cohort.Core

Associated Types

type Rep (Population d) :: Type -> Type #

Methods

from :: Population d -> Rep (Population d) x #

to :: Rep (Population d) x -> Population d #

FromJSON d => FromJSON (Population d) Source # 
Instance details

Defined in Cohort.Core

type Rep (Population d) Source # 
Instance details

Defined in Cohort.Core

type Rep (Population d) = D1 ('MetaData "Population" "Cohort.Core" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkPopulation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Subject d])))

data ObsUnit d Source #

An observational unit is what a subject may be transformed into.

Constructors

MkObsUnit 

Fields

Instances

Instances details
Eq d => Eq (ObsUnit d) Source # 
Instance details

Defined in Cohort.Core

Methods

(==) :: ObsUnit d -> ObsUnit d -> Bool #

(/=) :: ObsUnit d -> ObsUnit d -> Bool #

Show d => Show (ObsUnit d) Source # 
Instance details

Defined in Cohort.Core

Methods

showsPrec :: Int -> ObsUnit d -> ShowS #

show :: ObsUnit d -> String #

showList :: [ObsUnit d] -> ShowS #

Generic (ObsUnit d) Source # 
Instance details

Defined in Cohort.Core

Associated Types

type Rep (ObsUnit d) :: Type -> Type #

Methods

from :: ObsUnit d -> Rep (ObsUnit d) x #

to :: Rep (ObsUnit d) x -> ObsUnit d #

ToJSON d => ToJSON (ObsUnit d) Source # 
Instance details

Defined in Cohort.Output

type Rep (ObsUnit d) Source # 
Instance details

Defined in Cohort.Core

type Rep (ObsUnit d) = D1 ('MetaData "ObsUnit" "Cohort.Core" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "MkObsUnit" 'PrefixI 'True) (S1 ('MetaSel ('Just "obsID") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ID) :*: S1 ('MetaSel ('Just "obsData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 d)))

newtype CohortData d Source #

A container for CohortData

Constructors

MkCohortData 

Fields

Instances

Instances details
Eq d => Eq (CohortData d) Source # 
Instance details

Defined in Cohort.Core

Methods

(==) :: CohortData d -> CohortData d -> Bool #

(/=) :: CohortData d -> CohortData d -> Bool #

Show d => Show (CohortData d) Source # 
Instance details

Defined in Cohort.Core

Generic (CohortData d) Source # 
Instance details

Defined in Cohort.Core

Associated Types

type Rep (CohortData d) :: Type -> Type #

Methods

from :: CohortData d -> Rep (CohortData d) x #

to :: Rep (CohortData d) x -> CohortData d #

ToJSON d => ToJSON (CohortData d) Source # 
Instance details

Defined in Cohort.Output

type Rep (CohortData d) Source # 
Instance details

Defined in Cohort.Core

type Rep (CohortData d) = D1 ('MetaData "CohortData" "Cohort.Core" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkCohortData" 'PrefixI 'True) (S1 ('MetaSel ('Just "getObsData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ObsUnit d])))

newtype Cohort d Source #

A cohort is a list of observational units along with AttritionInfo regarding the number of subjects excluded by the Criteria.

Constructors

MkCohort (AttritionInfo, CohortData d) 

Instances

Instances details
Eq d => Eq (Cohort d) Source # 
Instance details

Defined in Cohort.Core

Methods

(==) :: Cohort d -> Cohort d -> Bool #

(/=) :: Cohort d -> Cohort d -> Bool #

Show d => Show (Cohort d) Source # 
Instance details

Defined in Cohort.Core

Methods

showsPrec :: Int -> Cohort d -> ShowS #

show :: Cohort d -> String #

showList :: [Cohort d] -> ShowS #

Generic (Cohort d) Source # 
Instance details

Defined in Cohort.Core

Associated Types

type Rep (Cohort d) :: Type -> Type #

Methods

from :: Cohort d -> Rep (Cohort d) x #

to :: Rep (Cohort d) x -> Cohort d #

ToJSON d => ToJSON (Cohort d) Source # 
Instance details

Defined in Cohort.Output

type Rep (Cohort d) Source # 
Instance details

Defined in Cohort.Core

type Rep (Cohort d) = D1 ('MetaData "Cohort" "Cohort.Core" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkCohort" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (AttritionInfo, CohortData d))))

data CohortSpec d1 d0 Source #

A cohort specification consist of two functions: one that transforms a subject's input data into a Criteria and another that transforms a subject's input data into the desired return type.

data CohortSetSpec i d Source #

Key/value pairs of CohortSpecs. The keys are the names of the cohorts.

newtype CohortSet d Source #

A container hold multiple cohorts of the same type. The key is the name of the cohort; value is a cohort.

Constructors

MkCohortSet (Map Text (Cohort d)) 

Instances

Instances details
Eq d => Eq (CohortSet d) Source # 
Instance details

Defined in Cohort.Core

Methods

(==) :: CohortSet d -> CohortSet d -> Bool #

(/=) :: CohortSet d -> CohortSet d -> Bool #

Show d => Show (CohortSet d) Source # 
Instance details

Defined in Cohort.Core

Generic (CohortSet d) Source # 
Instance details

Defined in Cohort.Core

Associated Types

type Rep (CohortSet d) :: Type -> Type #

Methods

from :: CohortSet d -> Rep (CohortSet d) x #

to :: Rep (CohortSet d) x -> CohortSet d #

ToJSON d => ToJSON (CohortSet d) Source # 
Instance details

Defined in Cohort.Output

type Rep (CohortSet d) Source # 
Instance details

Defined in Cohort.Core

type Rep (CohortSet d) = D1 ('MetaData "CohortSet" "Cohort.Core" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkCohortSet" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map Text (Cohort d)))))

data AttritionInfo Source #

A type which collects the counts of subjects included or excluded.

Instances

Instances details
Eq AttritionInfo Source # 
Instance details

Defined in Cohort.Core

Show AttritionInfo Source # 
Instance details

Defined in Cohort.Core

Generic AttritionInfo Source # 
Instance details

Defined in Cohort.Core

Associated Types

type Rep AttritionInfo :: Type -> Type #

Semigroup AttritionInfo Source #

Two AttritionInfo values can be combined, but this meant for combining attrition info from the same set of Criteria.

Instance details

Defined in Cohort.Core

ToJSON AttritionInfo Source # 
Instance details

Defined in Cohort.Output

FromJSON AttritionInfo Source # 
Instance details

Defined in Cohort.Output

type Rep AttritionInfo Source # 
Instance details

Defined in Cohort.Core

type Rep AttritionInfo = D1 ('MetaData "AttritionInfo" "Cohort.Core" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "MkAttritionInfo" 'PrefixI 'True) (S1 ('MetaSel ('Just "totalProcessed") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Just "attritionInfo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Set AttritionLevel))))

data AttritionLevel Source #

A type which collects counts of a CohortStatus

Instances

Instances details
Eq AttritionLevel Source # 
Instance details

Defined in Cohort.Core

Ord AttritionLevel Source #

Ordering of AttritionLevel is based on the value of its attritionLevel.

Instance details

Defined in Cohort.Core

Show AttritionLevel Source # 
Instance details

Defined in Cohort.Core

Generic AttritionLevel Source # 
Instance details

Defined in Cohort.Core

Associated Types

type Rep AttritionLevel :: Type -> Type #

Semigroup AttritionLevel Source #

NOTE: the Semigroup instance prefers the attritionLevel from the left, so be sure that you're combining

Instance details

Defined in Cohort.Core

ToJSON AttritionLevel Source # 
Instance details

Defined in Cohort.Output

FromJSON AttritionLevel Source # 
Instance details

Defined in Cohort.Output

type Rep AttritionLevel Source # 
Instance details

Defined in Cohort.Core

type Rep AttritionLevel = D1 ('MetaData "AttritionLevel" "Cohort.Core" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "MkAttritionLevel" 'PrefixI 'True) (S1 ('MetaSel ('Just "attritionLevel") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CohortStatus) :*: S1 ('MetaSel ('Just "attritionCount") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Natural)))

specifyCohort :: (d1 -> Criteria) -> (d1 -> d0) -> CohortSpec d1 d0 Source #

Creates a CohortSpec.

makeObsUnitFeatures :: (d1 -> d0) -> Subject d1 -> ObsUnit d0 Source #

Tranforms a Subject into a ObsUnit.

evalCohort :: CohortSpec d1 d0 -> Population d1 -> Cohort d0 Source #

Evaluates a CohortSpec on a Population.

getCohortIDs :: Cohort d -> [ID] Source #

Get IDs from a cohort.

getCohortData :: Cohort d -> [d] Source #

Get data from a cohort.

getCohortDataData :: CohortData d -> [d] Source #

Get data from a cohort.

getAttritionInfo :: Cohort d -> AttritionInfo Source #

Gets the attrition info from a cohort

makeCohortSpecs :: [(Text, d1 -> Criteria, d1 -> d0)] -> CohortSetSpec d1 d0 Source #

Make a set of CohortSpecs from list input.

Index

An Index is an interval of time from which the assessment intervals for an observational unit may be derived. Assessment intervals (encoded in the type AssessmentInterval) are intervals of time during which features are evaluated.

data Index i a Source #

An Index is a wrapper for an Intervallic used to indicate that a particular interval is considered an index interval to which other intervals will be compared.

Instances

Instances details
Functor i => Functor (Index i) Source # 
Instance details

Defined in Cohort.Index

Methods

fmap :: (a -> b) -> Index i a -> Index i b #

(<$) :: a -> Index i b -> Index i a #

Intervallic i a => Intervallic (Index i) a Source # 
Instance details

Defined in Cohort.Index

Methods

getInterval :: Index i a -> Interval a #

setInterval :: Index i a -> Interval a -> Index i a #

Eq (i a) => Eq (Index i a) Source # 
Instance details

Defined in Cohort.Index

Methods

(==) :: Index i a -> Index i a -> Bool #

(/=) :: Index i a -> Index i a -> Bool #

Show (i a) => Show (Index i a) Source # 
Instance details

Defined in Cohort.Index

Methods

showsPrec :: Int -> Index i a -> ShowS #

show :: Index i a -> String #

showList :: [Index i a] -> ShowS #

Generic (Index i a) Source # 
Instance details

Defined in Cohort.Index

Associated Types

type Rep (Index i a) :: Type -> Type #

Methods

from :: Index i a -> Rep (Index i a) x #

to :: Rep (Index i a) x -> Index i a #

(Intervallic i a, ToJSON (i a)) => ToJSON (Index i a) Source # 
Instance details

Defined in Cohort.Index

Methods

toJSON :: Index i a -> Value #

toEncoding :: Index i a -> Encoding #

toJSONList :: [Index i a] -> Value #

toEncodingList :: [Index i a] -> Encoding #

type Rep (Index i a) Source # 
Instance details

Defined in Cohort.Index

type Rep (Index i a) = D1 ('MetaData "Index" "Cohort.Index" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkIndex" 'PrefixI 'True) (S1 ('MetaSel ('Just "getIndex") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (i a))))

makeIndex :: Intervallic i a => i a -> Index i a Source #

Creates a new Index.

Assessment Intervals

The assessment intervals provided are:

  • Baseline: an interval which either meets or precedes index. Covariates are typically assessed during baseline intervals. A cohort's specification may include multiple baseline intervals, as different features may require different baseline intervals. For example, one feature may use a baseline interval of 365 days prior to index, while another uses a baseline interval of 90 days before index up to 30 days before index.
  • Followup: an interval which is startedBy, metBy, or after an Index. Outcomes are typically assessed during followup intervals. Similar to Baseline, a cohort's specification may include multiple followup intervals, as different features may require different followup intervals.

In future versions, one subject may have multiple values for an Index corresponding to unique ObsUnit. That is, there is a 1-to-1 map between index values and observational units, but there may be a 1-to-many map from subjects to indices.

While users are protected from forming invalid assessment intervals, they still need to carefully consider how to filter events based on the assessment interval. Consider the following data:

               _      <- Index    (15, 16)
     ----------       <- Baseline (5, 15)
 ---                  <- A (1, 4)
  ---                 <- B (2, 5)
    ---               <- C (4, 7)
      ---             <- D (5, 8)
         ---          <- E (8, 11)
            ---       <- F (12, 15)
              ---     <- G (14, 17)
                 ___  <- H (17, 20)
|----|----|----|----|
0         10        20

We have index, baseline, and 8 events (A-H). If Baseline is our assessment interval, then the events concuring (i.e. not disjoint) with Baseline are C-G. While C-F probably make sense to use in deriving some covariate, what about G? The event G begins during baseline but ends after index. If you want, for example, to know how many events started during baseline, then you’d want to include G in your filter (using concur). But if you wanted to know the durations of events enclosed by baseline, then you wouldn’t want to filter using concur and instead perhaps use enclosedBy.

data BaselineInterval a Source #

A type to contain baseline intervals. See the Baseline typeclass for methods to create values of this type.

Instances

Instances details
Functor BaselineInterval Source # 
Instance details

Defined in Cohort.AssessmentIntervals

Methods

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

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

Ord a => Intervallic BaselineInterval a Source # 
Instance details

Defined in Cohort.AssessmentIntervals

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

Defined in Cohort.AssessmentIntervals

(Show a, Ord a) => Show (BaselineInterval a) Source # 
Instance details

Defined in Cohort.AssessmentIntervals

Generic (BaselineInterval a) Source # 
Instance details

Defined in Cohort.AssessmentIntervals

Associated Types

type Rep (BaselineInterval a) :: Type -> Type #

type Rep (BaselineInterval a) Source # 
Instance details

Defined in Cohort.AssessmentIntervals

type Rep (BaselineInterval a) = D1 ('MetaData "BaselineInterval" "Cohort.AssessmentIntervals" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkBaselineInterval" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Interval a))))

class Intervallic i a => Baseline i a where Source #

Provides functions for creating a BaselineInterval from an Index. The baseline function should satify:

Meets
relate (baseline d i) i = Meets

The baselineBefore function should satisfy:

Before
relate (baselineBefore s d i) i = Before
>>> import Cohort.Index
>>> import IntervalAlgebra
>>> x = makeIndex (beginerval 1 10)
>>> b =baseline 10 x
>>> b
>>> relate b x
MkBaselineInterval (0, 10)
Meets
>>> import Cohort.Index
>>> import IntervalAlgebra
>>> x = makeIndex (beginerval 1 10)
>>> b = baselineBefore 2 4 x
>>> b
>>> relate b x
MkBaselineInterval (4, 8)
Before

Minimal complete definition

Nothing

Methods

baseline Source #

Arguments

:: IntervalSizeable a b 
=> b

duration of baseline

-> Index i a

the Index event

-> BaselineInterval a 

Creates a BaselineInterval of the given duration that Meets the Index interval.

baselineBefore Source #

Arguments

:: IntervalSizeable a b 
=> b

duration to shift back

-> b

duration of baseline

-> Index i a

the Index event

-> BaselineInterval a 

Creates a BaselineInterval of the given duration that precedes the Index interval.

Instances

Instances details
Ord a => Baseline Interval a Source # 
Instance details

Defined in Cohort.AssessmentIntervals

data FollowupInterval a Source #

A type to contain followup intervals. See the Followup typeclass for methods to create values of this type.

Instances

Instances details
Functor FollowupInterval Source # 
Instance details

Defined in Cohort.AssessmentIntervals

Methods

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

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

Ord a => Intervallic FollowupInterval a Source # 
Instance details

Defined in Cohort.AssessmentIntervals

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

Defined in Cohort.AssessmentIntervals

(Show a, Ord a) => Show (FollowupInterval a) Source # 
Instance details

Defined in Cohort.AssessmentIntervals

Generic (FollowupInterval a) Source # 
Instance details

Defined in Cohort.AssessmentIntervals

Associated Types

type Rep (FollowupInterval a) :: Type -> Type #

type Rep (FollowupInterval a) Source # 
Instance details

Defined in Cohort.AssessmentIntervals

type Rep (FollowupInterval a) = D1 ('MetaData "FollowupInterval" "Cohort.AssessmentIntervals" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkFollowupInterval" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Interval a))))

class Intervallic i a => Followup i a where Source #

Provides functions for creating a FollowupInterval from an Index. The followup function should satify:

StartedBy
relate (followup d i) i = StartedBy

The followupMetBy function should satisfy:

MetBy
relate (followupMetBy d i) i = MetBy

The followupAfter function should satisfy:

After
relate (followupAfter s d i) i = After
>>> import Cohort.Index
>>> import IntervalAlgebra
>>> x = makeIndex (beginerval 1 10)
>>> f = followup 10 x
>>> f
>>> relate f x
MkFollowupInterval (10, 20)
StartedBy

Note the consequence of providing a duration less than or equal to the duration of the index: a moment is added to the duration, so that the end of the FollowupInterval is greater than the end of the Index.

>>> import Cohort.Index
>>> import IntervalAlgebra
>>> x = makeIndex (beginerval 1 10)
>>> f = followup 1 x
>>> f
>>> relate f x
MkFollowupInterval (10, 12)
StartedBy
>>> import Cohort.Index
>>> import IntervalAlgebra
>>> x = makeIndex (beginerval 1 10)
>>> f = followupMetBy 9 x
>>> f
>>> relate f x
MkFollowupInterval (11, 20)
MetBy
>>> import Cohort.Index
>>> import IntervalAlgebra
>>> x = makeIndex (beginerval 1 10)
>>> f = followupAfter 1 9 x
>>> f
>>> relate f x
MkFollowupInterval (12, 21)
After

Minimal complete definition

Nothing

Methods

followup Source #

Arguments

:: (IntervalSizeable a b, Intervallic i a) 
=> b

duration of followup

-> Index i a

the Index event

-> FollowupInterval a 

followupMetBy Source #

Arguments

:: (IntervalSizeable a b, Intervallic i a) 
=> b

duration of followup

-> Index i a

the Index event

-> FollowupInterval a 

followupAfter Source #

Arguments

:: (IntervalSizeable a b, Intervallic i a) 
=> b

duration add between the end of index and begin of followup

-> b

duration of followup

-> Index i a

the Index event

-> FollowupInterval a 

data AssessmentInterval a Source #

A data type that contains variants of intervals during which assessment may occur.

Instances

Instances details
Functor AssessmentInterval Source # 
Instance details

Defined in Cohort.AssessmentIntervals

Ord a => Intervallic AssessmentInterval a Source # 
Instance details

Defined in Cohort.AssessmentIntervals

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

Defined in Cohort.AssessmentIntervals

(Show a, Ord a) => Show (AssessmentInterval a) Source # 
Instance details

Defined in Cohort.AssessmentIntervals

Generic (AssessmentInterval a) Source # 
Instance details

Defined in Cohort.AssessmentIntervals

Associated Types

type Rep (AssessmentInterval a) :: Type -> Type #

type Rep (AssessmentInterval a) Source # 
Instance details

Defined in Cohort.AssessmentIntervals

type Rep (AssessmentInterval a) = D1 ('MetaData "AssessmentInterval" "Cohort.AssessmentIntervals" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "Bl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (BaselineInterval a))) :+: C1 ('MetaCons "Fl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (FollowupInterval a))))

makeBaselineFromIndex :: (Baseline i a, IntervalSizeable a b) => b -> Index i a -> AssessmentInterval a Source #

Creates an AssessmentInterval using the baseline function.

>>> import Cohort.Index
>>> x = makeIndex $ beginerval 1 10
>>> makeBaselineFromIndex 10 x
Bl (MkBaselineInterval (0, 10))

makeBaselineBeforeIndex :: (Baseline i a, IntervalSizeable a b) => b -> b -> Index i a -> AssessmentInterval a Source #

Creates an AssessmentInterval using the baselineBefore function.

>>> import Cohort.Index
>>> x = makeIndex $ beginerval 1 10
>>> makeBaselineBeforeIndex 2 10 x
Bl (MkBaselineInterval (-2, 8))

makeFollowupFromIndex :: (Followup i a, IntervalSizeable a b) => b -> Index i a -> AssessmentInterval a Source #

Creates an AssessmentInterval using the followup function.

>>> import Cohort.Index
>>> x = makeIndex $ beginerval 1 10
>>> makeFollowupFromIndex 10 x
Fl (MkFollowupInterval (10, 20))

makeFollowupMeetingIndex :: (Followup i a, IntervalSizeable a b) => b -> Index i a -> AssessmentInterval a Source #

Creates an AssessmentInterval using the followupMetBy function.

>>> import Cohort.Index
>>> x = makeIndex $ beginerval 1 10
>>> makeFollowupMeetingIndex 10 x
Fl (MkFollowupInterval (11, 21))

makeFollowupAfterIndex :: (Followup i a, IntervalSizeable a b) => b -> b -> Index i a -> AssessmentInterval a Source #

Creates an AssessmentInterval using the followupAfter function.

>>> import Cohort.Index
>>> x = makeIndex $ beginerval 1 10
>>> makeFollowupAfterIndex 10 10 x
Fl (MkFollowupInterval (21, 31))

Criteria

data Criterion Source #

A type that is simply a 'FeatureN Status', that is, a feature that identifies whether to Include or Exclude a subject.

Instances

Instances details
Eq Criterion Source # 
Instance details

Defined in Cohort.Criteria

Show Criterion Source # 
Instance details

Defined in Cohort.Criteria

newtype Criteria Source #

A nonempty collection of Criterion paired with a Natural number.

Constructors

MkCriteria 

Instances

Instances details
Eq Criteria Source # 
Instance details

Defined in Cohort.Criteria

Show Criteria Source # 
Instance details

Defined in Cohort.Criteria

data Status Source #

Defines the return type for Criterion indicating whether to include or exclude a subject.

Constructors

Include 
Exclude 

Instances

Instances details
Eq Status Source # 
Instance details

Defined in Cohort.Criteria

Methods

(==) :: Status -> Status -> Bool #

(/=) :: Status -> Status -> Bool #

Show Status Source # 
Instance details

Defined in Cohort.Criteria

Generic Status Source # 
Instance details

Defined in Cohort.Criteria

Associated Types

type Rep Status :: Type -> Type #

Methods

from :: Status -> Rep Status x #

to :: Rep Status x -> Status #

type Rep Status Source # 
Instance details

Defined in Cohort.Criteria

type Rep Status = D1 ('MetaData "Status" "Cohort.Criteria" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "Include" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Exclude" 'PrefixI 'False) (U1 :: Type -> Type))

data CohortStatus Source #

Defines subject's diposition in a cohort either included or which criterion they were excluded by. See checkCohortStatus for evaluating a Criteria to determine CohortStatus.

Constructors

Included 
ExcludedBy (Natural, Text) 

Instances

Instances details
Eq CohortStatus Source # 
Instance details

Defined in Cohort.Criteria

Ord CohortStatus Source # 
Instance details

Defined in Cohort.Criteria

Show CohortStatus Source # 
Instance details

Defined in Cohort.Criteria

Generic CohortStatus Source # 
Instance details

Defined in Cohort.Criteria

Associated Types

type Rep CohortStatus :: Type -> Type #

ToJSON CohortStatus Source # 
Instance details

Defined in Cohort.Output

FromJSON CohortStatus Source # 
Instance details

Defined in Cohort.Output

type Rep CohortStatus Source # 
Instance details

Defined in Cohort.Criteria

type Rep CohortStatus = D1 ('MetaData "CohortStatus" "Cohort.Criteria" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "Included" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ExcludedBy" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Natural, Text))))

criteria :: NonEmpty Criterion -> Criteria Source #

Constructs a Criteria from a NonEmpty collection of Criterion.

excludeIf :: Bool -> Status Source #

Helper to convert a Bool to a Status

>>> excludeIf True
>>> excludeIf False
Exclude
Include

includeIf :: Bool -> Status Source #

Helper to convert a Bool to a Status

>>> includeIf True
>>> includeIf False
Include
Exclude

initStatusInfo :: Criteria -> NonEmpty CohortStatus Source #

Initializes a container of CohortStatus from a Criteria. This can be used to collect generate all the possible Exclusion/Inclusion reasons.

checkCohortStatus :: Criteria -> CohortStatus Source #

Converts a subject's Criteria to a CohortStatus. The status is set to Included if none of the Criterion have a status of Exclude.

Cohort I/O

Input

parsePopulationLines :: (FromJSON a, Show a, IntervalSizeable a b) => ByteString -> ([ParseError], Population (Events a)) Source #

Parse Event Int from json lines.

parsePopulationIntLines :: ByteString -> ([ParseError], Population (Events Int)) Source #

Parse Event Int from json lines.

parsePopulationDayLines :: ByteString -> ([ParseError], Population (Events Day)) Source #

Parse Event Day from json lines.

newtype ParseError Source #

Contains the line number and error message.

Constructors

MkParseError (Natural, Text) 

Instances

Instances details
Eq ParseError Source # 
Instance details

Defined in Cohort.Input

Show ParseError Source # 
Instance details

Defined in Cohort.Input

Output

data CohortJSON Source #

A type containing all the information of a Cohort but where the CohortData has been reshaped to a CohortDataShapeJSON.

Instances

Instances details
Eq CohortJSON Source # 
Instance details

Defined in Cohort.Output

Show CohortJSON Source # 
Instance details

Defined in Cohort.Output

Generic CohortJSON Source # 
Instance details

Defined in Cohort.Output

Associated Types

type Rep CohortJSON :: Type -> Type #

Semigroup CohortJSON Source # 
Instance details

Defined in Cohort.Output

ToJSON CohortJSON Source # 
Instance details

Defined in Cohort.Output

FromJSON CohortJSON Source # 
Instance details

Defined in Cohort.Output

type Rep CohortJSON Source # 
Instance details

Defined in Cohort.Output

type Rep CohortJSON = D1 ('MetaData "CohortJSON" "Cohort.Output" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkCohortJSON" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (AttritionInfo, CohortDataShapeJSON))))

newtype CohortSetJSON Source #

Similar to CohortSet, but where the Cohorts have been mapped to a CohortJSON.

Instances

Instances details
Eq CohortSetJSON Source # 
Instance details

Defined in Cohort.Output

Show CohortSetJSON Source # 
Instance details

Defined in Cohort.Output

Generic CohortSetJSON Source # 
Instance details

Defined in Cohort.Output

Associated Types

type Rep CohortSetJSON :: Type -> Type #

Semigroup CohortSetJSON Source # 
Instance details

Defined in Cohort.Output

ToJSON CohortSetJSON Source # 
Instance details

Defined in Cohort.Output

FromJSON CohortSetJSON Source # 
Instance details

Defined in Cohort.Output

type Rep CohortSetJSON Source # 
Instance details

Defined in Cohort.Output

type Rep CohortSetJSON = D1 ('MetaData "CohortSetJSON" "Cohort.Output" "hasklepias-0.21.0-inplace" 'True) (C1 ('MetaCons "MkCohortSetJSON" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map Text CohortJSON))))

data CohortDataShape d Source #

A type used to determine the output shape of a Cohort.

Instances

Instances details
Show d => Show (CohortDataShape d) Source # 
Instance details

Defined in Cohort.Output

data CohortDataShapeJSON Source #

A type used to represent JSON formats for each shape

Instances

Instances details
Eq CohortDataShapeJSON Source # 
Instance details

Defined in Cohort.Output

Show CohortDataShapeJSON Source # 
Instance details

Defined in Cohort.Output

Generic CohortDataShapeJSON Source # 
Instance details

Defined in Cohort.Output

Associated Types

type Rep CohortDataShapeJSON :: Type -> Type #

Semigroup CohortDataShapeJSON Source # 
Instance details

Defined in Cohort.Output

ToJSON CohortDataShapeJSON Source # 
Instance details

Defined in Cohort.Output

FromJSON CohortDataShapeJSON Source # 
Instance details

Defined in Cohort.Output

type Rep CohortDataShapeJSON Source # 
Instance details

Defined in Cohort.Output

data ColumnWiseJSON Source #

A type to hold Cohort information in a column-wise manner.

Constructors

MkColumnWiseJSON 

Fields

Instances

Instances details
Eq ColumnWiseJSON Source # 
Instance details

Defined in Cohort.Output

Show ColumnWiseJSON Source # 
Instance details

Defined in Cohort.Output

Generic ColumnWiseJSON Source # 
Instance details

Defined in Cohort.Output

Associated Types

type Rep ColumnWiseJSON :: Type -> Type #

Semigroup ColumnWiseJSON Source # 
Instance details

Defined in Cohort.Output

ToJSON ColumnWiseJSON Source # 
Instance details

Defined in Cohort.Output

FromJSON ColumnWiseJSON Source # 
Instance details

Defined in Cohort.Output

type Rep ColumnWiseJSON Source # 
Instance details

Defined in Cohort.Output

type Rep ColumnWiseJSON = D1 ('MetaData "ColumnWiseJSON" "Cohort.Output" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "MkColumnWiseJSON" 'PrefixI 'True) (S1 ('MetaSel ('Just "attributes") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Value]) :*: (S1 ('MetaSel ('Just "ids") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Value]) :*: S1 ('MetaSel ('Just "cohortData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [[Value]]))))

data RowWiseJSON Source #

A type to hold Cohort information in a row-wise manner.

Constructors

MkRowWiseJSON 

Fields

Instances

Instances details
Eq RowWiseJSON Source # 
Instance details

Defined in Cohort.Output

Show RowWiseJSON Source # 
Instance details

Defined in Cohort.Output

Generic RowWiseJSON Source # 
Instance details

Defined in Cohort.Output

Associated Types

type Rep RowWiseJSON :: Type -> Type #

Semigroup RowWiseJSON Source # 
Instance details

Defined in Cohort.Output

ToJSON RowWiseJSON Source # 
Instance details

Defined in Cohort.Output

FromJSON RowWiseJSON Source # 
Instance details

Defined in Cohort.Output

type Rep RowWiseJSON Source # 
Instance details

Defined in Cohort.Output

type Rep RowWiseJSON = D1 ('MetaData "RowWiseJSON" "Cohort.Output" "hasklepias-0.21.0-inplace" 'False) (C1 ('MetaCons "MkRowWiseJSON" 'PrefixI 'True) (S1 ('MetaSel ('Just "attributes") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Value]) :*: S1 ('MetaSel ('Just "cohortData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Value])))

class ShapeCohort d where Source #

Provides methods for reshaping a Cohort to a CohortDataShapeJSON.

Instances

Instances details
ShapeCohort Featureset Source # 
Instance details

Defined in Cohort.Output

toJSONCohortDataShape :: CohortDataShape shape -> Value Source #

Maps CohortDataShape into an Aeson Value.

Creating an executable cohort application

makeCohortApp Source #

Arguments

:: (FromJSON a, Show a, IntervalSizeable a b, ToJSON d0, ShapeCohort d0) 
=> String

cohort name

-> String

app version

-> (Cohort d0 -> CohortJSON)

a function which specifies the output shape

-> CohortSetSpec (Events a) d0

a list of cohort specifications

-> IO () 

Make a command line cohort building application.

Statistical Types

module Stype

Rexported Functions and modules

newtype IO a #

A value of type IO a is a computation which, when performed, does some I/O before returning a value of type a.

There is really only one way to "perform" an I/O action: bind it to Main.main in your program. When your program is run, the I/O will be performed. It isn't possible to perform I/O from an arbitrary function, unless that function is itself in the IO monad and called at some point, directly or indirectly, from Main.main.

IO is a monad, so IO actions can be combined using either the do-notation or the >> and >>= operations from the Monad class.

Constructors

IO (State# RealWorld -> (# State# RealWorld, a #)) 

Instances

Instances details
Monad IO

Since: base-2.1

Instance details

Defined in GHC.Base

Methods

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

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

return :: a -> IO a #

Functor IO

Since: base-2.1

Instance details

Defined in GHC.Base

Methods

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

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

MonadFail IO

Since: base-4.9.0.0

Instance details

Defined in Control.Monad.Fail

Methods

fail :: String -> IO a #

Applicative IO

Since: base-2.1

Instance details

Defined in GHC.Base

Methods

pure :: a -> IO a #

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

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

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

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

Alternative IO

Since: base-4.9.0.0

Instance details

Defined in GHC.Base

Methods

empty :: IO a #

(<|>) :: IO a -> IO a -> IO a #

some :: IO a -> IO [a] #

many :: IO a -> IO [a] #

MonadPlus IO

Since: base-4.9.0.0

Instance details

Defined in GHC.Base

Methods

mzero :: IO a #

mplus :: IO a -> IO a -> IO a #

MonadIO IO

Since: base-4.9.0.0

Instance details

Defined in Control.Monad.IO.Class

Methods

liftIO :: IO a -> IO a #

PrimMonad IO 
Instance details

Defined in Control.Monad.Primitive

Associated Types

type PrimState IO #

Methods

primitive :: (State# (PrimState IO) -> (# State# (PrimState IO), a #)) -> IO a #

PrimBase IO 
Instance details

Defined in Control.Monad.Primitive

Methods

internal :: IO a -> State# (PrimState IO) -> (# State# (PrimState IO), a #) #

Quasi IO 
Instance details

Defined in Language.Haskell.TH.Syntax

Semigroup a => Semigroup (IO a)

Since: base-4.10.0.0

Instance details

Defined in GHC.Base

Methods

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

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

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

Monoid a => Monoid (IO a)

Since: base-4.9.0.0

Instance details

Defined in GHC.Base

Methods

mempty :: IO a #

mappend :: IO a -> IO a -> IO a #

mconcat :: [IO a] -> IO a #

AssertionPredicable t => AssertionPredicable (IO t) 
Instance details

Defined in Test.Tasty.HUnit.Orig

Methods

assertionPredicate :: IO t -> IO Bool #

Assertable t => Assertable (IO t) 
Instance details

Defined in Test.Tasty.HUnit.Orig

Methods

assert :: IO t -> Assertion #

type PrimState IO 
Instance details

Defined in Control.Monad.Primitive

encode :: ToJSON a => a -> ByteString #

Efficiently serialize a JSON value as a lazy ByteString.

This is implemented in terms of the ToJSON class's toEncoding method.

class ToJSON a where #

A type that can be converted to JSON.

Instances in general must specify toJSON and should (but don't need to) specify toEncoding.

An example type and instance:

-- Allow ourselves to write Text literals.
{-# LANGUAGE OverloadedStrings #-}

data Coord = Coord { x :: Double, y :: Double }

instance ToJSON Coord where
  toJSON (Coord x y) = object ["x" .= x, "y" .= y]

  toEncoding (Coord x y) = pairs ("x" .= x <> "y" .= y)

Instead of manually writing your ToJSON instance, there are two options to do it automatically:

  • Data.Aeson.TH provides Template Haskell functions which will derive an instance at compile time. The generated instance is optimized for your type so it will probably be more efficient than the following option.
  • The compiler can provide a default generic implementation for toJSON.

To use the second, simply add a deriving Generic clause to your datatype and declare a ToJSON instance. If you require nothing other than defaultOptions, it is sufficient to write (and this is the only alternative where the default toJSON implementation is sufficient):

{-# LANGUAGE DeriveGeneric #-}

import GHC.Generics

data Coord = Coord { x :: Double, y :: Double } deriving Generic

instance ToJSON Coord where
    toEncoding = genericToEncoding defaultOptions

If on the other hand you wish to customize the generic decoding, you have to implement both methods:

customOptions = defaultOptions
                { fieldLabelModifier = map toUpper
                }

instance ToJSON Coord where
    toJSON     = genericToJSON customOptions
    toEncoding = genericToEncoding customOptions

Previous versions of this library only had the toJSON method. Adding toEncoding had two reasons:

  1. toEncoding is more efficient for the common case that the output of toJSON is directly serialized to a ByteString. Further, expressing either method in terms of the other would be non-optimal.
  2. The choice of defaults allows a smooth transition for existing users: Existing instances that do not define toEncoding still compile and have the correct semantics. This is ensured by making the default implementation of toEncoding use toJSON. This produces correct results, but since it performs an intermediate conversion to a Value, it will be less efficient than directly emitting an Encoding. (this also means that specifying nothing more than instance ToJSON Coord would be sufficient as a generically decoding instance, but there probably exists no good reason to not specify toEncoding in new instances.)

Minimal complete definition

Nothing

Methods

toJSON :: a -> Value #

Convert a Haskell value to a JSON-friendly intermediate type.

toEncoding :: a -> Encoding #

Encode a Haskell value as JSON.

The default implementation of this method creates an intermediate Value using toJSON. This provides source-level compatibility for people upgrading from older versions of this library, but obviously offers no performance advantage.

To benefit from direct encoding, you must provide an implementation for this method. The easiest way to do so is by having your types implement Generic using the DeriveGeneric extension, and then have GHC generate a method body as follows.

instance ToJSON Coord where
    toEncoding = genericToEncoding defaultOptions

toJSONList :: [a] -> Value #

toEncodingList :: [a] -> Encoding #

Instances

Instances details
ToJSON Bool 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Char 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Double 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Float 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Int 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Int8 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Int16 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Int32 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Int64 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Integer 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Natural 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Ordering 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Word 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Word8 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Word16 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Word32 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Word64 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON () 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: () -> Value #

toEncoding :: () -> Encoding #

toJSONList :: [()] -> Value #

toEncodingList :: [()] -> Encoding #

ToJSON Version 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Scientific 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Text 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON UTCTime 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Value 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON DotNetTime 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Text 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Number 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Void 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON CTime 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Day 
Instance details

Defined in Chronos

ToJSON Offset 
Instance details

Defined in Chronos

ToJSON Time 
Instance details

Defined in Chronos

ToJSON Timespan 
Instance details

Defined in Chronos

ToJSON Datetime 
Instance details

Defined in Chronos

ToJSON IntSet 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Day 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON ZonedTime 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON LocalTime 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON TimeOfDay 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON CalendarDiffTime 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON SystemTime

Encoded as number

Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON NominalDiffTime 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON DiffTime 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON DayOfWeek 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON QuarterOfYear 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Quarter 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Month 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON CalendarDiffDays 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON UUID 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON Attributes Source # 
Instance details

Defined in Features.Output

ToJSON Purpose Source # 
Instance details

Defined in Features.Output

ToJSON Role Source # 
Instance details

Defined in Features.Output

ToJSON MissingReason Source # 
Instance details

Defined in Features.Output

ToJSON CohortStatus Source # 
Instance details

Defined in Cohort.Output

ToJSON AttritionInfo Source # 
Instance details

Defined in Cohort.Output

ToJSON AttritionLevel Source # 
Instance details

Defined in Cohort.Output

ToJSON Featureable Source # 
Instance details

Defined in Features.Featureable

ToJSON Featureset Source # 
Instance details

Defined in Features.Featureset

ToJSON RowWiseJSON Source # 
Instance details

Defined in Cohort.Output

ToJSON ColumnWiseJSON Source # 
Instance details

Defined in Cohort.Output

ToJSON CohortDataShapeJSON Source # 
Instance details

Defined in Cohort.Output

ToJSON CohortSetJSON Source # 
Instance details

Defined in Cohort.Output

ToJSON CohortJSON Source # 
Instance details

Defined in Cohort.Output

ToJSON a => ToJSON [a] 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: [a] -> Value #

toEncoding :: [a] -> Encoding #

toJSONList :: [[a]] -> Value #

toEncodingList :: [[a]] -> Encoding #

ToJSON a => ToJSON (Maybe a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

(ToJSON a, Integral a) => ToJSON (Ratio a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (Min a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Min a -> Value #

toEncoding :: Min a -> Encoding #

toJSONList :: [Min a] -> Value #

toEncodingList :: [Min a] -> Encoding #

ToJSON a => ToJSON (Max a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Max a -> Value #

toEncoding :: Max a -> Encoding #

toJSONList :: [Max a] -> Value #

toEncodingList :: [Max a] -> Encoding #

ToJSON a => ToJSON (First a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (Last a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (WrappedMonoid a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (Option a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (Identity a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (First a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (Last a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (Dual a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (NonEmpty a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (IntMap a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON v => ToJSON (Tree v) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (Seq a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Seq a -> Value #

toEncoding :: Seq a -> Encoding #

toJSONList :: [Seq a] -> Value #

toEncodingList :: [Seq a] -> Encoding #

ToJSON a => ToJSON (Set a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Set a -> Value #

toEncoding :: Set a -> Encoding #

toJSONList :: [Set a] -> Value #

toEncodingList :: [Set a] -> Encoding #

ToJSON a => ToJSON (Array a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (SmallArray a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

(Prim a, ToJSON a) => ToJSON (PrimArray a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON1 f => ToJSON (Fix f)

Since: aeson-1.5.3.0

Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Fix f -> Value #

toEncoding :: Fix f -> Encoding #

toJSONList :: [Fix f] -> Value #

toEncodingList :: [Fix f] -> Encoding #

(ToJSON1 f, Functor f) => ToJSON (Mu f)

Since: aeson-1.5.3.0

Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Mu f -> Value #

toEncoding :: Mu f -> Encoding #

toJSONList :: [Mu f] -> Value #

toEncodingList :: [Mu f] -> Encoding #

(ToJSON1 f, Functor f) => ToJSON (Nu f)

Since: aeson-1.5.3.0

Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Nu f -> Value #

toEncoding :: Nu f -> Encoding #

toJSONList :: [Nu f] -> Value #

toEncodingList :: [Nu f] -> Encoding #

ToJSON a => ToJSON (DNonEmpty a)

Since: aeson-1.5.3.0

Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (DList a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

(ToJSON a, Ord a, Show a) => ToJSON (Interval a) Source # 
Instance details

Defined in Features.Output

ToJSON a => ToJSON (Vector a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (Maybe a)

Since: aeson-1.5.3.0

Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON a => ToJSON (HashSet a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

(Vector Vector a, ToJSON a) => ToJSON (Vector a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

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

Defined in Data.Aeson.Types.ToJSON

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

Defined in Data.Aeson.Types.ToJSON

ToJSON d => ToJSON (FeatureData d) Source # 
Instance details

Defined in Features.Output

ToJSON d => ToJSON (CohortSet d) Source # 
Instance details

Defined in Cohort.Output

ToJSON d => ToJSON (Cohort d) Source # 
Instance details

Defined in Cohort.Output

ToJSON d => ToJSON (CohortData d) Source # 
Instance details

Defined in Cohort.Output

ToJSON d => ToJSON (ObsUnit d) Source # 
Instance details

Defined in Cohort.Output

ToJSON (OutputShape a) Source # 
Instance details

Defined in Features.Output

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

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Either a b -> Value #

toEncoding :: Either a b -> Encoding #

toJSONList :: [Either a b] -> Value #

toEncodingList :: [Either a b] -> Encoding #

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

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b) -> Value #

toEncoding :: (a, b) -> Encoding #

toJSONList :: [(a, b)] -> Value #

toEncodingList :: [(a, b)] -> Encoding #

(ToJSON v, ToJSONKey k) => ToJSON (HashMap k v) 
Instance details

Defined in Data.Aeson.Types.ToJSON

(ToJSON v, ToJSONKey k) => ToJSON (Map k v) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Map k v -> Value #

toEncoding :: Map k v -> Encoding #

toJSONList :: [Map k v] -> Value #

toEncodingList :: [Map k v] -> Encoding #

HasResolution a => ToJSON (Fixed a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

ToJSON (Proxy a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

(ToJSON a, ToJSON b) => ToJSON (These a b)

Since: aeson-1.5.1.0

Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: These a b -> Value #

toEncoding :: These a b -> Encoding #

toJSONList :: [These a b] -> Value #

toEncodingList :: [These a b] -> Encoding #

(ToJSON a, ToJSON b) => ToJSON (Pair a b)

Since: aeson-1.5.3.0

Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Pair a b -> Value #

toEncoding :: Pair a b -> Encoding #

toJSONList :: [Pair a b] -> Value #

toEncodingList :: [Pair a b] -> Encoding #

(ToJSON a, ToJSON b) => ToJSON (These a b)

Since: aeson-1.5.3.0

Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: These a b -> Value #

toEncoding :: These a b -> Encoding #

toJSONList :: [These a b] -> Value #

toEncodingList :: [These a b] -> Encoding #

(ToJSON a, ToJSON b) => ToJSON (Either a b)

Since: aeson-1.5.3.0

Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Either a b -> Value #

toEncoding :: Either a b -> Encoding #

toJSONList :: [Either a b] -> Value #

toEncodingList :: [Either a b] -> Encoding #

(Intervallic i a, ToJSON (i a)) => ToJSON (Index i a) Source # 
Instance details

Defined in Cohort.Index

Methods

toJSON :: Index i a -> Value #

toEncoding :: Index i a -> Encoding #

toJSONList :: [Index i a] -> Value #

toEncodingList :: [Index i a] -> Encoding #

(Typeable d, KnownSymbol n, ToJSON d, HasAttributes n d) => ToJSON (Feature n d) Source # 
Instance details

Defined in Features.Output

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

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c) -> Value #

toEncoding :: (a, b, c) -> Encoding #

toJSONList :: [(a, b, c)] -> Value #

toEncodingList :: [(a, b, c)] -> Encoding #

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

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Const a b -> Value #

toEncoding :: Const a b -> Encoding #

toJSONList :: [Const a b] -> Value #

toEncodingList :: [Const a b] -> Encoding #

ToJSON b => ToJSON (Tagged a b) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Tagged a b -> Value #

toEncoding :: Tagged a b -> Encoding #

toJSONList :: [Tagged a b] -> Value #

toEncodingList :: [Tagged a b] -> Encoding #

(ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (These1 f g a)

Since: aeson-1.5.1.0

Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: These1 f g a -> Value #

toEncoding :: These1 f g a -> Encoding #

toJSONList :: [These1 f g a] -> Value #

toEncodingList :: [These1 f g a] -> Encoding #

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

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d) -> Value #

toEncoding :: (a, b, c, d) -> Encoding #

toJSONList :: [(a, b, c, d)] -> Value #

toEncodingList :: [(a, b, c, d)] -> Encoding #

(ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product f g a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Product f g a -> Value #

toEncoding :: Product f g a -> Encoding #

toJSONList :: [Product f g a] -> Value #

toEncodingList :: [Product f g a] -> Encoding #

(ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum f g a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Sum f g a -> Value #

toEncoding :: Sum f g a -> Encoding #

toJSONList :: [Sum f g a] -> Value #

toEncodingList :: [Sum f g a] -> Encoding #

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

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d, e) -> Value #

toEncoding :: (a, b, c, d, e) -> Encoding #

toJSONList :: [(a, b, c, d, e)] -> Value #

toEncodingList :: [(a, b, c, d, e)] -> Encoding #

(ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: Compose f g a -> Value #

toEncoding :: Compose f g a -> Encoding #

toJSONList :: [Compose f g a] -> Value #

toEncodingList :: [Compose f g a] -> Encoding #

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

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d, e, f) -> Value #

toEncoding :: (a, b, c, d, e, f) -> Encoding #

toJSONList :: [(a, b, c, d, e, f)] -> Value #

toEncodingList :: [(a, b, c, d, e, f)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON (a, b, c, d, e, f, g) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d, e, f, g) -> Value #

toEncoding :: (a, b, c, d, e, f, g) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON (a, b, c, d, e, f, g, h) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d, e, f, g, h) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON (a, b, c, d, e, f, g, h, i) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d, e, f, g, h, i) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON (a, b, c, d, e, f, g, h, i, j) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON (a, b, c, d, e, f, g, h, i, j, k) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j, k) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j, k) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j, k)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j, k)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j, k, l) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j, k, l) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j, k, l)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j, k, l)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n)] -> Encoding #

(ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n, ToJSON o) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) 
Instance details

Defined in Data.Aeson.Types.ToJSON

Methods

toJSON :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Value #

toEncoding :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Encoding #

toJSONList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)] -> Value #

toEncodingList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)] -> Encoding #

type HasCallStack = ?callStack :: CallStack #

Request a CallStack.

NOTE: The implicit parameter ?callStack :: CallStack is an implementation detail and should not be considered part of the CallStack API, we may decide to change the implementation in the future.

Since: base-4.9.0.0

withResource #

Arguments

:: IO a

initialize the resource

-> (a -> IO ())

free the resource

-> (IO a -> TestTree)

IO a is an action which returns the acquired resource. Despite it being an IO action, the resource it returns will be acquired only once and shared across all the tests in the tree.

-> TestTree 

Acquire the resource to run this test (sub)tree and release it afterwards

askOption :: IsOption v => (v -> TestTree) -> TestTree #

Customize the test tree based on the run-time options

localOption :: IsOption v => v -> TestTree -> TestTree #

Locally set the option value for the given test subtree

adjustOption :: IsOption v => (v -> v) -> TestTree -> TestTree #

Locally adjust the option value for the given test subtree

defaultMain :: TestTree -> IO () #

Parse the command line arguments and run the tests.

When the tests finish, this function calls exitWith with the exit code that indicates whether any tests have failed. Most external systems (stack, cabal, travis-ci, jenkins etc.) rely on the exit code to detect whether the tests pass. If you want to do something else after defaultMain returns, you need to catch the exception and then re-throw it. Example:

import Test.Tasty
import Test.Tasty.HUnit
import System.Exit
import Control.Exception

test = testCase "Test 1" (2 @?= 3)

main = defaultMain test
  `catch` (\e -> do
    if e == ExitSuccess
      then putStrLn "Yea"
      else putStrLn "Nay"
    throwIO e)

defaultIngredients :: [Ingredient] #

List of the default ingredients. This is what defaultMain uses.

At the moment it consists of listingTests and consoleTestReporter.

defaultMainWithIngredients :: [Ingredient] -> TestTree -> IO () #

Parse the command line arguments and run the tests using the provided ingredient list.

When the tests finish, this function calls exitWith with the exit code that indicates whether any tests have failed. See defaultMain for details.

includingOptions :: [OptionDescription] -> Ingredient #

This ingredient doesn't do anything apart from registering additional options.

The option values can be accessed using askOption.

after_ #

Arguments

:: DependencyType

whether to run the tests even if some of the dependencies fail

-> Expr

the pattern

-> TestTree

the subtree that depends on other tests

-> TestTree

the subtree annotated with dependency information

Like after, but accepts the pattern as a syntax tree instead of a string. Useful for generating a test tree programmatically.

Examples

Expand

Only match on the test's own name, ignoring the group names:

after_ AllFinish (EQ (Field NF) (StringLit "Bar")) $
   testCase "A test that depends on Foo.Bar" $ ...

Since: tasty-1.2

testGroup :: TestName -> [TestTree] -> TestTree #

Create a named group of test cases or other groups

type TestName = String #

The name of a test or a group of tests

data DependencyType #

These are the two ways in which one test may depend on the others.

This is the same distinction as the hard vs soft dependencies in TestNG.

Since: tasty-1.2

Constructors

AllSucceed

The current test tree will be executed after its dependencies finish, and only if all of the dependencies succeed.

AllFinish

The current test tree will be executed after its dependencies finish, regardless of whether they succeed or not.

Instances

Instances details
Eq DependencyType 
Instance details

Defined in Test.Tasty.Core

Show DependencyType 
Instance details

Defined in Test.Tasty.Core

data TestTree #

The main data structure defining a test suite.

It consists of individual test cases and properties, organized in named groups which form a tree-like hierarchy.

There is no generic way to create a test case. Instead, every test provider (tasty-hunit, tasty-smallcheck etc.) provides a function to turn a test case into a TestTree.

Groups can be created using testGroup.

mkTimeout #

Arguments

:: Integer

microseconds

-> Timeout 

A shortcut for creating Timeout values

data Timeout #

Timeout to be applied to individual tests

Constructors

Timeout Integer String

String is the original representation of the timeout (such as "0.5m"), so that we can print it back. Integer is the number of microseconds.

NoTimeout 

testCaseInfo :: TestName -> IO String -> TestTree #

Like testCase, except in case the test succeeds, the returned string will be shown as the description. If the empty string is returned, it will be ignored.

testCase :: TestName -> Assertion -> TestTree #

Turn an Assertion into a tasty test case

testCaseSteps :: TestName -> ((String -> IO ()) -> Assertion) -> TestTree #

Create a multi-step unit test.

Example:

main = defaultMain $ testCaseSteps "Multi-step test" $ \step -> do
  step "Preparing..."
  -- do something

  step "Running part 1"
  -- do something

  step "Running part 2"
  -- do something
  assertFailure "BAM!"

  step "Running part 3"
  -- do something

The step calls are mere annotations. They let you see which steps were performed successfully, and which step failed.

You can think of step as putStrLn, except putStrLn would mess up the output with the console reporter and get lost with the others.

For the example above, the output will be

Multi-step test: FAIL
  Preparing...
  Running part 1
  Running part 2
    BAM!

1 out of 1 tests failed (0.00s)

Note that:

  • Tasty still treats this as a single test, even though it consists of multiple steps.
  • The execution stops after the first failure. When we are looking at a failed test, we know that all displayed steps but the last one were successful, and the last one failed. The steps after the failed one are not displayed, since they didn't run.

assertString #

Arguments

:: HasCallStack 
=> String

The message that is displayed with the assertion failure

-> Assertion 

Signals an assertion failure if a non-empty message (i.e., a message other than "") is passed.

(@?) infix 1 #

Arguments

:: (AssertionPredicable t, HasCallStack) 
=> t

A value of which the asserted condition is predicated

-> String

A message that is displayed if the assertion fails

-> Assertion 

An infix and flipped version of assertBool. E.g. instead of

assertBool "Non-empty list" (null [1])

you can write

null [1] @? "Non-empty list"

@? is also overloaded to accept IO Bool predicates, so instead of

do
  e <- doesFileExist "test"
  e @? "File does not exist"

you can write

doesFileExist "test" @? "File does not exist"

(@?=) infix 1 #

Arguments

:: (Eq a, Show a, HasCallStack) 
=> a

The actual value

-> a

The expected value

-> Assertion 

Asserts that the specified actual value is equal to the expected value (with the actual value on the left-hand side).

(@=?) infix 1 #

Arguments

:: (Eq a, Show a, HasCallStack) 
=> a

The expected value

-> a

The actual value

-> Assertion 

Asserts that the specified actual value is equal to the expected value (with the expected value on the left-hand side).

assertEqual #

Arguments

:: (Eq a, Show a, HasCallStack) 
=> String

The message prefix

-> a

The expected value

-> a

The actual value

-> Assertion 

Asserts that the specified actual value is equal to the expected value. The output message will contain the prefix, the expected value, and the actual value.

If the prefix is the empty string (i.e., ""), then the prefix is omitted and only the expected and actual values are output.

assertBool #

Arguments

:: HasCallStack 
=> String

The message that is displayed if the assertion fails

-> Bool

The condition

-> Assertion 

Asserts that the specified condition holds.

assertFailure #

Arguments

:: HasCallStack 
=> String

A message that is displayed with the assertion failure

-> IO a 

Unconditionally signals that a failure has occured. All other assertions can be expressed with the form:

   if conditionIsMet
       then return ()
       else assertFailure msg

type Assertion = IO () #

An assertion is simply an IO action. Assertion failure is indicated by throwing an exception, typically HUnitFailure.

Instead of throwing the exception directly, you should use functions like assertFailure and assertBool.

Test cases are composed of a sequence of one or more assertions.

class AssertionPredicable t where #

An ad-hoc class used to overload the @? operator.

The only intended instances of this class are Bool and IO Bool.

You shouldn't need to interact with this class directly.

Methods

assertionPredicate :: t -> IO Bool #

Instances

Instances details
AssertionPredicable Bool 
Instance details

Defined in Test.Tasty.HUnit.Orig

AssertionPredicable t => AssertionPredicable (IO t) 
Instance details

Defined in Test.Tasty.HUnit.Orig

Methods

assertionPredicate :: IO t -> IO Bool #

class Assertable t where #

Allows the extension of the assertion mechanism.

Since an Assertion can be a sequence of Assertions and IO actions, there is a fair amount of flexibility of what can be achieved. As a rule, the resulting Assertion should be the body of a TestCase or part of a TestCase; it should not be used to assert multiple, independent conditions.

If more complex arrangements of assertions are needed, Tests and Testable should be used.

Methods

assert :: t -> Assertion #

Instances

Instances details
Assertable Bool 
Instance details

Defined in Test.Tasty.HUnit.Orig

Methods

assert :: Bool -> Assertion #

Assertable () 
Instance details

Defined in Test.Tasty.HUnit.Orig

Methods

assert :: () -> Assertion #

Assertable String 
Instance details

Defined in Test.Tasty.HUnit.Orig

Methods

assert :: String -> Assertion #

Assertable t => Assertable (IO t) 
Instance details

Defined in Test.Tasty.HUnit.Orig

Methods

assert :: IO t -> Assertion #

type AssertionPredicate = IO Bool #

The result of an assertion that hasn't been evaluated yet.

Most test cases follow the following steps:

  1. Do some processing or an action.
  2. Assert certain conditions.

However, this flow is not always suitable. AssertionPredicate allows for additional steps to be inserted without the initial action to be affected by side effects. Additionally, clean-up can be done before the test case has a chance to end. A potential work flow is:

  1. Write data to a file.
  2. Read data from a file, evaluate conditions.
  3. Clean up the file.
  4. Assert that the side effects of the read operation meet certain conditions.
  5. Assert that the conditions evaluated in step 2 are met.