-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | A natural language generator (specifically, an FB-LTAG surface realiser) -- -- A natural language generator (specifically, an FB-LTAG surface -- realiser) @package GenI @version 0.22 module NLP.GenI.Statistics data Statistics type StatisticsState a = forall m. MonadState Statistics m => m a emptyStats :: Statistics showFinalStats :: Statistics -> String initialStatisticsStateFor :: MonadState Statistics m => (m a -> Statistics -> b) -> m a -> b -- | Adds a metric at the beginning of the list (note we reverse the order -- whene we want to print the metrics) addMetric :: Metric -> StatisticsState () data Metric IntMetric :: String -> Int -> Metric queryMetrics :: (Metric -> Maybe a) -> Statistics -> [a] updateMetrics :: (Metric -> Metric) -> Statistics -> Statistics incrIntMetric :: String -> Int -> Metric -> Metric queryIntMetric :: String -> Metric -> Maybe Int instance NFData Metric instance NFData Statistics instance JSON Statistics instance Show Metric -- | This is not a proper pretty printer. I aim is to replace this with a -- (de-facto) standard library if one should appear module NLP.GenI.Pretty -- | An alternative Show instance (the idea being that we should -- reserve Show for outputting actual Haskell) -- -- Minimal implementation is pretty or prettyStr class Pretty a where pretty = pack . prettyStr prettyStr = unpack . pretty pretty :: Pretty a => a -> Text prettyStr :: Pretty a => a -> String between :: Text -> Text -> Text -> Text parens :: Text -> Text squares :: Text -> Text -- | Identical to append (<>) :: Text -> Text -> Text -- | Separated by space unless one of them is empty (in which case just the -- non-empty one) (<+>) :: Text -> Text -> Text -- | I think I want ($+$) here but I'm not sure I understand the -- documentation from the pretty package. -- -- t1 above t2 separates the two by a newline, unless one -- of them is empty. The vertical equivalent to '(+)' above :: Text -> Text -> Text -- | 
--   prettyCount toBlah ""     (x,1) == "blah"
--   prettyCount toBlah "foos" (x,1) == "blah"
--   prettyCount toBlah ""     (x,4) == "blah ×4"
--   prettyCount toBlah "foos" (x,4) == "blah ×4 foos"
--
prettyCount :: (a -> Text) -> Text -> (a, Int) -> Text instance Pretty Integer instance Pretty Int instance Pretty String module NLP.GenI.GeniShow -- | GenI format; should round-trip with Parser by rights -- -- Minimal definition, either one of geniShow or -- geniShowText class GeniShow a where geniShow = unpack . geniShowText geniShowText = pack . geniShow geniShow :: GeniShow a => a -> String geniShowText :: GeniShow a => a -> Text geniShowTree :: GeniShow a => Int -> Tree a -> Text geniKeyword :: Text -> Text -> Text instance GeniShow a => GeniShow (Tree a) module NLP.GenI.Polarity.Types data PolarityKey PolarityKeyAv :: Text -> Text -> PolarityKey PolarityKeyStr :: Text -> PolarityKey -- | attribute PolarityKeyVar :: Text -> PolarityKey type SemPols = [Int] -- | PolarityAttr is something you want to perform detect polarities -- on. data PolarityAttr SimplePolarityAttr :: Text -> PolarityAttr spkAtt :: PolarityAttr -> Text -- | RestrictedPolarityKey c att is a polarity key in -- which we only pay attention to nodes that have the category -- c. This makes it possible to have polarities for a just a -- small subset of nodes RestrictedPolarityAttr :: Text -> Text -> PolarityAttr _rpkCat :: PolarityAttr -> Text rpkAtt :: PolarityAttr -> Text readPolarityAttrs :: String -> Set PolarityAttr showPolarityAttrs :: Set PolarityAttr -> String instance Typeable PolarityKey instance Typeable PolarityAttr instance Eq PolarityKey instance Ord PolarityKey instance Data PolarityKey instance Eq PolarityAttr instance Ord PolarityAttr instance NFData PolarityAttr instance NFData PolarityKey instance Show PolarityAttr instance Pretty PolarityKey -- | This module provides some very generic, non-GenI specific functions on -- strings, trees and other miscellaneous odds and ends. Whenever -- possible, one should try to replace these functions with versions that -- are available in the standard libraries, or the Haskell platform ones, -- or on hackage. module NLP.GenI.General -- | putStr on stderr ePutStr :: String -> IO () ePutStrLn :: String -> IO () eFlush :: IO () isGeniIdentLetter :: Char -> Bool -- | Drop all characters up to and including the one in question dropTillIncluding :: Char -> String -> String trim :: String -> String -- | Make the first character of a string upper case toUpperHead :: String -> String -- | Make the first character of a string lower case toLowerHead :: String -> String -- | An alphanumeric sort is one where you treat the numbers in the string -- as actual numbers. An alphanumeric sort would put x2 before x100, -- because 2 < 10, wheraeas a naive sort would put it the other way -- around because the characters 1 < 2. To sort alphanumerically, just -- 'sortBy (comparing toAlphaNum)' toAlphaNum :: String -> [AlphaNum] quoteString :: String -> String quoteText :: Text -> Text -- | break a list of items into sublists of length < the clump size, -- taking into consideration that each item in the clump will have a -- single gap of padding interspersed -- -- any item whose length is greater than the clump size is put into a -- clump by itself -- -- given a length function clumpBy (length.show) 8 [hello, -- this, is, a, list] clumpBy :: (a -> Int) -> Int -> [a] -> [[a]] first3 :: (a -> a2) -> (a, b, c) -> (a2, b, c) second3 :: (b -> b2) -> (a, b, c) -> (a, b2, c) third3 :: (c -> c2) -> (a, b, c) -> (a, b, c2) fst3 :: (a, b, c) -> a snd3 :: (a, b, c) -> b thd3 :: (a, b, c) -> c -- | A strict version of map map' :: (a -> b) -> [a] -> [b] buckets :: Ord b => (a -> b) -> [a] -> [(b, [a])] -- | True if the intersection of two lists is empty. isEmptyIntersect :: Eq a => [a] -> [a] -> Bool -- | Serves the same function as groupBy. It groups together items -- by some property they have in common. The difference is that the -- property is used as a key to a Map that you can lookup. groupByFM :: Ord b => (a -> b) -> [a] -> (Map b [a]) insertToListMap :: Ord b => b -> a -> Map b [a] -> Map b [a] histogram :: Ord a => [a] -> Map a Int combinations :: [[a]] -> [[a]] mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b] -- | Return the list, modifying only the first matching item. repList :: (a -> Bool) -> (a -> a) -> [a] -> [a] -- | Strict version of mapTree (for non-strict, just use fmap) mapTree' :: (a -> b) -> Tree a -> Tree b -- | Like filter, except on Trees. Filter might not be a good name, -- though, because we return a list of nodes, not a tree. filterTree :: (a -> Bool) -> Tree a -> [a] -- | The leaf nodes of a Tree treeLeaves :: Tree a -> [a] -- | Return pairs of (parent, terminal) preTerminals :: Tree a -> [(a, a)] -- | repNode fn filt t returns a version of t in -- which the first node which filt matches is transformed using -- fn. repNode :: (Tree a -> Tree a) -> (Tree a -> Bool) -> Tree a -> Maybe (Tree a) -- | Like repNode except that it performs the operations on all -- nodes that match and doesn't care if any nodes match or not repAllNode :: (Tree a -> Tree a) -> (Tree a -> Bool) -> Tree a -> Tree a -- | Like repNode but on a list of tree nodes listRepNode :: (Tree a -> Tree a) -> (Tree a -> Bool) -> [Tree a] -> ([Tree a], Bool) -- | Replace a node in the tree in-place with another node; keep the -- children the same. If the node is not found in the tree, or if there -- are multiple instances of the node, this is treated as an error. repNodeByNode :: (a -> Bool) -> a -> Tree a -> Tree a type Interval = (Int, Int) -- | Add two intervals (!+!) :: Interval -> Interval -> Interval -- | ival x builds a trivial interval from x to -- x ival :: Int -> Interval showInterval :: Interval -> String type BitVector = Integer -- | displays a bit vector, using a minimum number of bits showBitVector :: Int -> BitVector -> String -- | errors specifically in GenI, which is very likely NOT the user's -- fault. geniBug :: String -> a prettyException :: IOException -> String -- | The module name for an arbitrary data type mkLogname :: Typeable a => a -> String instance Eq AlphaNum instance JSON Text instance Ord AlphaNum instance Binary Text -- | This module provides a simple, naive implementation of -- nondeterministic finite automata (NFA). -- -- The transition function consists of a Map, but there are also -- accessor function which help you query the automaton without worrying -- about how it's implemented. -- --
    --
  1. The states are a list of lists, not just a simple flat list as you -- might expect. This allows you to optionally group your states into -- "columns" which is something we use in the GenI polarity automaton -- optimisation.
    2. --
  2. We model the empty an empty transition as the transition on -- Nothing. All other transitions are Just -- something.
    3. --
