proto-voice-model-0.1.0.0
Safe HaskellSafe-Inferred
LanguageGHC2021

Common

Description

Common types and functionality that are used throughout the model.

Synopsis

Paths

Paths encode sequences of alternating objects (such as nodes and edges). They are often used to encode sequences of slices and transitions. Note that dependending on context, both slice-transition-slice and transition-slice-transition orders are used.

data Path around between Source #

A Path is a datastructure that represents a sequence of alternating objects, arounds and betweens, starting and ending with the same type. An example would be a path in a graph, starting and ending with a node with edges in-between.

Constructors

Path !around !between !(Path around between) 
PathEnd !around 

Instances

Instances details
Bifunctor Path Source # 
Instance details

Defined in Common

Methods

bimap :: (a -> b) -> (c -> d) -> Path a c -> Path b d #

first :: (a -> b) -> Path a c -> Path b c #

second :: (b -> c) -> Path a b -> Path a c #

Generic (Path around between) Source # 
Instance details

Defined in Common

Associated Types

type Rep (Path around between) :: Type -> Type #

Methods

from :: Path around between -> Rep (Path around between) x #

to :: Rep (Path around between) x -> Path around between #

(Show a, Show b) => Show (Path a b) Source # 
Instance details

Defined in Common

Methods

showsPrec :: Int -> Path a b -> ShowS #

show :: Path a b -> String #

showList :: [Path a b] -> ShowS #

(Eq around, Eq between) => Eq (Path around between) Source # 
Instance details

Defined in Common

Methods

(==) :: Path around between -> Path around between -> Bool #

(/=) :: Path around between -> Path around between -> Bool #

(Ord around, Ord between) => Ord (Path around between) Source # 
Instance details

Defined in Common

Methods

compare :: Path around between -> Path around between -> Ordering #

(<) :: Path around between -> Path around between -> Bool #

(<=) :: Path around between -> Path around between -> Bool #

(>) :: Path around between -> Path around between -> Bool #

(>=) :: Path around between -> Path around between -> Bool #

max :: Path around between -> Path around between -> Path around between #

min :: Path around between -> Path around between -> Path around between #

type Rep (Path around between) Source # 
Instance details

Defined in Common

type Rep (Path around between) = D1 ('MetaData "Path" "Common" "proto-voice-model-0.1.0.0-IpbUkUcWDicKjQK7SlZCoP" 'False) (C1 ('MetaCons "Path" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 around) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 between) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Path around between)))) :+: C1 ('MetaCons "PathEnd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 around)))

pathLen :: Path a b -> Int Source #

Returns the number of arounds in the path.

pathHead :: Path a b -> a Source #

Returns the first around in the path.

pathSetHead :: Path a b -> a -> Path a b Source #

Replaces the first around in the path.

mapArounds :: (a -> a') -> Path a b -> Path a' b Source #

Maps a function over every around in the path.

mapAroundsWithIndex :: Int -> (Int -> a -> a') -> Path a b -> Path a' b Source #

Maps a function over every around in the path together with its index.

mapBetweens :: (a -> b -> a -> c) -> Path a b -> [c] Source #

Maps a function over every between and its adjacent arounds in the path.

reversePath :: Path a b -> Path a b Source #

Reverses the path.

pathArounds :: Path a b -> [a] Source #

Returns the list of arounds in the path.

pathBetweens :: Path a b -> [b] Source #

Returns the list of betweens in the path).

StartStop

StartStop is a wrapper that augments a type with special values for beginning and end.

data StartStop a Source #

A container type that augements the type a with symbols for beginning (Start, ⋊) and end (Stop, ⋉). Every other value is wrapped in an Inner constructor.

Constructors

Start 
Inner !a 
Stop 

Instances

Instances details
Foldable StartStop Source # 
Instance details

Defined in Common

Methods

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

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

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

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

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

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

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

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

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

toList :: StartStop a -> [a] #

null :: StartStop a -> Bool #

length :: StartStop a -> Int #

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

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

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

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

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

Traversable StartStop Source # 
Instance details

Defined in Common

Methods

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

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

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

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

Functor StartStop Source # 
Instance details

Defined in Common

Methods

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

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

FromJSON a => FromJSON (StartStop a) Source # 
Instance details

Defined in Common

Generic (StartStop a) Source # 
Instance details

Defined in Common

Associated Types

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

Methods

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

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

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

Defined in Common

NFData a => NFData (StartStop a) Source # 
Instance details

Defined in Common

Methods

rnf :: StartStop a -> () #

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

Defined in Common

Methods

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

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

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

Defined in Common

Hashable a => Hashable (StartStop a) Source # 
Instance details

Defined in Common

Methods

hashWithSalt :: Int -> StartStop a -> Int #

hash :: StartStop a -> Int #

Notation a => Notation (StartStop a) Source # 
Instance details

Defined in Common

type Rep (StartStop a) Source # 
Instance details

Defined in Common

type Rep (StartStop a) = D1 ('MetaData "StartStop" "Common" "proto-voice-model-0.1.0.0-IpbUkUcWDicKjQK7SlZCoP" 'False) (C1 ('MetaCons "Start" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Inner" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 a)) :+: C1 ('MetaCons "Stop" 'PrefixI 'False) (U1 :: Type -> Type)))

onlyInner :: [StartStop a] -> [a] Source #

From a list of StartStops returns only the elements that are not :⋊ or :⋉, unwrapped to their original type.

getInner :: StartStop a -> Maybe a Source #

Returns the content of an Inner, or Nothing.

getInnerE :: StartStop a -> Either String a Source #

Returns the content of an Inner, or a Left with an error message.

isInner :: StartStop a -> Bool Source #

Returns True iff the argument is an Inner.

isStart :: StartStop a -> Bool Source #

Returns True iff the argument is Start.

isStop :: StartStop a -> Bool Source #

Returns True iff the argument is Stop.

distStartStop :: StartStop (a, b) -> (StartStop a, StartStop b) Source #

Turns a pair within a StartStop into a pair of StartStops

Evaluators

Evaluators (Eval) are the main parsing interface for a grammar. They bundle a number of functions that compute local "completions" (i.e., parent objects and generative operations) from child objects. Parsers use these evaluators to generically parse an input sequence since all the grammar-specific parsing code is provided by the evaluator.

Evaluators can be transformed and combined using mapEvalScore and productEval respectively.

data SplitType Source #

A flag that indicates where a split has been performed, on the left transition, the right transition, or the only transition

type UnspreadMiddle tr slc v = (slc, tr, slc) -> Maybe (slc, v) Source #

An evaluator for unspreads. Takes the two child slices and the middle transition. Returns the parent slice and the spread operation, if possible.

type UnspreadLeft tr slc = (tr, slc) -> slc -> [tr] Source #

An evaluator returning the possible left parent edges of an unspread. The first argument is a pair of left child transition and left child slice. The second argument is the parent slice.

type UnspreadRight tr slc = (slc, tr) -> slc -> [tr] Source #

An evaluator returning the possible right parent edges of an unspread. The first argument is a pair of right child slice and right child transition. The second argument is the parent slice.

type Unsplit tr slc v = StartStop slc -> tr -> slc -> tr -> StartStop slc -> SplitType -> [(tr, v)] Source #

An evaluator for unsplits. Returns possible unsplits of a given pair of transitions.

data Eval tr tr' slc slc' v Source #

A combined evaluator for unsplits, unspreads, and unfreezes. Additionally, contains a function for mapping terminal slices to derivation slices.

Constructors

Eval 

Fields

type IsLast = Bool Source #

A flag indicating whether an operation is performed on the last transition.

mapEvalScore :: (v -> w) -> Eval tr tr' slc slc' v -> Eval tr tr' slc slc' w Source #

Maps a function over all scores produced by the evaluator.

productEval :: Eval tr1 tr' slc1 slc' v1 -> Eval tr2 tr' slc2 slc' v2 -> Eval (tr1, tr2) tr' (slc1, slc2) slc' (v1, v2) Source #

Combine two evaluators into a product evaluator. Each evaluation function returns the product of the two component evaluators' results.

Special Restricting Evaluators

Some special evaluators that can be combined with grammar-specific evaluators to restrict the possibile derivations.

data RightBranchSpread Source #

A flag that is used to restrict spread operations to right branching.

Constructors

RBBranches 
RBClear 

Instances

Instances details
Generic RightBranchSpread Source # 
Instance details

Defined in Common

Associated Types

type Rep RightBranchSpread :: Type -> Type #

Show RightBranchSpread Source # 
Instance details

Defined in Common

NFData RightBranchSpread Source # 
Instance details

Defined in Common

Methods

rnf :: RightBranchSpread -> () #

Eq RightBranchSpread Source # 
Instance details

Defined in Common

Ord RightBranchSpread Source # 
Instance details

Defined in Common

Hashable RightBranchSpread Source # 
Instance details

Defined in Common

type Rep RightBranchSpread Source # 
Instance details

Defined in Common

type Rep RightBranchSpread = D1 ('MetaData "RightBranchSpread" "Common" "proto-voice-model-0.1.0.0-IpbUkUcWDicKjQK7SlZCoP" 'False) (C1 ('MetaCons "RBBranches" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "RBClear" 'PrefixI 'False) (U1 :: Type -> Type))

evalRightBranchSpread :: Eval RightBranchSpread tr' () slc' () Source #

An evaluator that doesn't parse the input but restricts spread operations to right branching. Legal combinations will just return a singleton () while illegal combinations return nothing. Combine this with any evaluator as a product (using productEval or rightBranchSpread) to make the evaluator right-branching.

rightBranchSpread :: Eval tr tr' slc slc' w -> Eval (RightBranchSpread, tr) tr' ((), slc) slc' w Source #

Restrict any evaluator to right-branching spreads.

data Merged Source #

A flag for indicating whether a transition is the result of a split or not. This is used for restricting the order of splits and spreads.

Constructors

Merged 
NotMerged 

Instances

Instances details
Generic Merged Source # 
Instance details

Defined in Common

Associated Types

type Rep Merged :: Type -> Type #

Methods

from :: Merged -> Rep Merged x #

to :: Rep Merged x -> Merged #

Show Merged Source # 
Instance details

Defined in Common

NFData Merged Source # 
Instance details

Defined in Common

Methods

rnf :: Merged -> () #

Eq Merged Source # 
Instance details

Defined in Common

Methods

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

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

Ord Merged Source # 
Instance details

Defined in Common

Hashable Merged Source # 
Instance details

Defined in Common

Methods

hashWithSalt :: Int -> Merged -> Int #

hash :: Merged -> Int #

type Rep Merged Source # 
Instance details

Defined in Common

type Rep Merged = D1 ('MetaData "Merged" "Common" "proto-voice-model-0.1.0.0-IpbUkUcWDicKjQK7SlZCoP" 'False) (C1 ('MetaCons "Merged" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NotMerged" 'PrefixI 'False) (U1 :: Type -> Type))

evalSplitBeforeSpread :: Eval Merged tr' () slc' () Source #

An evaluator that doesn't parse the input but restricts the order of operations to always have splits before spreads on the left and right transitions at a spread. Legal combinations will just return a singleton () while illegal combinations return nothing. Combine this with any evaluator as a product (using productEval or splitFirst) to make the evaluator order-restricted.

splitFirst :: Eval tr tr' slc slc' w -> Eval (Merged, tr) tr' ((), slc) slc' w Source #

Restrict any evaluator to split-before-spread order.

Leftmost Derivations

Derivations can be represented as lists of operations in leftmost-first order. In this order, each operation (split, spread, or freeze) is applied to the leftmost non-terminal transition(s).

More specifically, if there is only one open transition left, only two actions are possible, freezing or splitting that transition:

freeze only:   split only:
...=[]——⋉      ==[]——⋉
...=[]==⋉         \  /
                    []

These options are encoded in LeftmostSingle.

If two or more transitions are still open, four actions are possible:

freeze left:         split left:          split right:         spread:
...=[]——[]——[]—...   ...=[]——[]——[]—...   ...=[]——[]——[]—...   ...=[]——[]——[]—...
...=[]==[]——[]—...        \  /                     \  /             \  /\  /
                           []                       []               []——[]

These options are encoded in LeftmostDouble. Note that the order of operations is restricted so that after a right split only only another right split or a spread are allowed. See below for a way to construct leftmost derivations in a type-safe way, checking operation order and open transitions at compile time.

Both single and double operations are combined in Leftmost. All three operation containers are parameterized over the specific operations types for splits (s), spreads (h for "horizontalization"), freezes (f).

data Leftmost s f h Source #

A combined datatype for all leftmost-derivation operations.

Constructors

LMSingle !(LeftmostSingle s f) 
LMDouble !(LeftmostDouble s f h) 

Bundled Patterns

pattern LMFreezeLeft :: f -> Leftmost s f h 
pattern LMFreezeOnly :: f -> Leftmost s f h 
pattern LMSplitLeft :: s -> Leftmost s f h 
pattern LMSplitOnly :: s -> Leftmost s f h 
pattern LMSplitRight :: s -> Leftmost s f h 
pattern LMSpread :: h -> Leftmost s f h 

Instances

Instances details
(FromJSON s, FromJSON f, FromJSON h) => FromJSON (Leftmost s f h) Source # 
Instance details

Defined in Common

Methods

parseJSON :: Value -> Parser (Leftmost s f h) #

parseJSONList :: Value -> Parser [Leftmost s f h] #

(ToJSON s, ToJSON f, ToJSON h) => ToJSON (Leftmost s f h) Source # 
Instance details

Defined in Common

Methods

toJSON :: Leftmost s f h -> Value #

toEncoding :: Leftmost s f h -> Encoding #

toJSONList :: [Leftmost s f h] -> Value #

toEncodingList :: [Leftmost s f h] -> Encoding #

Generic (Leftmost s f h) Source # 
Instance details

Defined in Common

Associated Types

type Rep (Leftmost s f h) :: Type -> Type #

Methods

from :: Leftmost s f h -> Rep (Leftmost s f h) x #

to :: Rep (Leftmost s f h) x -> Leftmost s f h #

(Show s, Show f, Show h) => Show (Leftmost s f h) Source # 
Instance details

Defined in Common

Methods

showsPrec :: Int -> Leftmost s f h -> ShowS #

show :: Leftmost s f h -> String #

showList :: [Leftmost s f h] -> ShowS #

(NFData s, NFData f, NFData h) => NFData (Leftmost s f h) Source # 
Instance details

Defined in Common

Methods

rnf :: Leftmost s f h -> () #

(Eq s, Eq f, Eq h) => Eq (Leftmost s f h) Source # 
Instance details

Defined in Common

Methods

(==) :: Leftmost s f h -> Leftmost s f h -> Bool #

(/=) :: Leftmost s f h -> Leftmost s f h -> Bool #

(Ord s, Ord f, Ord h) => Ord (Leftmost s f h) Source # 
Instance details

Defined in Common

Methods

compare :: Leftmost s f h -> Leftmost s f h -> Ordering #

(<) :: Leftmost s f h -> Leftmost s f h -> Bool #

(<=) :: Leftmost s f h -> Leftmost s f h -> Bool #

(>) :: Leftmost s f h -> Leftmost s f h -> Bool #

(>=) :: Leftmost s f h -> Leftmost s f h -> Bool #

max :: Leftmost s f h -> Leftmost s f h -> Leftmost s f h #

min :: Leftmost s f h -> Leftmost s f h -> Leftmost s f h #

type Rep (Leftmost s f h) Source # 
Instance details

Defined in Common

type Rep (Leftmost s f h) = D1 ('MetaData "Leftmost" "Common" "proto-voice-model-0.1.0.0-IpbUkUcWDicKjQK7SlZCoP" 'False) (C1 ('MetaCons "LMSingle" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LeftmostSingle s f))) :+: C1 ('MetaCons "LMDouble" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LeftmostDouble s f h))))

data LeftmostSingle s f Source #

Generative operations on a single transition (split or freeze).

Constructors

LMSingleSplit !s 
LMSingleFreeze !f 

Instances

Instances details
Foldable (LeftmostSingle s) Source # 
Instance details

Defined in Common

Methods

fold :: Monoid m => LeftmostSingle s m -> m #

foldMap :: Monoid m => (a -> m) -> LeftmostSingle s a -> m #

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

foldr :: (a -> b -> b) -> b -> LeftmostSingle s a -> b #

foldr' :: (a -> b -> b) -> b -> LeftmostSingle s a -> b #

foldl :: (b -> a -> b) -> b -> LeftmostSingle s a -> b #

foldl' :: (b -> a -> b) -> b -> LeftmostSingle s a -> b #

foldr1 :: (a -> a -> a) -> LeftmostSingle s a -> a #

foldl1 :: (a -> a -> a) -> LeftmostSingle s a -> a #

toList :: LeftmostSingle s a -> [a] #

null :: LeftmostSingle s a -> Bool #

length :: LeftmostSingle s a -> Int #

elem :: Eq a => a -> LeftmostSingle s a -> Bool #

maximum :: Ord a => LeftmostSingle s a -> a #

minimum :: Ord a => LeftmostSingle s a -> a #

sum :: Num a => LeftmostSingle s a -> a #

product :: Num a => LeftmostSingle s a -> a #

Traversable (LeftmostSingle s) Source # 
Instance details

Defined in Common

Methods

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

sequenceA :: Applicative f => LeftmostSingle s (f a) -> f (LeftmostSingle s a) #

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

sequence :: Monad m => LeftmostSingle s (m a) -> m (LeftmostSingle s a) #

Functor (LeftmostSingle s) Source # 
Instance details

Defined in Common

Methods

fmap :: (a -> b) -> LeftmostSingle s a -> LeftmostSingle s b #

(<$) :: a -> LeftmostSingle s b -> LeftmostSingle s a #

(ToJSON s, ToJSON f) => ToJSON (LeftmostSingle s f) Source # 
Instance details

Defined in Common

Generic (LeftmostSingle s f) Source # 
Instance details

Defined in Common

Associated Types

type Rep (LeftmostSingle s f) :: Type -> Type #

Methods

from :: LeftmostSingle s f -> Rep (LeftmostSingle s f) x #

to :: Rep (LeftmostSingle s f) x -> LeftmostSingle s f #

(Show s, Show f) => Show (LeftmostSingle s f) Source # 
Instance details

Defined in Common

(NFData s, NFData f) => NFData (LeftmostSingle s f) Source # 
Instance details

Defined in Common

Methods

rnf :: LeftmostSingle s f -> () #

(Eq s, Eq f) => Eq (LeftmostSingle s f) Source # 
Instance details

Defined in Common

(Ord s, Ord f) => Ord (LeftmostSingle s f) Source # 
Instance details

Defined in Common

type Rep (LeftmostSingle s f) Source # 
Instance details

Defined in Common

type Rep (LeftmostSingle s f) = D1 ('MetaData "LeftmostSingle" "Common" "proto-voice-model-0.1.0.0-IpbUkUcWDicKjQK7SlZCoP" 'False) (C1 ('MetaCons "LMSingleSplit" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 s)) :+: C1 ('MetaCons "LMSingleFreeze" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 f)))

data LeftmostDouble s f h Source #

Generative operations on two transitions (split left, freeze left, split right, or spread)

Instances

Instances details
(ToJSON s, ToJSON f, ToJSON h) => ToJSON (LeftmostDouble s f h) Source # 
Instance details

Defined in Common

Generic (LeftmostDouble s f h) Source # 
Instance details

Defined in Common

Associated Types

type Rep (LeftmostDouble s f h) :: Type -> Type #

Methods

from :: LeftmostDouble s f h -> Rep (LeftmostDouble s f h) x #

to :: Rep (LeftmostDouble s f h) x -> LeftmostDouble s f h #

(Show s, Show f, Show h) => Show (LeftmostDouble s f h) Source # 
Instance details

Defined in Common

Methods

showsPrec :: Int -> LeftmostDouble s f h -> ShowS #

show :: LeftmostDouble s f h -> String #

showList :: [LeftmostDouble s f h] -> ShowS #

(NFData s, NFData f, NFData h) => NFData (LeftmostDouble s f h) Source # 
Instance details

Defined in Common

Methods

rnf :: LeftmostDouble s f h -> () #

(Eq s, Eq f, Eq h) => Eq (LeftmostDouble s f h) Source # 
Instance details

Defined in Common

Methods

(==) :: LeftmostDouble s f h -> LeftmostDouble s f h -> Bool #

(/=) :: LeftmostDouble s f h -> LeftmostDouble s f h -> Bool #

(Ord s, Ord f, Ord h) => Ord (LeftmostDouble s f h) Source # 
Instance details

Defined in Common

Methods

compare :: LeftmostDouble s f h -> LeftmostDouble s f h -> Ordering #

(<) :: LeftmostDouble s f h -> LeftmostDouble s f h -> Bool #

(<=) :: LeftmostDouble s f h -> LeftmostDouble s f h -> Bool #

(>) :: LeftmostDouble s f h -> LeftmostDouble s f h -> Bool #

(>=) :: LeftmostDouble s f h -> LeftmostDouble s f h -> Bool #

max :: LeftmostDouble s f h -> LeftmostDouble s f h -> LeftmostDouble s f h #

min :: LeftmostDouble s f h -> LeftmostDouble s f h -> LeftmostDouble s f h #

type Rep (LeftmostDouble s f h) Source # 
Instance details

Defined in Common

type Rep (LeftmostDouble s f h) = D1 ('MetaData "LeftmostDouble" "Common" "proto-voice-model-0.1.0.0-IpbUkUcWDicKjQK7SlZCoP" 'False) ((C1 ('MetaCons "LMDoubleSplitLeft" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 s)) :+: C1 ('MetaCons "LMDoubleFreezeLeft" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 f))) :+: (C1 ('MetaCons "LMDoubleSplitRight" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 s)) :+: C1 ('MetaCons "LMDoubleSpread" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 h))))

data Analysis s f h tr slc Source #

Encodes an analysis of a piece, consisting of a "top" (the starting point of the derivation, i.e., the smallest reduction in the analysis) and a derivation of the piece's surface from the top.

Use this type's FromJSON instance to load an analysis exported by the protovoice annotation tool.

Constructors

Analysis 

Fields

Instances

Instances details
(FromJSON s, FromJSON f, FromJSON h, FromJSON tr, FromJSON slc) => FromJSON (Analysis s f h tr slc) Source # 
Instance details

Defined in Common

Methods

parseJSON :: Value -> Parser (Analysis s f h tr slc) #

parseJSONList :: Value -> Parser [Analysis s f h tr slc] #

Generic (Analysis s f h tr slc) Source # 
Instance details

Defined in Common

Associated Types

type Rep (Analysis s f h tr slc) :: Type -> Type #

Methods

from :: Analysis s f h tr slc -> Rep (Analysis s f h tr slc) x #

to :: Rep (Analysis s f h tr slc) x -> Analysis s f h tr slc #

(Show s, Show f, Show h, Show tr, Show slc) => Show (Analysis s f h tr slc) Source # 
Instance details

Defined in Common

Methods

showsPrec :: Int -> Analysis s f h tr slc -> ShowS #

show :: Analysis s f h tr slc -> String #

showList :: [Analysis s f h tr slc] -> ShowS #

(Eq s, Eq f, Eq h, Eq tr, Eq slc) => Eq (Analysis s f h tr slc) Source # 
Instance details

Defined in Common

Methods

(==) :: Analysis s f h tr slc -> Analysis s f h tr slc -> Bool #

(/=) :: Analysis s f h tr slc -> Analysis s f h tr slc -> Bool #

(Ord s, Ord f, Ord h, Ord tr, Ord slc) => Ord (Analysis s f h tr slc) Source # 
Instance details

Defined in Common

Methods

compare :: Analysis s f h tr slc -> Analysis s f h tr slc -> Ordering #

(<) :: Analysis s f h tr slc -> Analysis s f h tr slc -> Bool #

(<=) :: Analysis s f h tr slc -> Analysis s f h tr slc -> Bool #

(>) :: Analysis s f h tr slc -> Analysis s f h tr slc -> Bool #

(>=) :: Analysis s f h tr slc -> Analysis s f h tr slc -> Bool #

max :: Analysis s f h tr slc -> Analysis s f h tr slc -> Analysis s f h tr slc #

min :: Analysis s f h tr slc -> Analysis s f h tr slc -> Analysis s f h tr slc #

type Rep (Analysis s f h tr slc) Source # 
Instance details

Defined in Common

type Rep (Analysis s f h tr slc) = D1 ('MetaData "Analysis" "Common" "proto-voice-model-0.1.0.0-IpbUkUcWDicKjQK7SlZCoP" 'False) (C1 ('MetaCons "Analysis" 'PrefixI 'True) (S1 ('MetaSel ('Just "anaDerivation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Leftmost s f h]) :*: S1 ('MetaSel ('Just "anaTop") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Path tr slc))))

debugAnalysis :: forall tr slc s f h. (Show tr, Show slc, Show s, Show h) => (s -> tr -> Either String (tr, slc, tr)) -> (f -> tr -> Either String tr) -> (h -> tr -> slc -> tr -> Either String (tr, slc, tr, slc, tr)) -> Analysis s f h tr slc -> IO (Either String ()) Source #

Prints the steps and intermediate configurations of a derivation.

mkLeftmostEval :: UnspreadMiddle tr slc h -> UnspreadLeft tr slc -> UnspreadRight tr slc -> (StartStop slc -> tr -> slc -> tr -> StartStop slc -> [(tr, s)]) -> (StartStop slc -> Maybe tr' -> StartStop slc -> [(tr, f)]) -> (slc' -> slc) -> Eval tr tr' slc slc' (Leftmost s f h) Source #

Create a leftmost evaluator from position-independent evaluation functions that just return spread, split, and freeze operations by wrapping those into the appropriate Leftmost constructors.

Monadic Interface for Constructing Derivations

Use these functions to manually build a derivation, checking leftmost-correctness in the type. A good way to do this is to start a derivation using buildDerivation or buildPartialDerivation and follow up with a do block that contains a sequence of split, freeze, splitRight and spread actions..

deriv :: [Leftmost () () ()] -- using unit for each operation type
deriv = buildDerivation $ do -- start with 1 transition
  split ()      -- (2 open transitions)
  splitRight () -- (3 open)
  spread ()     -- (4 open)
  freeze ()     -- (3 open)
  split ()      -- (4 open)
  freeze ()     -- (3 open)
  freeze ()     -- (2 open)
  freeze ()     -- (1 open)
  freeze ()     -- (0 open, end of derivation)

The above example results in the following derivation graph:

Since PartialDerivation is an indexed monad (it's exact type changes between actions), using do-notation requires you to rebind its syntax to use indexed versions of >>= and >> using the QualifiedDo extension. The easiest way to do use the generic operators from Language.Haskell.DoNotation by using this module as the do qualifier:

import qualified Language.Haskell.DoNotation as Do

deriv = buildDerivation $ Do.do -- requires -XQualifiedDo
  split ()
  ...

newtype PartialDerivation s f h (openTrans :: Nat) (afterRightSplit :: Bool) Source #

A wrapper around leftmost derivations that tracks information about the derivation state in the type. Number of open transitions: openTrans. Whether a right split has been performed at the current point: afterRightSplit.

Constructors

PD 

Fields

data DerivationInfo a b Source #

A type-level wrapper for partial derivation info. Encodes the number of open transitions and whether the last operation was a right split.

data IndexedWriter w i j a Source #

An "indexed" version of a writer monad, i.e. one where the monad type between two steps can change. This can be used for tracking the number of open transitions in a derivation on the type level while still providing an monadic interface for constructing a derivation.

Instances

Instances details
IxFunctor (IndexedWriter w :: k -> k1 -> Type -> TYPE LiftedRep) Source # 
Instance details

Defined in Common

Methods

imap :: forall a b (j :: k0) (k2 :: k10). (a -> b) -> IndexedWriter w j k2 a -> IndexedWriter w j k2 b #

Monoid w => IxMonad (IndexedWriter w :: k -> k -> Type -> TYPE LiftedRep) Source # 
Instance details

Defined in Common

Methods

ibind :: forall a (j :: k0) (k1 :: k0) b (i :: k0). (a -> IndexedWriter w j k1 b) -> IndexedWriter w i j a -> IndexedWriter w i k1 b #

Monoid w => IxApplicative (IndexedWriter w :: k -> k -> Type -> TYPE LiftedRep) Source # 
Instance details

Defined in Common

Methods

iap :: forall (i :: k0) (j :: k0) a b (k1 :: k0). IndexedWriter w i j (a -> b) -> IndexedWriter w j k1 a -> IndexedWriter w i k1 b #

Monoid w => IxPointed (IndexedWriter w :: k -> k -> Type -> TYPE LiftedRep) Source # 
Instance details

Defined in Common

Methods

ireturn :: forall a (i :: k0). a -> IndexedWriter w i i a #

itell :: Monoid w => w -> IndexedWriter w i j () Source #

type DerivationAction s f h n n' afterRight afterRight' = IndexedWriter [Leftmost s f h] (DerivationInfo n afterRight) (DerivationInfo n' afterRight') () Source #

The type of a monadic derivation action that modifies the derivation state (number of open transitions, after right split).

buildDerivation :: DerivationAction s f h 1 n 'False snd -> [Leftmost s f h] Source #

Turn a monadically constructed derivation into a proper left-most derivation. This function assumes the derivation to start with a single transition.

buildPartialDerivation :: forall n n' snd s f h. DerivationAction s f h n n' 'False snd -> [Leftmost s f h] Source #

Turn a monadically constructed partial derivation into a left-most derivation. This function does not restrict the number of transitions in the starting configuration.

split :: forall n s f h. (KnownNat n, 1 <= n) => s -> DerivationAction s f h n (n + 1) 'False 'False Source #

Turn a split operation into a monadic (left or single) split action.

freeze :: forall n s h f. (KnownNat n, 1 <= n) => f -> DerivationAction s f h n (n - 1) 'False 'False Source #

Turn a freeze operation into a monadic (left or single) freeze action.

splitRight :: 2 <= n => s -> DerivationAction s f h n (n + 1) snd 'True Source #

Turn a split operation into a monadic right-split action.

spread :: 2 <= n => h -> DerivationAction s f h n (n + 1) snd 'False Source #

Turn a spread operation into a monadic spread action.

Derivations Semiring

A generic semiring that represents a collection of derivations as prefix trees.

data Derivations a Source #

The derivations semiring. Similar to a free semiring, encodes sequences, alternatives, and neutral values directly. However, semiring equivalences are not idendified by default.

Constructors

Do !a

a single operation

Or !(Derivations a) !(Derivations a)

combines alternative derivations

Then !(Derivations a) !(Derivations a)

combines sequential derivations

NoOp

the neutral element to Then

Cannot

the neutral element to Or

Instances

Instances details
Generic (Derivations a) Source # 
Instance details

Defined in Common

Associated Types

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

Methods

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

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

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

Defined in Common

NFData a => NFData (Derivations a) Source # 
Instance details

Defined in Common

Methods

rnf :: Derivations a -> () #

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

Defined in Common

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

Defined in Common

Semiring (Derivations a) Source # 
Instance details

Defined in Common

type Rep (Derivations a) Source # 
Instance details

Defined in Common

mapDerivations :: Semiring r => (a -> r) -> Derivations a -> r Source #

Map the Derivations semiring to another semiring.

flattenDerivations :: Ord a => Derivations a -> Set [a] Source #

Flatten the prefix-tree structure of Derivations into a simple set of derivations.

flattenDerivationsRed :: Ord a => Derivations a -> [[a]] Source #

Flatten the prefix-tree structure of Derivations into a simple list of (potentially redundant) derivations.

firstDerivation :: Ord a => Derivations a -> Maybe [a] Source #

Obtain the first derivation from a Derivations tree.

Utilities

traceLevel :: Int Source #

The global trace level. Only trace messages >= this level are shown.

traceIf :: Int -> [Char] -> Bool -> Bool Source #

A helper for conditionally tracing a message.

showTex :: Show a => a -> String Source #

Convert special characters to TeX commands.

showTexT :: Show a => a -> Text Source #

Convert special characters to TeX commands (using Text)