module NLP.GenI.Automaton -- | Note: you can define the final state either by setting -- isFinalSt to Just f where f is some function -- or by putting them in finalStList data NFA st ab NFA :: st -> Maybe (st -> Bool) -> [st] -> Map st (Map st [Maybe ab]) -> [[st]] -> NFA st ab startSt :: NFA st ab -> st -- | finalSt will use this if defined isFinalSt :: NFA st ab -> Maybe (st -> Bool) -- | can be ignored if isFinalSt is defined finalStList :: NFA st ab -> [st] -- | there can be more than one transition between any two states and a -- transition could be the empty symbol transitions :: NFA st ab -> Map st (Map st [Maybe ab]) -- | if you don't care about grouping states into columns you can just dump -- everything in one big list states :: NFA st ab -> [[st]] -- | finalSt returns all the final states of an automaton finalSt :: NFA st ab -> [st] addTrans :: (Ord ab, Ord st) => NFA st ab -> st -> Maybe ab -> st -> NFA st ab -- | lookupTrans aut st1 ab returns the states that -- st1 transitions to via a. lookupTrans :: (Ord ab, Ord st) => NFA st ab -> st -> (Maybe ab) -> [st] -- | Returns all possible paths through an automaton from the start state -- to any dead-end. -- -- Each path is represented as a list of labels. -- -- We assume that the automaton does not have any loops in it. automatonPaths :: (Ord st, Ord ab) => (NFA st ab) -> [[ab]] -- | The set of all bundled paths. A bundled path is a sequence of states -- through the automaton from the start state to any dead end. Any two -- neighbouring states can have more than one possible transition between -- them, so the bundles can multiply out to a lot of different possible -- paths. -- -- The output is a list of lists of lists: -- -- automatonPathSets :: (Ord st, Ord ab) => (NFA st ab) -> [[[ab]]] numStates :: NFA st ab -> Int numTransitions :: NFA st ab -> Int module Data.FullList.Internal newtype FullList a FullList :: [a] -> FullList a fromFL :: FullList a -> [a] indeedFL :: [a] -> w -> (FullList a -> w) -> w head :: FullList a -> a tail :: FullList a -> [a] (++) :: FullList a -> FullList a -> FullList a sortNub :: (Eq a, Ord a) => FullList a -> FullList a class Listable l (!:) :: Listable l => a -> l a -> FullList a instance Typeable1 FullList instance Eq a => Eq (FullList a) instance Ord a => Ord (FullList a) instance Show a => Show (FullList a) instance Data a => Data (FullList a) instance Binary a => Binary (FullList a) instance NFData a => NFData (FullList a) instance Listable FullList instance Listable [] instance Functor FullList module Data.FullList data FullList a fromFL :: FullList a -> [a] indeedFL :: [a] -> w -> (FullList a -> w) -> w head :: FullList a -> a tail :: FullList a -> [a] (++) :: FullList a -> FullList a -> FullList a sortNub :: (Eq a, Ord a) => FullList a -> FullList a class Listable l (!:) :: Listable l => a -> l a -> FullList a module NLP.GenI.GeniVal.Internal -- | constant : no label, just constraints variable : label, with or -- without constraints anonymous : no label, no constraints data GeniVal GeniVal :: Maybe Text -> Maybe (FullList Text) -> GeniVal gLabel :: GeniVal -> Maybe Text gConstraints :: GeniVal -> Maybe (FullList Text) -- | mkGConst x :! [] creates a single constant. -- mkGConst x :! xs creates an atomic disjunction. It -- makes no difference which of the values you supply for x and -- xs as they will be sorted and nubed anyway. mkGConst :: FullList Text -> GeniVal mkGConstNone :: Text -> GeniVal mkGVar :: Text -> Maybe (FullList Text) -> GeniVal mkGVarNone :: Text -> GeniVal mkGAnon :: GeniVal isConst :: GeniVal -> Bool singletonVal :: GeniVal -> Maybe Text isVar :: GeniVal -> Bool isAnon :: GeniVal -> Bool type Subst = Map Text GeniVal prettySubst :: Subst -> Text -- | unify performs unification on two lists of GeniVal. If -- unification succeeds, it returns Just (r,s) where r -- is the result of unification and verb!s! is a list of substitutions -- that this unification results in. unify :: Monad m => [GeniVal] -> [GeniVal] -> m ([GeniVal], Subst) -- | l1 allSubsume l2 returns the result of l1 -- unify l2 if doing a simultaneous traversal of both lists, -- each item in l1 subsumes the corresponding item in -- l2 allSubsume :: Monad m => [GeniVal] -> [GeniVal] -> m ([GeniVal], Subst) unifyHelper :: Monad m => (GeniVal -> GeniVal -> UnificationResult) -> [GeniVal] -> [GeniVal] -> m ([GeniVal], Subst) -- | Note that the first Subst is assumed to come chronologically before -- the second one; so merging { X -> Y } and { Y -> 3 -- } should give us { X -> 3; Y -> 3 }; -- -- See prependToSubst for a warning! appendSubst :: Subst -> Subst -> Subst -- | Add to variable replacement to a Subst that logical comes -- before the other stuff in it. So for example, if we have Y -> -- foo and we want to insert X -> Y, we notice that, in -- fact, Y has already been replaced by foo, so we add -- X -> foo instead -- -- Note that it is undefined if you try to append something like Y -- -> foo to Y -> bar, because that would mean that -- unification is broken prependToSubst :: (Text, GeniVal) -> Subst -> Subst data UnificationResult SuccessSans :: GeniVal -> UnificationResult SuccessRep :: Text -> GeniVal -> UnificationResult SuccessRep2 :: Text -> Text -> GeniVal -> UnificationResult Failure :: UnificationResult -- | See source code for details -- -- Note that we assume that it's acceptable to generate new variable -- names by appending an x to them; this assumption is only safe -- if the variables have gone through the function -- finaliseVarsById or have been pre-processed and rewritten with -- some kind of common suffix to avoid an accidental match unifyOne :: GeniVal -> GeniVal -> UnificationResult intersectConstraints :: Eq a => Maybe (FullList a) -> Maybe (FullList a) -> Maybe (Maybe (FullList a)) -- | subsumeOne x y returns the same result as unifyOne -- x y if x subsumes y or Failure otherwise subsumeOne :: GeniVal -> GeniVal -> UnificationResult replace :: DescendGeniVal a => Subst -> a -> a replaceOne :: DescendGeniVal a => (Text, GeniVal) -> a -> a -- | Here it is safe to say (X -> Y; Y -> Z) because this would be -- crushed down into a final value of (X -> Z; Y -> Z) replaceList :: DescendGeniVal a => [(Text, GeniVal)] -> a -> a replaceMapG :: Subst -> GeniVal -> GeniVal replaceOneG :: (Text, GeniVal) -> GeniVal -> GeniVal type CollectedVar = (Text, Maybe (FullList Text)) -- | A Collectable is something which can return its variables as a -- map from the variable to the number of times that variable occurs in -- it. -- -- Important invariant: if the variable does not occur, then it does not -- appear in the map (ie. all counts must be >= 1 or the item does not -- occur at all) -- -- By variables, what I most had in mind was the GVar values in a -- GeniVal. This notion is probably not very useful outside the context -- of alpha-conversion task, but it seems general enough that I'll keep -- it around for a good bit, until either some use for it creeps up, or I -- find a more general notion that I can transform this into. class Collectable a collect :: Collectable a => a -> Map CollectedVar Int -> Map CollectedVar Int -- | An Idable is something that can be mapped to a unique id. You might -- consider using this to implement Ord, but I won't. Note that the only -- use I have for this so far (20 dec 2005) is in alpha-conversion. class Idable a idOf :: Idable a => a -> Integer -- | Anonymise any variable that occurs only once in the object anonymiseSingletons :: (Collectable a, DescendGeniVal a) => a -> a finaliseVarsById :: (Collectable a, DescendGeniVal a, Idable a) => a -> a -- | finaliseVars does the following: -- -- finaliseVars :: (Collectable a, DescendGeniVal a) => Text -> a -> a crushOne :: [GeniVal] -> Maybe GeniVal crushList :: [[GeniVal]] -> Maybe [GeniVal] class DescendGeniVal a descendGeniVal :: DescendGeniVal a => (GeniVal -> GeniVal) -> a -> a instance [overlap ok] Typeable GeniVal instance [overlap ok] Eq GeniVal instance [overlap ok] Ord GeniVal instance [overlap ok] Data GeniVal instance [overlap ok] Binary GeniVal instance [overlap ok] NFData GeniVal instance [overlap ok] (Functor f, DescendGeniVal a) => DescendGeniVal (f a) instance [overlap ok] DescendGeniVal GeniVal instance [overlap ok] Collectable GeniVal instance [overlap ok] Collectable a => Collectable [a] instance [overlap ok] Collectable a => Collectable (Maybe a) instance [overlap ok] GeniShow GeniVal instance [overlap ok] Pretty GeniVal module NLP.GenI.GeniVal -- | constant : no label, just constraints variable : label, with or -- without constraints anonymous : no label, no constraints data GeniVal gLabel :: GeniVal -> Maybe Text gConstraints :: GeniVal -> Maybe (FullList Text) -- | mkGConst x :! [] creates a single constant. -- mkGConst x :! xs creates an atomic disjunction. It -- makes no difference which of the values you supply for x and -- xs as they will be sorted and nubed anyway. mkGConst :: FullList Text -> GeniVal mkGConstNone :: Text -> GeniVal mkGVar :: Text -> Maybe (FullList Text) -> GeniVal mkGVarNone :: Text -> GeniVal mkGAnon :: GeniVal isVar :: GeniVal -> Bool isAnon :: GeniVal -> Bool isConst :: GeniVal -> Bool singletonVal :: GeniVal -> Maybe Text crushOne :: [GeniVal] -> Maybe GeniVal -- | finaliseVars does the following: -- -- finaliseVars :: (Collectable a, DescendGeniVal a) => Text -> a -> a finaliseVarsById :: (Collectable a, DescendGeniVal a, Idable a) => a -> a -- | unify performs unification on two lists of GeniVal. If -- unification succeeds, it returns Just (r,s) where r -- is the result of unification and verb!s! is a list of substitutions -- that this unification results in. unify :: Monad m => [GeniVal] -> [GeniVal] -> m ([GeniVal], Subst) data UnificationResult SuccessSans :: GeniVal -> UnificationResult SuccessRep :: Text -> GeniVal -> UnificationResult SuccessRep2 :: Text -> Text -> GeniVal -> UnificationResult Failure :: UnificationResult type Subst = Map Text GeniVal -- | Note that the first Subst is assumed to come chronologically before -- the second one; so merging { X -> Y } and { Y -> 3 -- } should give us { X -> 3; Y -> 3 }; -- -- See prependToSubst for a warning! appendSubst :: Subst -> Subst -> Subst -- | subsumeOne x y returns the same result as unifyOne -- x y if x subsumes y or Failure otherwise subsumeOne :: GeniVal -> GeniVal -> UnificationResult -- | l1 allSubsume l2 returns the result of l1 -- unify l2 if doing a simultaneous traversal of both lists, -- each item in l1 subsumes the corresponding item in -- l2 allSubsume :: Monad m => [GeniVal] -> [GeniVal] -> m ([GeniVal], Subst) class DescendGeniVal a descendGeniVal :: DescendGeniVal a => (GeniVal -> GeniVal) -> a -> a -- | A Collectable is something which can return its variables as a -- map from the variable to the number of times that variable occurs in -- it. -- -- Important invariant: if the variable does not occur, then it does not -- appear in the map (ie. all counts must be >= 1 or the item does not -- occur at all) -- -- By variables, what I most had in mind was the GVar values in a -- GeniVal. This notion is probably not very useful outside the context -- of alpha-conversion task, but it seems general enough that I'll keep -- it around for a good bit, until either some use for it creeps up, or I -- find a more general notion that I can transform this into. class Collectable a collect :: Collectable a => a -> Map CollectedVar Int -> Map CollectedVar Int -- | An Idable is something that can be mapped to a unique id. You might -- consider using this to implement Ord, but I won't. Note that the only -- use I have for this so far (20 dec 2005) is in alpha-conversion. class Idable a idOf :: Idable a => a -> Integer replace :: DescendGeniVal a => Subst -> a -> a -- | Here it is safe to say (X -> Y; Y -> Z) because this would be -- crushed down into a final value of (X -> Z; Y -> Z) replaceList :: DescendGeniVal a => [(Text, GeniVal)] -> a -> a module NLP.GenI.FeatureStructure type Flist a = [AvPair a] data AvPair a AvPair :: Text -> a -> AvPair a avAtt :: AvPair a -> Text avVal :: AvPair a -> a type FeatStruct a = Map Text a emptyFeatStruct :: FeatStruct a mkFeatStruct :: Flist GeniVal -> FeatStruct GeniVal fromFeatStruct :: FeatStruct a -> Flist a -- | Sort an Flist according with its attributes sortFlist :: Flist a -> Flist a -- | unifyFeat performs feature structure unification, under the -- these assumptions about the input: -- -- -- -- The features are allowed to have different sets of attributes, beacuse -- we use alignFeat to realign them. unifyFeat :: Monad m => Flist GeniVal -> Flist GeniVal -> m (Flist GeniVal, Subst) -- | alignFeat is a pre-procesing step used to ensure that feature -- structures have the same set of keys. If a key is missing in one, we -- copy it to the other with an anonymous value. -- -- The two feature structures must be sorted for this to work alignFeat :: Flist GeniVal -> Flist GeniVal -> [(Text, GeniVal, GeniVal)] alignFeatH :: Flist GeniVal -> Flist GeniVal -> [(Text, GeniVal, GeniVal)] -> [(Text, GeniVal, GeniVal)] crushAvPair :: AvPair [GeniVal] -> Maybe (AvPair GeniVal) crushFlist :: Flist [GeniVal] -> Maybe (Flist GeniVal) instance Typeable1 AvPair instance Ord a => Ord (AvPair a) instance Eq a => Eq (AvPair a) instance Data a => Data (AvPair a) instance NFData a => NFData (AvPair a) instance Binary a => Binary (AvPair a) instance GeniShow (AvPair GeniVal) instance GeniShow (Flist GeniVal) instance Pretty (AvPair GeniVal) instance Pretty (Flist GeniVal) instance Collectable a => Collectable (AvPair a) instance DescendGeniVal v => DescendGeniVal ([String], Flist v) instance DescendGeniVal a => DescendGeniVal (String, a) instance DescendGeniVal v => DescendGeniVal (AvPair v) instance GeniShow (FeatStruct GeniVal) instance Pretty (FeatStruct GeniVal) module NLP.GenI.Semantics data Literal gv Literal :: gv -> gv -> [gv] -> Literal gv lHandle :: Literal gv -> gv lPredicate :: Literal gv -> gv lArgs :: Literal gv -> [gv] type Sem = [Literal GeniVal] type LitConstr = (Literal GeniVal, [Text]) type SemInput = (Sem, Flist GeniVal, [LitConstr]) emptyLiteral :: Literal GeniVal removeConstraints :: SemInput -> SemInput -- | default sorting for a semantics sortSem :: Ord a => [Literal a] -> [Literal a] compareOnLiteral :: Ord a => Literal a -> Literal a -> Ordering sortByAmbiguity :: Sem -> Sem class HasConstants a constants :: HasConstants a => a -> Int literalCount :: [Literal GeniVal] -> Map Text Int boringLiteral :: Literal GeniVal -> Maybe Text isInternalHandle :: Text -> Bool -- | x subsumeSem y returns all the possible ways to unify -- x with some SUBSET of y so that x subsumes -- y. If x does NOT subsume y, we return the -- empty list. subsumeSem :: Sem -> Sem -> [(Sem, Subst)] subsumeSemH :: Sem -> Sem -> [(Sem, Subst)] -- | p1 subsumeLiteral p2... FIXME subsumeLiteral :: Literal GeniVal -> Literal GeniVal -> Maybe (Literal GeniVal, Subst) unifySem :: Sem -> Sem -> [(Sem, Subst)] unifySemH :: Sem -> Sem -> [(Sem, Subst)] unifyLiteral :: Literal GeniVal -> Literal GeniVal -> Maybe (Literal GeniVal, Subst) instance Typeable1 Literal instance Eq gv => Eq (Literal gv) instance Data gv => Data (Literal gv) instance Binary g => Binary (Literal g) instance NFData g => NFData (Literal g) instance GeniShow SemInput instance Pretty SemInput instance GeniShow (Literal GeniVal) instance Pretty (Literal GeniVal) instance GeniShow Sem instance Pretty Sem instance DescendGeniVal a => DescendGeniVal (Literal a) instance HasConstants (Literal GeniVal) instance HasConstants a => HasConstants [a] instance HasConstants GeniVal instance Collectable a => Collectable (Literal a) instance Ord gv => Ord (Literal gv) module NLP.GenI.TestSuite data TestCase TestCase :: Text -> Text -> SemInput -> [Text] -> TestCase tcName :: TestCase -> Text -- | for gui tcSemString :: TestCase -> Text tcSem :: TestCase -> SemInput -- | expected results (for testing) tcExpected :: TestCase -> [Text] instance Pretty TestCase instance GeniShow TestCase module NLP.GenI.Flag data Optimisation PolOpts :: Optimisation AdjOpts :: Optimisation Polarised :: Optimisation NoConstraints :: Optimisation type Instruction = (FilePath, Maybe [Text]) data BuilderType SimpleBuilder :: BuilderType SimpleOnePhaseBuilder :: BuilderType data GrammarType -- | geni's text format GeniHand :: GrammarType -- | built into geni, no parsing needed PreCompiled :: GrammarType -- | lexical selection already done PreAnchored :: GrammarType -- | Flags are GenI's internal representation of command line arguments. We -- use phantom existential types (?) for representing GenI flags. This -- makes it simpler to do things such as ``get the value of the -- MacrosFlg'' whilst preserving type safety (we always know that -- MacrosFlg is associated with String). The alternative would be writing -- getters and setters for each flag, and that gets really boring after a -- while. data Flag Flag :: (x -> f) -> x -> Flag isFlag :: (Typeable f, Typeable x) => (x -> f) -> Flag -> Bool hasFlag :: (Typeable f, Typeable x) => (x -> f) -> [Flag] -> Bool deleteFlag :: (Typeable f, Typeable x) => (x -> f) -> [Flag] -> [Flag] -- | This only has an effect if the flag is set modifyFlag :: (Eq f, Typeable f, Typeable x) => (x -> f) -> (x -> x) -> [Flag] -> [Flag] setFlag :: (Eq f, Typeable f, Typeable x) => (x -> f) -> x -> [Flag] -> [Flag] getFlag :: (Typeable f, Typeable x) => (x -> f) -> [Flag] -> Maybe x getAllFlags :: (Typeable f, Typeable x) => (x -> f) -> [Flag] -> [x] newtype BatchDirFlg BatchDirFlg :: FilePath -> BatchDirFlg newtype DisableGuiFlg DisableGuiFlg :: () -> DisableGuiFlg newtype DetectPolaritiesFlg DetectPolaritiesFlg :: (Set PolarityAttr) -> DetectPolaritiesFlg newtype DumpDerivationFlg DumpDerivationFlg :: () -> DumpDerivationFlg newtype EarlyDeathFlg EarlyDeathFlg :: () -> EarlyDeathFlg newtype FromStdinFlg FromStdinFlg :: () -> FromStdinFlg newtype HelpFlg HelpFlg :: () -> HelpFlg newtype InstructionsFileFlg InstructionsFileFlg :: FilePath -> InstructionsFileFlg newtype LexiconFlg LexiconFlg :: FilePath -> LexiconFlg newtype MacrosFlg MacrosFlg :: FilePath -> MacrosFlg newtype TracesFlg TracesFlg :: FilePath -> TracesFlg newtype MaxStepsFlg MaxStepsFlg :: Integer -> MaxStepsFlg newtype MaxResultsFlg MaxResultsFlg :: Integer -> MaxResultsFlg newtype MetricsFlg MetricsFlg :: [String] -> MetricsFlg newtype MorphCmdFlg MorphCmdFlg :: String -> MorphCmdFlg newtype MorphInfoFlg MorphInfoFlg :: FilePath -> MorphInfoFlg newtype OptimisationsFlg OptimisationsFlg :: [Optimisation] -> OptimisationsFlg newtype OutputFileFlg OutputFileFlg :: String -> OutputFileFlg newtype PartialFlg PartialFlg :: () -> PartialFlg newtype RankingConstraintsFlg RankingConstraintsFlg :: FilePath -> RankingConstraintsFlg newtype RootFeatureFlg RootFeatureFlg :: (Flist GeniVal) -> RootFeatureFlg newtype NoLoadTestSuiteFlg NoLoadTestSuiteFlg :: () -> NoLoadTestSuiteFlg newtype StatsFileFlg StatsFileFlg :: FilePath -> StatsFileFlg newtype TestCaseFlg TestCaseFlg :: Text -> TestCaseFlg newtype TestInstructionsFlg TestInstructionsFlg :: [Instruction] -> TestInstructionsFlg newtype TestSuiteFlg TestSuiteFlg :: FilePath -> TestSuiteFlg newtype TimeoutFlg TimeoutFlg :: Int -> TimeoutFlg newtype VerboseModeFlg VerboseModeFlg :: () -> VerboseModeFlg newtype VersionFlg VersionFlg :: () -> VersionFlg newtype ViewCmdFlg ViewCmdFlg :: String -> ViewCmdFlg newtype BuilderFlg BuilderFlg :: BuilderType -> BuilderFlg newtype GrammarTypeFlg GrammarTypeFlg :: GrammarType -> GrammarTypeFlg newtype WeirdFlg WeirdFlg :: String -> WeirdFlg instance Typeable Optimisation instance Typeable BuilderType instance Typeable GrammarType instance Typeable Flag instance Typeable BatchDirFlg instance Typeable DisableGuiFlg instance Typeable DetectPolaritiesFlg instance Typeable DumpDerivationFlg instance Typeable EarlyDeathFlg instance Typeable FromStdinFlg instance Typeable HelpFlg instance Typeable InstructionsFileFlg instance Typeable LexiconFlg instance Typeable MacrosFlg instance Typeable TracesFlg instance Typeable MaxStepsFlg instance Typeable MaxResultsFlg instance Typeable MetricsFlg instance Typeable MorphCmdFlg instance Typeable MorphInfoFlg instance Typeable OptimisationsFlg instance Typeable OutputFileFlg instance Typeable PartialFlg instance Typeable RankingConstraintsFlg instance Typeable RootFeatureFlg instance Typeable NoLoadTestSuiteFlg instance Typeable StatsFileFlg instance Typeable TestCaseFlg instance Typeable TestInstructionsFlg instance Typeable TestSuiteFlg instance Typeable TimeoutFlg instance Typeable VerboseModeFlg instance Typeable VersionFlg instance Typeable ViewCmdFlg instance Typeable BuilderFlg instance Typeable GrammarTypeFlg instance Typeable WeirdFlg instance Show Optimisation instance Eq Optimisation instance Eq BuilderType instance Show GrammarType instance Eq GrammarType instance Eq BatchDirFlg instance Eq DisableGuiFlg instance Eq DetectPolaritiesFlg instance Eq DumpDerivationFlg instance Eq EarlyDeathFlg instance Eq FromStdinFlg instance Eq HelpFlg instance Eq InstructionsFileFlg instance Eq LexiconFlg instance Eq MacrosFlg instance Eq TracesFlg instance Eq MaxStepsFlg instance Eq MaxResultsFlg instance Eq MetricsFlg instance Eq MorphCmdFlg instance Eq MorphInfoFlg instance Eq OptimisationsFlg instance Eq OutputFileFlg instance Eq PartialFlg instance Eq RankingConstraintsFlg instance Eq RootFeatureFlg instance Eq NoLoadTestSuiteFlg instance Eq StatsFileFlg instance Eq TestCaseFlg instance Eq TestInstructionsFlg instance Eq TestSuiteFlg instance Eq TimeoutFlg instance Eq VerboseModeFlg instance Eq VersionFlg instance Eq ViewCmdFlg instance Eq BuilderFlg instance Eq GrammarTypeFlg instance Eq WeirdFlg instance Eq Flag instance Show BuilderType module NLP.GenI.LexicalSelection.Types -- | Left hand side of a path equation data PathEqLhs PeqInterface :: Text -> PathEqLhs PeqJust :: NodePathEqLhs -> PathEqLhs PeqUnknown :: Text -> PathEqLhs -- | Path equations can either hit a feature or a node's lexeme attribute data NodePathEqLhs PeqFeat :: Text -> TopBottom -> Text -> NodePathEqLhs PeqLex :: Text -> NodePathEqLhs data TopBottom Top :: TopBottom Bottom :: TopBottom type PathEqPair = (NodePathEqLhs, GeniVal) -- | Parse a path equation using the GenI conventions This always succeeds, -- but can return Just warning if anything anomalous comes up -- FIXME : make more efficient parsePathEq :: Text -> Writer [LexCombineError] PathEqLhs showPathEqLhs :: PathEqLhs -> Text data LexCombineError BoringError :: Text -> LexCombineError FamilyNotFoundError :: Text -> LexCombineError SchemaError :: [Text] -> LexCombineError2 -> LexCombineError data LexCombineError2 EnrichError :: PathEqLhs -> LexCombineError2 StringError :: Text -> LexCombineError2 showLexCombineError :: LexCombineError -> (Text, Text) compressLexCombineErrors :: [LexCombineError] -> [LexCombineError] instance Eq TopBottom instance Ord TopBottom instance Eq NodePathEqLhs instance Ord NodePathEqLhs instance Eq PathEqLhs instance Ord PathEqLhs instance Eq LexCombineError2 instance Ord LexCombineError2 instance Eq LexCombineError instance Pretty LexCombineError2 instance Pretty LexCombineError instance Poset Text instance Poset PathEqLhs instance Poset LexCombineError2 instance Poset LexCombineError module NLP.GenI.Lexicon.Internal type Lexicon = [LexEntry] data LexEntry LexEntry :: FullList Text -> Text -> [GeniVal] -> Flist GeniVal -> Flist GeniVal -> Flist GeniVal -> Sem -> [SemPols] -> LexEntry iword :: LexEntry -> FullList Text ifamname :: LexEntry -> Text iparams :: LexEntry -> [GeniVal] iinterface :: LexEntry -> Flist GeniVal ifilters :: LexEntry -> Flist GeniVal iequations :: LexEntry -> Flist GeniVal isemantics :: LexEntry -> Sem isempols :: LexEntry -> [SemPols] -- | See also mkFullLexEntry This version comes with some sensible -- defaults. mkLexEntry :: FullList Text -> Text -> [GeniVal] -> Flist GeniVal -> Flist GeniVal -> Flist GeniVal -> Sem -> LexEntry -- | Variant of mkLexEntry but with more control mkFullLexEntry :: FullList Text -> Text -> [GeniVal] -> Flist GeniVal -> Flist GeniVal -> Flist GeniVal -> Sem -> [SemPols] -> LexEntry -- | An annotated GeniVal. This is for a rather old, obscure variant on the -- polarity filtering optimisation. To account for zero literal -- semantics, we annotate each value in the semantics with a -- positive/negative marker. These markers are then counted up to -- determine with we need to insert more literals into the semantics or -- not. See the manual on polarity filtering for more details type PolValue = (GeniVal, Int) fromLexSem :: [Literal PolValue] -> (Sem, [SemPols]) -- | Note that by convention we ignore the polarity associated with the -- predicate itself fromLexLiteral :: Literal PolValue -> (Literal GeniVal, SemPols) instance Typeable LexEntry instance Eq LexEntry instance Data LexEntry instance NFData LexEntry instance Binary LexEntry instance Pretty LexEntry instance GeniShow [LexEntry] instance GeniShow LexEntry instance Collectable LexEntry instance DescendGeniVal LexEntry module NLP.GenI.Lexicon type Lexicon = [LexEntry] data LexEntry -- | See also mkFullLexEntry This version comes with some sensible -- defaults. mkLexEntry :: FullList Text -> Text -> [GeniVal] -> Flist GeniVal -> Flist GeniVal -> Flist GeniVal -> Sem -> LexEntry -- | Variant of mkLexEntry but with more control mkFullLexEntry :: FullList Text -> Text -> [GeniVal] -> Flist GeniVal -> Flist GeniVal -> Flist GeniVal -> Sem -> [SemPols] -> LexEntry iword :: LexEntry -> FullList Text ifamname :: LexEntry -> Text iparams :: LexEntry -> [GeniVal] iinterface :: LexEntry -> Flist GeniVal ifilters :: LexEntry -> Flist GeniVal iequations :: LexEntry -> Flist GeniVal isemantics :: LexEntry -> Sem isempols :: LexEntry -> [SemPols] -- | An annotated GeniVal. This is for a rather old, obscure variant on the -- polarity filtering optimisation. To account for zero literal -- semantics, we annotate each value in the semantics with a -- positive/negative marker. These markers are then counted up to -- determine with we need to insert more literals into the semantics or -- not. See the manual on polarity filtering for more details type PolValue = (GeniVal, Int) fromLexSem :: [Literal PolValue] -> (Sem, [SemPols]) -- | Note that by convention we ignore the polarity associated with the -- predicate itself fromLexLiteral :: Literal PolValue -> (Literal GeniVal, SemPols) -- | This module provides basic datatypes specific to Tree Adjoining -- Grammar tree schemata. module NLP.GenI.TreeSchema type Macros = [SchemaTree] type SchemaTree = Ttree SchemaNode type SchemaNode = GNode [GeniVal] data Ttree a TT :: [GeniVal] -> Text -> Text -> Flist GeniVal -> Ptype -> Maybe Sem -> [Text] -> Tree a -> Ttree a params :: Ttree a -> [GeniVal] pfamily :: Ttree a -> Text pidname :: Ttree a -> Text pinterface :: Ttree a -> Flist GeniVal ptype :: Ttree a -> Ptype psemantics :: Ttree a -> Maybe Sem ptrace :: Ttree a -> [Text] tree :: Ttree a -> Tree a data Ptype Initial :: Ptype Auxiliar :: Ptype root :: Tree a -> a rootUpd :: Tree a -> a -> Tree a foot :: Tree (GNode a) -> GNode a -- | Given a lexical item l and a tree node n (actually a -- subtree with no children), return the same node with the lexical item -- as its unique child. The idea is that it converts terminal lexeme -- nodes into preterminal nodes where the actual terminal is the given -- lexical item setLexeme :: [Text] -> Tree (GNode a) -> Tree (GNode a) -- | Given a lexical item s and a Tree GNode t, returns the tree -- t' where l has been assigned to the anchor node in t' setAnchor :: FullList Text -> Tree (GNode a) -> Tree (GNode a) -- | Attributes recognised as lexemes, in order of preference lexemeAttributes :: [Text] crushTreeGNode :: Tree (GNode [GeniVal]) -> Maybe (Tree (GNode GeniVal)) -- | A single node of a TAG tree. data GNode gv GN :: NodeName -> Flist gv -> Flist gv -> Bool -> [Text] -> GType -> Bool -> Text -> GNode gv gnname :: GNode gv -> NodeName -- | top feature structure gup :: GNode gv -> Flist gv -- | bottom feature structure gdown :: GNode gv -> Flist gv -- | False for na nodes ganchor :: GNode gv -> Bool -- | [] for na nodes glexeme :: GNode gv -> [Text] gtype :: GNode gv -> GType gaconstr :: GNode gv -> Bool -- | for TAG, this would be the elementary tree that this node originally -- came from gorigin :: GNode gv -> Text gnnameIs :: NodeName -> GNode gv -> Bool type NodeName = Text data GType Subs :: GType Foot :: GType Lex :: GType Other :: GType -- | Return the value of the cat attribute, if available gCategory :: Flist GeniVal -> Maybe GeniVal showLexeme :: [Text] -> Text crushGNode :: GNode [GeniVal] -> Maybe (GNode GeniVal) instance [overlap ok] Typeable Ptype instance [overlap ok] Typeable1 Ttree instance [overlap ok] Typeable GType instance [overlap ok] Typeable1 GNode instance [overlap ok] Show Ptype instance [overlap ok] Eq Ptype instance [overlap ok] Data Ptype instance [overlap ok] Data a => Data (Ttree a) instance [overlap ok] Eq a => Eq (Ttree a) instance [overlap ok] Show GType instance [overlap ok] Eq GType instance [overlap ok] Data GType instance [overlap ok] Eq gv => Eq (GNode gv) instance [overlap ok] Data gv => Data (GNode gv) instance [overlap ok] NFData gv => NFData (GNode gv) instance [overlap ok] NFData Ptype instance [overlap ok] NFData GType instance [overlap ok] Binary a => Binary (Ttree a) instance [overlap ok] Binary GType instance [overlap ok] Binary gv => Binary (GNode gv) instance [overlap ok] Binary Ptype instance [overlap ok] GeniShow (GNode GeniVal) instance [overlap ok] Pretty (GNode GeniVal) instance [overlap ok] GeniShow a => GeniShow (Ttree a) instance [overlap ok] GeniShow Ptype instance [overlap ok] DescendGeniVal v => DescendGeniVal (GNode v) instance [overlap ok] Collectable gv => Collectable (GNode gv) instance [overlap ok] Collectable a => Collectable (Tree a) instance [overlap ok] DescendGeniVal a => DescendGeniVal (Map k a) instance [overlap ok] Collectable a => Collectable (Ttree a) instance [overlap ok] DescendGeniVal v => DescendGeniVal (Ttree v) -- | This module provides basic datatypes specific to Tree Adjoining -- Grammar (TAG) elementary trees and some low-level operations. module NLP.GenI.Tag -- | An anchored grammar. The grammar associates a set of semantic -- predicates to a list of trees each. type Tags = Map String [TagElem] data TagElem TE :: Text -> Text -> Integer -> Ptype -> Tree (GNode GeniVal) -> Sem -> Map PolarityKey (Int, Int) -> Flist GeniVal -> [Text] -> [SemPols] -> TagElem idname :: TagElem -> Text ttreename :: TagElem -> Text tidnum :: TagElem -> Integer ttype :: TagElem -> Ptype ttree :: TagElem -> Tree (GNode GeniVal) tsemantics :: TagElem -> Sem tpolarities :: TagElem -> Map PolarityKey (Int, Int) tinterface :: TagElem -> Flist GeniVal ttrace :: TagElem -> [Text] -- | can be empty tsempols :: TagElem -> [SemPols] -- | TagItem is a generalisation of TagElem. class TagItem t tgIdName :: TagItem t => t -> Text tgIdNum :: TagItem t => t -> Integer tgSemantics :: TagItem t => t -> Sem tgTree :: TagItem t => t -> Tree (GNode GeniVal) data TagSite TagSite :: Text -> Flist GeniVal -> Flist GeniVal -> Text -> TagSite tsName :: TagSite -> Text tsUp :: TagSite -> Flist GeniVal tsDown :: TagSite -> Flist GeniVal tsOrigin :: TagSite -> Text type TagDerivation = [DerivationStep] data DerivationStep SubstitutionStep :: Text -> Text -> Text -> DerivationStep AdjunctionStep :: Text -> Text -> Text -> DerivationStep InitStep :: Text -> DerivationStep dsChild :: DerivationStep -> Text dsParent :: DerivationStep -> Maybe Text dsParentSite :: DerivationStep -> Maybe Text ts_synIncomplete, ts_tbUnificationFailure :: String ts_semIncomplete :: [Literal GeniVal] -> String ts_rootFeatureMismatch :: Flist GeniVal -> String -- | addTags tags key elem adds elem to the the -- list of elements associated to the key addToTags :: Tags -> String -> TagElem -> Tags -- | Normally, extracting the sentences from a TAG tree would just consist -- of reading its leaves. But if you want the generator to return -- inflected forms instead of just lemmas, you also need to return the -- relevant features for each leaf. In TAG, or at least our use of it, -- the features come from the *pre-terminal* nodes, that is, not the -- leaves themselves but their parents. Another bit of trickiness: -- because of atomic disjunction, leaves might have more than one value, -- so we can't just return a String lemma but a list of String, one for -- each possibility. tagLeaves :: TagElem -> [(NodeName, UninflectedDisjunction)] -- | Try in order: lexeme, lexeme attributes, node name getLexeme :: GNode GeniVal -> [Text] toTagSite :: GNode GeniVal -> TagSite -- | Assigns a unique id to each element of this list, that is, an integer -- between 1 and the size of the list. setTidnums :: [TagElem] -> [TagElem] -- | Plug the first tree into the second tree at the specified node. -- Anything below the second node is silently discarded. We assume the -- trees are pluggable; it is treated as a bug if they are not! plugTree :: Tree NodeName -> NodeName -> Tree NodeName -> Tree NodeName -- | Given two trees auxt and t, splice the tree -- auxt into t via the TAG adjunction rule. spliceTree :: NodeName -> Tree NodeName -> NodeName -> Tree NodeName -> Tree NodeName -- | Sorts trees into a Map.Map organised by the first literal of their -- semantics. This is useful in at least three places: the polarity -- optimisation, the gui display code, and code for measuring the -- efficiency of GenI. Note: trees with a null semantics are filed under -- an empty predicate, if any. mapBySem :: TagItem t => [t] -> Map (Literal GeniVal) [t] collect :: Collectable a => a -> Map CollectedVar Int -> Map CollectedVar Int -- | Given a tree(GNode) returns a list of substitution or adjunction -- nodes, as well as remaining nodes with a null adjunction constraint. detectSites :: Tree (GNode GeniVal) -> ([NodeName], [NodeName], [NodeName]) instance Typeable TagSite instance Typeable TagElem instance Eq TagSite instance Ord TagSite instance Data TagSite instance Eq TagElem instance Data TagElem instance Show DerivationStep instance Ord DerivationStep instance Eq DerivationStep instance NFData DerivationStep instance NFData TagElem instance Pretty [TagSite] instance GeniShow [TagElem] instance GeniShow TagElem instance TagItem TagElem instance Idable TagElem instance Collectable TagElem instance DescendGeniVal TagSite instance DescendGeniVal TagElem instance Ord TagElem instance JSON DerivationStep module NLP.GenI.Parser geniTestSuite :: Parser [TestCase] geniSemanticInput :: Parser (Sem, Flist GeniVal, [LitConstr]) -- | Just the String representations of the semantics in the test suite geniTestSuiteString :: Parser [Text] -- | This is only used by the script genimakesuite geniDerivations :: Parser [TestCaseOutput] toSemInputString :: SemInput -> Text -> SemInputString geniMacros :: Parser [SchemaTree] -- | This makes it possible to read anchored trees, which may be useful for -- debugging purposes. -- -- FIXME: note that this is very rudimentary; we do not set id numbers, -- parse polarities. You'll have to call some of our helper functions if -- you want that functionality. geniTagElems :: Parser [TagElem] geniLexicon :: Parser [LexEntry] geniMorphInfo :: Parser [(Text, Flist GeniVal)] geniFeats :: GeniValLike v => Parser (Flist v) geniSemantics :: Parser Sem geniValue :: Parser GeniVal geniWords :: Parser Text geniWord :: Parser Text geniLanguageDef :: LanguageDef () tillEof :: Parser a -> Parser a parseFromFile :: Parser a -> SourceName -> IO (Either ParseError a) instance Eq Annotation instance GeniShow SemInputString instance GeniValLike [GeniVal] instance GeniValLike GeniVal module NLP.GenI.Morphology.Types type MorphInputFn = Literal GeniVal -> Maybe (Flist GeniVal) type MorphRealiser = [LemmaPlusSentence] -> [MorphOutput] data MorphOutput MorphOutput :: [Text] -> [Text] -> MorphOutput moWarnings :: MorphOutput -> [Text] moRealisations :: MorphOutput -> [Text] -- | A lemma plus its morphological features data LemmaPlus LemmaPlus :: Text -> Flist GeniVal -> LemmaPlus lpLemma :: LemmaPlus -> Text lpFeats :: LemmaPlus -> Flist GeniVal -- | A sentence composed of LemmaPlus instead of plain old words type LemmaPlusSentence = [LemmaPlus] parsecToJSON :: Monad m => String -> Parser b -> String -> m b instance Ord MorphOutput instance Eq MorphOutput instance Eq LemmaPlus instance Ord LemmaPlus instance NFData LemmaPlus instance NFData MorphOutput instance JSON LemmaPlus instance JSON MorphOutput -- | This module handles mostly everything to do with morphology in Geni. -- There are two basic tasks: morphological input and output. GenI farms -- out morphology to whatever third party program you specify on the -- command line. Note that a simple and stupid `sillymorph' -- realiser is provided either in the GenI repository or on hackage. module NLP.GenI.Morphology -- | Converts information from a morphological information file into GenI's -- internal format. readMorph :: [(Text, [AvPair GeniVal])] -> MorphInputFn -- | Filters away from an input semantics any literals whose realisation is -- strictly morphological. The first argument tells us helps identify the -- morphological literals -- it associates literals with morphological -- stuff; if it returns Nothing, then it is non-morphological stripMorphSem :: MorphInputFn -> Sem -> Sem -- | attachMorph morphfn sem cands does the bulk of the -- morphological input processing. We use morphfn to determine -- which literals in sem contain morphological information and -- what information they contain. Then we attach this morphological -- information to the relevant trees in cand. A tree is -- considered relevant w.r.t to a morphological literal if its semantics -- contains at least one literal whose first index is the same as the -- first index of the morphological literal. attachMorph :: MorphInputFn -> Sem -> [TagElem] -> [TagElem] setMorphAnchor :: GNode GeniVal -> Tree (GNode GeniVal) -> Tree (GNode GeniVal) -- | Converts a list of uninflected sentences into inflected ones by -- calling inflectSentencesUsingCmd :: String -> [LemmaPlusSentence] -> IO [(LemmaPlusSentence, MorphOutput)] -- | Extracts the lemmas from a list of uninflected sentences. This is used -- when the morphological generator is unavailable, doesn't work, etc. sansMorph :: LemmaPlusSentence -> MorphOutput instance Typeable MNAME module NLP.GenI.Warning.Internal -- | This exists because we want the Monoid instance, providing a -- GenI-specific notion of appending which merges instances of the same -- error newtype GeniWarnings GeniWarnings :: [GeniWarning] -> GeniWarnings fromGeniWarnings :: GeniWarnings -> [GeniWarning] mkGeniWarnings :: [GeniWarning] -> GeniWarnings data GeniWarning -- | A warning that should be repeated for each lexical entry affected LexWarning :: [LexEntry] -> LexWarning -> GeniWarning -- | A single custom warning CustomLexWarning :: Text -> GeniWarning -- | Literals which did not receive any lexical selection NoLexSelection :: [Literal GeniVal] -> GeniWarning -- | Warnings from the morphological realiser MorphWarning :: [Text] -> GeniWarning data LexWarning LexCombineAllSchemataFailed :: LexWarning LexCombineOneSchemaFailed :: LexCombineError -> LexWarning MissingCoanchors :: Text -> Int -> LexWarning -- | Sort, treating non-comporable items as equal posort :: Poset a => [a] -> [a] sortWarnings :: GeniWarnings -> GeniWarnings appendWarning :: GeniWarning -> [GeniWarning] -> [GeniWarning] mergeWarning :: GeniWarning -> GeniWarning -> Maybe GeniWarning -- | A warning may be displayed over several lines showGeniWarning :: GeniWarning -> [Text] type WordFamilyCount = Map (FullList Text, Text) Int toWfCount :: [LexEntry] -> WordFamilyCount instance Eq LexWarning instance Eq GeniWarning instance Poset LexWarning instance Poset GeniWarning instance Monoid GeniWarnings -- | Typed warnings as an easier alternative to strings. -- -- This makes it easier to recognise repeated warnings and print them out -- in a reasonable way module NLP.GenI.Warning -- | This exists because we want the Monoid instance, providing a -- GenI-specific notion of appending which merges instances of the same -- error data GeniWarnings fromGeniWarnings :: GeniWarnings -> [GeniWarning] mkGeniWarnings :: [GeniWarning] -> GeniWarnings sortWarnings :: GeniWarnings -> GeniWarnings data GeniWarning -- | A warning that should be repeated for each lexical entry affected LexWarning :: [LexEntry] -> LexWarning -> GeniWarning -- | A single custom warning CustomLexWarning :: Text -> GeniWarning -- | Literals which did not receive any lexical selection NoLexSelection :: [Literal GeniVal] -> GeniWarning -- | Warnings from the morphological realiser MorphWarning :: [Text] -> GeniWarning data LexWarning LexCombineAllSchemataFailed :: LexWarning LexCombineOneSchemaFailed :: LexCombineError -> LexWarning MissingCoanchors :: Text -> Int -> LexWarning -- | A warning may be displayed over several lines showGeniWarning :: GeniWarning -> [Text] -- | This module performs the core of lexical selection and anchoring. module NLP.GenI.LexicalSelection -- | See Configuration if you want to use GenI with a custom lexical -- selection function. type LexicalSelector = Macros -> Lexicon -> Sem -> IO LexicalSelection -- | The result of the lexical selection process data LexicalSelection LexicalSelection :: [TagElem] -> [LexEntry] -> GeniWarnings -> LexicalSelection -- | the main result: a set of elementary trees (ie. anchored trees) lsAnchored :: LexicalSelection -> [TagElem] -- | if available, lexical entries that were used to produce anchored trees -- (useful for identifying anchoring failure) lsLexEntries :: LexicalSelection -> [LexEntry] -- | HINT: use mempty to initialise to empty lsWarnings :: LexicalSelection -> GeniWarnings -- | Performs standard GenI lexical selection as described in -- http://projects.haskell.org/GenI/manual/lexical-selection.html -- -- This is just defaultLexicalSelection lifted into IO defaultLexicalSelector :: Macros -> Lexicon -> Sem -> IO LexicalSelection -- | Helper for defaultLexicalSelector (Standard GenI lexical -- selection is actually pure) -- -- This is just defaultLexicalChoice and defaultAnchoring defaultLexicalSelection :: Macros -> Lexicon -> Sem -> LexicalSelection -- | missingLexEntries ts lexs returns any of the lexical -- candidates lexs that were apparently not anchored -- succesfully. -- -- TODO: it does this by (wrongly) checking for each lexical item to see -- if any of the anchored trees in ts have identical semantics -- to that lexical item. The better way to do this would be to throw a -- subsumption check on top of items reported missing, because it's -- possible for the trees to add semantics through unification. missingLexEntries :: [TagElem] -> [LexEntry] -> [LexEntry] -- | Select and returns the set of entries from the lexicon whose semantics -- subsumes the input semantics. defaultLexicalChoice :: Lexicon -> Sem -> [LexEntry] -- | chooseCandI sem l attempts to unify the semantics of -- l with sem If this succeeds, we use return the -- result(s); if it fails, we reject l as a lexical selection -- candidate. chooseCandI :: Sem -> [LexEntry] -> [LexEntry] -- | mergeSynonyms is a factorisation technique that uses atomic -- disjunction to merge all synonyms into a single lexical entry. Two -- lexical entries are considered synonyms if their semantics match and -- they point to the same tree families. -- -- FIXME: 2006-10-11 - note that this is no longer being used, because it -- breaks the case where two lexical entries differ only by their use of -- path equations. Perhaps it's worthwhile just to add a check that the -- path equations match exactly. mergeSynonyms :: [LexEntry] -> [LexEntry] -- | The LexCombine monad supports warnings during lexical selection -- and also failure via Maybe type LexCombine a = MaybeT (Writer [LexCombineError]) a -- | Note an anchoring error lexTell :: LexCombineError -> LexCombine () -- | defaultAnchoring schemata lex sem implements the later half -- of lexical selection (tree anchoring and enrichement). It assumes that -- lex consists just of the lexical items that have been -- selected, and tries to combine them with the tree schemata. -- -- This function may be useful if you are implementing your own lexical -- selection functions, and you want GenI to take over after you've given -- it a [LexEntry] defaultAnchoring :: Macros -> [LexEntry] -> Sem -> LexicalSelection -- | Given a lexical item, looks up the tree families for that item, and -- anchor the item to the trees. combineList :: Sem -> Macros -> LexEntry -> ([LexCombineError], [TagElem]) -- | Combine a single tree with its lexical item to form a bonafide -- TagElem. This process can fail, however, because of filtering or -- enrichement combineOne :: Sem -> LexEntry -> SchemaTree -> LexCombine [TagElem] -- | See http://projects.haskell.org/manual/lexical-selection on -- enrichement enrich :: LexEntry -> SchemaTree -> LexCombine SchemaTree -- | Helper for enrich (enrich by single path equation) enrichBy :: SchemaTree -> PathEqPair -> LexCombine SchemaTree -- | Helper for enrichBy maybeEnrichBy :: SchemaTree -> PathEqPair -> Maybe (SchemaTree, Subst) -- | enrichFeat av fs attempts to unify av with -- fs -- -- Note here that fs is an Flist [GeniVal] rather than -- the usual Flist GeniVal you may expect. This is because it -- comes from SchemaTree which allows non-atomic disjunctions of -- GeniVal which have to be flatten down to at most atomic -- disjunctions once lexical selection is complete. enrichFeat :: AvPair GeniVal -> Flist [GeniVal] -> Maybe (Flist [GeniVal], Subst) -- | missingCoanchors l t returns the list of coanchor node names -- from l that were not found in t missingCoanchors :: LexEntry -> SchemaTree -> [Text] -- | Split a lex entry's path equations into interface enrichement -- equations or (co-)anchor modifiers lexEquations :: LexEntry -> Writer [LexCombineError] ([AvPair GeniVal], [PathEqPair]) -- | seekCoanchor lhs t returns Just node if t -- contains exactly one node that can be identified by lhs, -- Nothing if it contains none. -- -- It crashes if there is more than one such node, because this should -- have been caught earlier by GenI. seekCoanchor :: NodePathEqLhs -> SchemaTree -> Maybe SchemaNode -- | matchNodeName lhs n is True if the lhs -- refers to the node n matchNodeName :: NodePathEqLhs -> SchemaNode -> Bool -- | matchNodeNameHelper recognises “anchor“ by convention; -- otherwise, it does a name match matchNodeNameHelper :: Text -> SchemaNode -> Bool -- | The lemanchor mechanism is described in -- http://projects.haskell.org/manual/lexical-selection setLemAnchors :: Tree (GNode GeniVal) -> Tree (GNode GeniVal) -- | The name of the lemanchor attribute (by convention; see source) _lemanchor :: Text -- | setOrigin n t marks the nodes in t as having come -- from a tree named n setOrigin :: Text -> Tree (GNode v) -> Tree (GNode v) module NLP.GenI.Configuration -- | Holds the specification for how Geni should be run, its input files, -- etc. This is the stuff that would normally be found in the -- configuration file. data Params Params :: GrammarType -> BuilderType -> Maybe MorphRealiser -> Maybe LexicalSelector -> [Flag] -> Params grammarType :: Params -> GrammarType builderType :: Params -> BuilderType -- | Can still be overridden with a morph command mind you customMorph :: Params -> Maybe MorphRealiser -- | Lexical selection function (if you set this you may want to add -- PreAnchored to the config) customSelector :: Params -> Maybe LexicalSelector geniFlags :: Params -> [Flag] mainBuilderTypes :: [BuilderType] getFlagP :: (Typeable f, Typeable x) => (x -> f) -> Params -> Maybe x getListFlagP :: (Typeable f, Typeable x) => ([x] -> f) -> Params -> [x] modifyFlagP :: (Eq f, Typeable f, Typeable x) => (x -> f) -> (x -> x) -> Params -> Params setFlagP :: (Eq f, Typeable f, Typeable x) => (x -> f) -> x -> Params -> Params hasFlagP :: (Typeable f, Typeable x) => (x -> f) -> Params -> Bool deleteFlagP :: (Typeable f, Typeable x) => (x -> f) -> Params -> Params hasOpt :: Optimisation -> Params -> Bool -- | The default parameters configuration emptyParams :: Params defineParams :: [Flag] -> Params -> Params treatArgs :: [OptDescr Flag] -> [String] -> IO Params treatArgsWithParams :: [OptDescr Flag] -> [String] -> Params -> IO Params -- | Print out a GenI-style usage message with options divided into -- sections usage :: [OptSection] -> String -> String basicSections :: [OptSection] optionsSections :: [OptSection] -- | Update the internal instructions list, test suite and case according -- to the contents of an instructions file. -- -- Basic approach -- -- processInstructions :: Params -> IO Params -- | Uses the GetOpt library to process the command line arguments. Note -- that we divide them into basic and advanced usage. optionsForStandardGenI :: [OptDescr Flag] optionsForBasicStuff :: [OptDescr Flag] optionsForOptimisation :: [OptDescr Flag] optionsForMorphology :: [OptDescr Flag] optionsForInputFiles :: [OptDescr Flag] optionsForBuilder :: [OptDescr Flag] optionsForTesting :: [OptDescr Flag] helpOption :: OptDescr Flag verboseOption :: OptDescr Flag lexiconOption, macrosOption :: OptDescr Flag nubBySwitches :: [OptDescr a] -> [OptDescr a] noArg :: (Eq f, Typeable f) => (() -> f) -> ArgDescr Flag reqArg :: (Eq f, Typeable f, Eq x, Typeable x) => (x -> f) -> (String -> x) -> String -> ArgDescr Flag optArg :: (Eq f, Typeable f, Eq x, Typeable x) => (x -> f) -> x -> (String -> x) -> String -> ArgDescr Flag -- | TODO: This is a horrible and abusive use of error parseFlagWithParsec :: String -> CharParser () b -> String -> b readGlobalConfig :: IO (Maybe YamlLight) setLoggers :: YamlLight -> IO () -- | The class Typeable allows a concrete representation of a type -- to be calculated. class Typeable a instance Show LogTo instance Show LogFmt instance Show LoggerConfig instance IsString YamlLight instance Read LogFmt instance Read LogTo module NLP.GenI.Polarity.Internal data PolarityDetectionResult PD_UserError :: String -> PolarityDetectionResult PD_Nothing :: PolarityDetectionResult PD_Just :: [(PolarityKey, Interval)] -> PolarityDetectionResult PD_Unconstrained :: (Text, Interval) -> PolarityDetectionResult -- | Given a description of what the root feature should unify with return -- a -1 polarity for all relevant polarity keys. This allows us to -- compensate for the root node of any derived tree. detectRootCompensation :: Set PolarityAttr -> FeatStruct GeniVal -> PolMap detectPolsH :: Set PolarityAttr -> TagElem -> [(PolarityKey, Interval)] detectPolarity :: Int -> PolarityAttr -> FeatStruct GeniVal -> FeatStruct GeniVal -> PolarityDetectionResult toZero :: Int -> Interval substNodes :: TagElem -> [GNode GeniVal] substTops :: TagElem -> [Flist GeniVal] type SemMap = Map (Literal GeniVal) [TagElem] type PolMap = Map PolarityKey Interval polarityKeys :: [TagElem] -> PolMap -> [PolarityKey] -- | Convert any unconstrained polarities in a PolMap to constrained -- ones, assuming a global list of known constrained keys. convertUnconstrainedPolarities :: [PolarityKey] -> PolMap -> PolMap addPols :: [(PolarityKey, Interval)] -> PolMap -> PolMap -- | Ensures that all states and transitions in the polarity automaton are -- unique. This is a slight optimisation so that we don't have to -- repeatedly check the automaton for state uniqueness during its -- construction, but it is essential that this check be done after -- construction nubAut :: (Ord ab, Ord st) => NFA st ab -> NFA st ab __cat__, __idx__ :: Text -- | Note that this will crash if any of the entries are errors pdResults :: [PolarityDetectionResult] -> [(PolarityKey, Interval)] -- | Note that this will crash if any of the entries are errors pdToList :: (String -> String) -> PolarityDetectionResult -> [(PolarityKey, Interval)] module NLP.GenI.Polarity type PolAut = NFA PolState PolTrans data PolState -- | position in the input semantics, extra semantics, polarity interval PolSt :: Int -> [Literal GeniVal] -> [(Int, Int)] -> PolState type AutDebug = (PolarityKey, PolAut, PolAut) -- | intermediate auts, seed aut, final aut, potentially modified sem data PolResult PolResult :: [AutDebug] -> PolAut -> PolAut -> Sem -> PolResult prIntermediate :: PolResult -> [AutDebug] prInitial :: PolResult -> PolAut prFinal :: PolResult -> PolAut prSem :: PolResult -> Sem -- | Constructs a polarity automaton. For debugging purposes, it returns -- all the intermediate automata produced by the construction algorithm. buildAutomaton :: Set PolarityAttr -> FeatStruct GeniVal -> PolMap -> SemInput -> [TagElem] -> PolResult makePolAut :: [TagElem] -> Sem -> PolMap -> [PolarityKey] -> PolResult -- | Returns a modified input semantics and lexical selection in which -- pronouns are properly accounted for. fixPronouns :: (Sem, [TagElem]) -> (Sem, [TagElem]) detectSansIdx :: [TagElem] -> [TagElem] suggestPolFeatures :: [TagElem] -> [Text] detectPols :: Set PolarityAttr -> TagElem -> TagElem -- | Given a list of paths (i.e. a list of list of trees) return a list of -- trees such that each tree is annotated with the paths it belongs to. detectPolPaths :: [[TagElem]] -> [(TagElem, BitVector)] declareIdxConstraints :: Flist GeniVal -> PolMap detectIdxConstraints :: Flist GeniVal -> Flist GeniVal -> PolMap -- | Render the list of polarity automaton paths as a string prettyPolPaths :: BitVector -> Text prettyPolPaths' :: BitVector -> Int -> [Int] -- | Returns all possible paths through an automaton from the start state -- to any dead-end. -- -- Each path is represented as a list of labels. -- -- We assume that the automaton does not have any loops in it. automatonPaths :: (Ord st, Ord ab) => (NFA st ab) -> [[ab]] -- | finalSt returns all the final states of an automaton finalSt :: NFA st ab -> [st] -- | Note: you can define the final state either by setting -- isFinalSt to Just f where f is some function -- or by putting them in finalStList data NFA st ab instance Eq PolState instance Ord PolState instance Show PolState -- | The heavy lifting of GenI, the whole chart/agenda mechanism, can be -- implemented in many ways. To make it easier to write different -- algorithms for GenI and compare them, we provide a single interface -- for what we call Builders. -- -- This interface is then used called by the Geni module and by the -- graphical interface. Note that each builder has its own graphical -- interface and that we do a similar thing in the graphical interface -- code to make it possible to use these GUIs. module NLP.GenI.Builder type TagDerivation = [DerivationStep] data Builder st it pa Builder :: (Input -> pa -> (st, Statistics)) -> BuilderState st () -> BuilderState st () -> (st -> GenStatus) -> (st -> [Output]) -> (st -> [Output]) -> Builder st it pa -- | initialise the machine from the semantics and lexical selection init :: Builder st it pa -> Input -> pa -> (st, Statistics) -- | run a realisation step step :: Builder st it pa -> BuilderState st () -- | run all realisations steps until completion stepAll :: Builder st it pa -> BuilderState st () -- | determine if realisation is finished finished :: Builder st it pa -> st -> GenStatus -- | unpack chart results into a list of sentences unpack :: Builder st it pa -> st -> [Output] partial :: Builder st it pa -> st -> [Output] data GenStatus Finished :: GenStatus Active :: GenStatus Error :: Text -> GenStatus -- | The names of lexically selected chart items used in a derivation lexicalSelection :: TagDerivation -> [Text] data FilterStatus a Filtered :: FilterStatus a NotFiltered :: a -> FilterStatus a incrCounter :: String -> Int -> BuilderState st () num_iterations, num_comparisons, chart_size :: String -- | Sequence two dispatch filters. (>-->) :: Monad s => DispatchFilter s a -> DispatchFilter s a -> DispatchFilter s a type SemBitMap = Map (Literal GeniVal) BitVector -- | assign a bit vector value to each literal in the semantics the -- resulting map can then be used to construct a bit vector -- representation of the semantics defineSemanticBits :: Sem -> SemBitMap semToBitVector :: SemBitMap -> Sem -> BitVector bitVectorToSem :: SemBitMap -> BitVector -> Sem -- | Dispatching consists of assigning a chart item to the right part of -- the chart (agenda, trash, results list, etc). This is implemented as a -- series of filters which can either fail or succeed. If a filter fails, -- it may modify the item before passing it on to future filters. type DispatchFilter s a = a -> s (FilterStatus a) -- | If the item meets some condition, use the first filter, otherwise use -- the second one. condFilter :: Monad s => (a -> Bool) -> DispatchFilter s a -> DispatchFilter s a -> DispatchFilter s a -- | Default implementation for the stepAll function in -- Builder defaultStepAll :: Builder st it pa -> BuilderState st () type BuilderState s a = StateT s (State Statistics) a data UninflectedDisjunction UninflectedDisjunction :: [Text] -> (Flist GeniVal) -> UninflectedDisjunction -- | To simplify interaction with the backend, we provide a single data -- structure which represents all the inputs a backend could take. data Input Input :: SemInput -> [LexEntry] -> [(TagElem, BitVector)] -> Input inSemInput :: Input -> SemInput -- | for the debugger inLex :: Input -> [LexEntry] -- | tag tree inCands :: Input -> [(TagElem, BitVector)] -- | Equivalent to id unless the input contains an empty or -- uninstatiated semantics unlessEmptySem :: Input -> Params -> a -> a initStats :: Params -> Statistics type Output = (Integer, LemmaPlusSentence, TagDerivation) -- | A SentenceAut represents a set of sentences in the form of an -- automaton. The labels of the automaton are the words of the sentence. -- But note! “word“ in the sentence is in fact a tuple (lemma, -- inflectional feature structures). Normally, the states are defined as -- integers, with the only requirement being that each one, naturally -- enough, is unique. type SentenceAut = NFA Int LemmaPlus -- | Performs surface realisation from an input semantics and a lexical -- selection. -- -- Statistics tracked -- -- run :: Builder st it Params -> Input -> Params -> (st, Statistics) queryCounter :: String -> Statistics -> Maybe Int defaultMetricNames :: [String] preInit :: Input -> Params -> (Input, PolResult) instance Typeable UninflectedDisjunction instance Data UninflectedDisjunction instance NFData Input instance Collectable UninflectedDisjunction instance DescendGeniVal UninflectedDisjunction module NLP.GenI.Simple.SimpleBuilder type Agenda = [SimpleItem] type AuxAgenda = [SimpleItem] type Chart = [SimpleItem] data SimpleStatus type SimpleState a = BuilderState SimpleStatus a data SimpleItem SimpleItem :: ChartId -> [NodeName] -> [NodeName] -> BitVector -> BitVector -> [GNode GeniVal] -> Tree Text -> NodeName -> Maybe NodeName -> [NodeName] -> TagDerivation -> SimpleGuiItem -> SimpleItem siId :: SimpleItem -> ChartId siSubstnodes :: SimpleItem -> [NodeName] siAdjnodes :: SimpleItem -> [NodeName] siSemantics :: SimpleItem -> BitVector siPolpaths :: SimpleItem -> BitVector -- | actually a set siNodes :: SimpleItem -> [GNode GeniVal] siDerived :: SimpleItem -> Tree Text siRoot_ :: SimpleItem -> NodeName siFoot_ :: SimpleItem -> Maybe NodeName siPendingTb :: SimpleItem -> [NodeName] siDerivation :: SimpleItem -> TagDerivation siGuiStuff :: SimpleItem -> SimpleGuiItem simpleBuilder_2p, simpleBuilder_1p :: SimpleBuilder simpleBuilder :: Bool -> SimpleBuilder theAgenda :: SimpleStatus -> Agenda theHoldingPen :: SimpleStatus -> AuxAgenda theChart :: SimpleStatus -> Chart theResults :: SimpleStatus -> [SimpleItem] -- | Creates an initial SimpleStatus. initSimpleBuilder :: Bool -> Input -> Params -> (SimpleStatus, Statistics) addToAgenda :: SimpleItem -> SimpleState () addToChart :: SimpleItem -> SimpleState () genconfig :: SimpleStatus -> Params -- | Things whose only use is within the graphical debugger data SimpleGuiItem SimpleGuiItem :: [Text] -> [String] -> Sem -> Text -> SimpleGuiItem -- | nodes to highlight if there are things wrong with this item, what? siHighlight :: SimpleGuiItem -> [Text] siDiagnostic :: SimpleGuiItem -> [String] siFullSem :: SimpleGuiItem -> Sem siIdname :: SimpleGuiItem -> Text theTrash :: SimpleStatus -> Trash step :: SimpleStatus -> GenerationPhase unpackResult :: SimpleItem -> [Output] testCanAdjoin :: SimpleItem -> TagSite -> Maybe (TagSite, TagSite, Subst) testIapplyAdjNode :: Bool -> SimpleItem -> SimpleItem -> Maybe SimpleItem testEmptySimpleGuiItem :: SimpleGuiItem instance Typeable SimpleGuiItem instance Show GenerationPhase instance Data SimpleGuiItem instance DescendGeniVal SimpleItem instance DescendGeniVal (Text, UninflectedDisjunction) module NLP.GenI.OptimalityTheory data OtConstraint -- | the trace must appear PositiveC :: Text -> OtConstraint -- | the trace must NOT appear NegativeC :: Text -> OtConstraint -- | these traces must not appear AT THE SAME TIME NegativeConjC :: [Text] -> OtConstraint type OtRanking = [[OtConstraint]] type GetTraces = Text -> [Text] type OtResult x = (Int, x, [OtViolation]) data OtViolation data RankedOtConstraint RankedOtConstraint :: Int -> OtConstraint -> RankedOtConstraint rankResults :: GetTraces -> (a -> TagDerivation) -> OtRanking -> [a] -> [OtResult a] otWarnings :: Macros -> OtRanking -> [OtViolation] -> [Text] prettyViolations :: GetTraces -> Bool -> [OtViolation] -> Text prettyRank :: Int -> Text instance Show OtConstraint instance Eq OtConstraint instance Show RankedOtConstraint instance Eq RankedOtConstraint instance Eq RankedOtConstraint2 instance Show OtViolation instance Eq OtViolation instance Ord OtViolation instance Ord LexItem instance Eq LexItem instance Show LexItem instance NFData OtConstraint instance NFData RankedOtConstraint instance NFData OtViolation instance Pretty OtConstraint instance Pretty RankedOtConstraint instance JSON OtViolation instance JSON RankedOtConstraint instance JSON OtConstraint instance Ord RankedOtConstraint2 instance Ord RankedOtConstraint -- | This is the interface between the front and backends of the generator. -- The GUI and the console interface both talk to this module, and in -- turn, this module talks to the input file parsers and the surface -- realisation engine. module NLP.GenI -- | The program state consists of its configuration options and abstract, -- cleaned up representations of all the data it's had to load into -- memory (tree schemata files, lexicon files, etc). The intention is for -- the state to stay static until the next time something triggers some -- file loading. data ProgState ProgState :: Params -> Macros -> Lexicon -> MorphInputFn -> OtRanking -> [Text] -> ProgState -- | the current configuration pa :: ProgState -> Params -- | tree schemata gr :: ProgState -> Macros -- | lexical entries le :: ProgState -> Lexicon -- | function to extract morphological information from the semantics (you -- may instead be looking for customMorph) morphinf :: ProgState -> MorphInputFn -- | OT constraints (optional) ranking :: ProgState -> OtRanking -- | simplified traces (optional) traces :: ProgState -> [Text] type ProgStateRef = IORef ProgState -- | The program state when you start GenI for the very first time emptyProgState :: Params -> ProgState -- | See Configuration if you want to use GenI with a custom lexical -- selection function. type LexicalSelector = Macros -> Lexicon -> Sem -> IO LexicalSelection -- | Entry point! (the most useful function to know here) -- -- -- -- In addition to the results, this returns a generator state. The latter -- is is mostly useful for debugging via the graphical interface. Note -- that we assumes that you have already loaded in your grammar and -- parsed your input semantics. runGeni :: ProgStateRef -> SemInput -> Builder st it Params -> IO (GeniResults, st) -- | GeniResults is the outcome of running GenI on a single input -- semantics. Each distinct result is returned as a single -- GeniResult (NB: a single result may expand into multiple -- strings through morphological post-processing), data GeniResults GeniResults :: [GeniResult] -> [Text] -> Statistics -> GeniResults -- | one per chart item grResults :: GeniResults -> [GeniResult] -- | usually from lexical selection grGlobalWarnings :: GeniResults -> [Text] -- | things like number of chart items to help study efficiency grStatistics :: GeniResults -> Statistics data GeniResult GError :: GeniError -> GeniResult GSuccess :: GeniSuccess -> GeniResult isSuccess :: GeniResult -> Bool data GeniError GeniError :: [Text] -> GeniError data GeniSuccess GeniSuccess :: LemmaPlusSentence -> [Text] -> ResultType -> [Text] -> TagDerivation -> Integer -> [GeniLexSel] -> Int -> [OtViolation] -> GeniSuccess -- | “original” uninflected result grLemmaSentence :: GeniSuccess -> LemmaPlusSentence -- | results after morphology grRealisations :: GeniSuccess -> [Text] grResultType :: GeniSuccess -> ResultType -- | warnings “local” to this particular item, cf. grGlobalWarnings grWarnings :: GeniSuccess -> [Text] -- | derivation tree behind the result grDerivation :: GeniSuccess -> TagDerivation -- | normally a chart item id grOrigin :: GeniSuccess -> Integer -- | the lexical selection behind this result (info only) grLexSelection :: GeniSuccess -> [GeniLexSel] -- | see OptimalityTheory grRanking :: GeniSuccess -> Int -- | which OT constraints were violated grViolations :: GeniSuccess -> [OtViolation] data GeniLexSel GeniLexSel :: Text -> [Text] -> GeniLexSel nlTree :: GeniLexSel -> Text nlTrace :: GeniLexSel -> [Text] data ResultType CompleteResult :: ResultType PartialResult :: ResultType -- | initGeni performs lexical selection and strips the input -- semantics of any morpohological literals initGeni :: ProgStateRef -> SemInput -> IO (Input, GeniWarnings) -- | This is a helper to runGenI. It's mainly useful if you are -- building interactive GenI debugging tools. -- -- Given a builder state, -- -- extractResults :: ProgStateRef -> Builder st it Params -> st -> IO [GeniResult] -- | No morphology! Pretend the lemma string is a sentence lemmaSentenceString :: GeniSuccess -> Text prettyResult :: ProgState -> GeniSuccess -> Text -- | Show the sentences produced by the generator, in a relatively compact -- form showRealisations :: [String] -> String histogram :: Ord a => [a] -> Map a Int -- | getTraces is most likely useful for grammars produced by a -- metagrammar system. Given a tree name, we retrieve the -- `trace' information from the grammar for all trees that have -- this name. We assume the tree name was constructed by GenI; see the -- source code for details. getTraces :: ProgState -> Text -> [Text] -- | We have one master function that loads all the files GenI is expected -- to use. This just calls the sub-loaders below, some of which are -- exported for use by the graphical interface. The master function also -- makes sure to complain intelligently if some of the required files are -- missing. loadEverything :: ProgStateRef -> IO () -- | The file loading functions all work the same way: we load the file, -- and try to parse it. If this doesn't work, we just fail in IO, and -- GenI dies. If we succeed, we update the program state passed in as an -- IORef. class Loadable x lParse :: Loadable x => FilePath -> String -> Either ParseError x lSet :: Loadable x => x -> ProgState -> ProgState lSummarise :: Loadable x => x -> String loadLexicon :: ProgStateRef -> IO Lexicon -- | The macros are stored as a hashing function in the monad. loadGeniMacros :: ProgStateRef -> IO Macros loadTestSuite :: ProgStateRef -> IO [TestCase] parseSemInput :: String -> Either ParseError SemInput loadRanking :: ProgStateRef -> IO () data BadInputException BadInputException :: String -> ParseError -> BadInputException -- | Load something from a string rather than a file loadFromString :: Loadable a => ProgStateRef -> String -> String -> IO a instance Typeable BadInputException instance Show BadInputException instance Ord GeniError instance Eq GeniError instance Ord GeniLexSel instance Eq GeniLexSel instance Ord ResultType instance Eq ResultType instance Ord GeniSuccess instance Eq GeniSuccess instance Ord GeniResult instance Eq GeniResult instance NFData GeniLexSel instance NFData ResultType instance NFData GeniError instance NFData GeniSuccess instance NFData GeniResult instance JSON GeniLexSel instance JSON ResultType instance JSON GeniError instance JSON GeniSuccess instance JSON GeniResult instance Loadable PreAnchoredL instance Pretty GeniError instance Loadable TestSuiteL instance Loadable OtRanking instance Loadable TracesL instance Loadable MorphFnL instance Loadable Macros instance Loadable Lexicon instance Exception BadInputException -- | The console user interface including batch processing on entire test -- suites. module NLP.GenI.Console consoleGeni :: ProgStateRef -> IO () -- | Used in processing instructions files. Each instruction consists of a -- suite file and a list of test case names from that file -- -- See http://projects.haskell.org/GenI/manual/command-line.html -- for how testsuite, testcase, and instructions are expected to interact -- -- (Exported for use by regression testing code) loadNextSuite :: ProgStateRef -> (FilePath, Maybe [Text]) -> IO [TestCase] instance Typeable MNAME module NLP.GenI.Main main :: IO () mainWithState :: ProgState -> IO () forceGuiFlag :: Params -> Params module BoolExp data BoolExp a Cond :: a -> BoolExp a And :: (BoolExp a) -> (BoolExp a) -> BoolExp a Or :: (BoolExp a) -> (BoolExp a) -> BoolExp a Not :: (BoolExp a) -> BoolExp a check :: (a -> Bool) -> BoolExp a -> Bool