{-# LANGUAGE FlexibleInstances, UndecidableInstances, CPP #-}
module GF.Command.Commands (
  PGFEnv,HasPGFEnv(..),pgf,mos,pgfEnv,pgfCommands,
  options,flags,
  ) where
import Prelude hiding (putStrLn,(<>)) -- GHC 8.4.1 clash with Text.PrettyPrint

import PGF

import PGF.Internal(lookStartCat,functionsToCat,lookValCat,restrictPGF,hasLin)
import PGF.Internal(abstract,funs,cats,Expr(EFun)) ----
import PGF.Internal(ppFun,ppCat)
import PGF.Internal(optimizePGF)

import GF.Compile.Export
import GF.Compile.ToAPI
import GF.Compile.ExampleBased
import GF.Infra.Option (noOptions, readOutputFormat, outputFormatsExpl)
import GF.Infra.UseIO(writeUTF8File)
import GF.Infra.SIO
import GF.Command.Abstract
import GF.Command.CommandInfo
import GF.Command.CommonCommands
import GF.Text.Clitics
import GF.Quiz

import GF.Command.TreeOperations ---- temporary place for typecheck and compute

import GF.Data.Operations

import PGF.Internal (encodeFile)
import Data.List(intersperse,nub)
import Data.Maybe
import qualified Data.Map as Map
import GF.Text.Pretty
import Data.List (sort)
import qualified Control.Monad.Fail as Fail
--import Debug.Trace


data PGFEnv = Env {PGFEnv -> PGF
pgf::PGF,PGFEnv -> Map Language Morpho
mos::Map.Map Language Morpho}

pgfEnv :: PGF -> PGFEnv
pgfEnv PGF
pgf = PGF -> Map Language Morpho -> PGFEnv
Env PGF
pgf Map Language Morpho
mos
  where mos :: Map Language Morpho
mos = [(Language, Morpho)] -> Map Language Morpho
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Language
la,PGF -> Language -> Morpho
buildMorpho PGF
pgf Language
la) | Language
la <- PGF -> [Language]
languages PGF
pgf]

class (Functor m,Monad m,MonadSIO m) => HasPGFEnv m where getPGFEnv :: m PGFEnv

instance (Monad m,HasPGFEnv m,Fail.MonadFail m) => TypeCheckArg m where
  typeCheckArg :: Expr -> m Expr
typeCheckArg Expr
e = ((TcError -> m Expr)
-> ((Expr, Type) -> m Expr)
-> Either TcError (Expr, Type)
-> m Expr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m Expr
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Expr) -> (TcError -> String) -> TcError -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Pretty a => a -> String
render (Doc -> String) -> (TcError -> Doc) -> TcError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcError -> Doc
ppTcError) (Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr)
-> ((Expr, Type) -> Expr) -> (Expr, Type) -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr, Type) -> Expr
forall a b. (a, b) -> a
fst)
                    (Either TcError (Expr, Type) -> m Expr)
-> (PGFEnv -> Either TcError (Expr, Type)) -> PGFEnv -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PGF -> Expr -> Either TcError (Expr, Type))
-> Expr -> PGF -> Either TcError (Expr, Type)
forall a b c. (a -> b -> c) -> b -> a -> c
flip PGF -> Expr -> Either TcError (Expr, Type)
inferExpr Expr
e (PGF -> Either TcError (Expr, Type))
-> (PGFEnv -> PGF) -> PGFEnv -> Either TcError (Expr, Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGFEnv -> PGF
pgf) (PGFEnv -> m Expr) -> m PGFEnv -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m PGFEnv
forall (m :: * -> *). HasPGFEnv m => m PGFEnv
getPGFEnv

pgfCommands :: HasPGFEnv m => Map.Map String (CommandInfo m)
pgfCommands :: Map String (CommandInfo m)
pgfCommands = [(String, CommandInfo m)] -> Map String (CommandInfo m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
  (String
"aw", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"align_words",
     synopsis :: String
synopsis = String
"show word alignments between languages graphically",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Prints a set of strings in the .dot format (the graphviz format).",
       String
"The graph can be saved in a file by the wf command as usual.",
       String
"If the -view flag is defined, the graph is saved in a temporary file",
       String
"which is processed by 'dot' (graphviz) and displayed by the program indicated",
       String
"by the view flag. The target format is png, unless overridden by the",
       String
"flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick)."
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
arg (Env PGF
pgf Map Language Morpho
mos) -> do
         let es :: [Expr]
es = CommandArguments -> [Expr]
toExprs CommandArguments
arg
         let langs :: [Language]
langs = PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts
         if String -> [Option] -> Bool
isOpt String
"giza" [Option]
opts
           then do
             let giz :: [(String, String, String)]
giz = (Expr -> (String, String, String))
-> [Expr] -> [(String, String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (PGF -> (Language, Language) -> Expr -> (String, String, String)
gizaAlignment PGF
pgf ([Language] -> Language
forall a. [a] -> a
head ([Language] -> Language) -> [Language] -> Language
forall a b. (a -> b) -> a -> b
$ [Language]
langs, [Language] -> Language
forall a. [a] -> a
head ([Language] -> Language) -> [Language] -> Language
forall a b. (a -> b) -> a -> b
$ [Language] -> [Language]
forall a. [a] -> [a]
tail ([Language] -> [Language]) -> [Language] -> [Language]
forall a b. (a -> b) -> a -> b
$ [Language]
langs)) [Expr]
es
             let lsrc :: String
lsrc = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,String
_,String
_) -> String
x) [(String, String, String)]
giz
             let ltrg :: String
ltrg = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
_,String
x,String
_) -> String
x) [(String, String, String)]
giz
             let align :: String
align = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
_,String
_,String
x) -> String
x) [(String, String, String)]
giz
             let grph :: String
grph = if [Expr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expr]
es then [] else String
lsrc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n--end_source--\n\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
ltrgString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n-end_target--\n\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
align
             CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString String
grph
           else do
             let grphs :: [String]
grphs = (Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (PGF -> [Language] -> Expr -> String
graphvizAlignment PGF
pgf [Language]
langs) [Expr]
es
             if String -> [Option] -> Bool
isFlag String
"view" [Option]
opts Bool -> Bool -> Bool
|| String -> [Option] -> Bool
isFlag String
"format" [Option]
opts
               then do
                 let view :: String
view = [Option] -> String
optViewGraph [Option]
opts
                 let format :: String
format = [Option] -> String
optViewFormat [Option]
opts
                 String -> String -> String -> [String] -> SIO CommandOutput
viewGraphviz String
view String
format String
"_grpha_" [String]
grphs
               else CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
grphs,
     examples :: [(String, String)]
examples = [
       (String
"gr | aw"                         , String
"generate a tree and show word alignment as graph script"),
       (String
"gr | aw -view=\"open\""          , String
"generate a tree and display alignment on Mac"),
       (String
"gr | aw -view=\"eog\""           , String
"generate a tree and display alignment on Ubuntu"),
       (String
"gt | aw -giza | wf -file=aligns" , String
"generate trees, send giza alignments to file")
       ],
     options :: [(String, String)]
options = [
       (String
"giza",  String
"show alignments in the Giza format; the first two languages")
       ],
     flags :: [(String, String)]
flags = [
       (String
"format",String
"format of the visualization file (default \"png\")"),
       (String
"lang",  String
"alignments for this list of languages (default: all)"),
       (String
"view",  String
"program to open the resulting file")
       ]
    }),
  (String
"ca", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"clitic_analyse",
     synopsis :: String
synopsis = String
"print the analyses of all words into stems and clitics",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Analyses all words into all possible combinations of stem + clitics.",
       String
"The analysis is returned in the format stem &+ clitic1 &+ clitic2 ...",
       String
"which is hence the inverse of 'pt -bind'. The list of clitics is give",
       String
"by the flag '-clitics'. The list of stems is given as the list of words",
       String
"of the language given by the '-lang' flag."
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec  = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \[Option]
opts CommandArguments
ts PGFEnv
env -> case [Option]
opts of
               [Option]
_ | String -> [Option] -> Bool
isOpt String
"raw" [Option]
opts ->
                    CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> ([String] -> CommandOutput) -> [String] -> SIO CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CommandOutput
fromString (String -> CommandOutput)
-> ([String] -> String) -> [String] -> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[String]] -> String) -> [[[String]]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords ([String] -> String)
-> ([[String]] -> [String]) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"+")) ([[[String]]] -> [String])
-> ([String] -> [[[String]]]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (String -> [[String]]) -> [String] -> [[[String]]]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Bool) -> [String] -> String -> [[String]]
getClitics (Morpho -> String -> Bool
isInMorpho (PGFEnv -> [Option] -> Morpho
optMorpho PGFEnv
env [Option]
opts)) ([Option] -> [String]
optClitics [Option]
opts)) ([String] -> [[[String]]])
-> ([String] -> [String]) -> [String] -> [[[String]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
words ([String] -> SIO CommandOutput) -> [String] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ CommandArguments -> [String]
toStrings CommandArguments
ts
               [Option]
_ ->
                    CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> ([String] -> CommandOutput) -> [String] -> SIO CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> CommandOutput
fromStrings ([String] -> CommandOutput)
-> ([String] -> [String]) -> [String] -> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (String -> Bool) -> [String] -> [String] -> [String]
getCliticsText (Morpho -> String -> Bool
isInMorpho (PGFEnv -> [Option] -> Morpho
optMorpho PGFEnv
env [Option]
opts)) ([Option] -> [String]
optClitics [Option]
opts) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
words ([String] -> SIO CommandOutput) -> [String] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ CommandArguments -> [String]
toStrings CommandArguments
ts,
     flags :: [(String, String)]
flags = [
       (String
"clitics",String
"the list of possible clitics (comma-separated, no spaces)"),
       (String
"lang",   String
"the language of analysis")
       ],
     options :: [(String, String)]
options = [
       (String
"raw", String
"analyse each word separately (not suitable input for parser)")
       ],
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx String
"ca -lang=Fin -clitics=ko,ni \"nukkuuko minun vaimoni\" | p  -- to parse Finnish"
       ]
     }),

  (String
"eb", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"example_based",
     syntax :: String
syntax = String
"eb (-probs=FILE | -lang=LANG)* -file=FILE.gfe",
     synopsis :: String
synopsis = String
"converts .gfe files to .gf files by parsing examples to trees",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Reads FILE.gfe and writes FILE.gf. Each expression of form",
       String
"'%ex CAT QUOTEDSTRING' in FILE.gfe is replaced by a syntax tree.",
       String
"This tree is the first one returned by the parser; a biased ranking",
       String
"can be used to regulate the order. If there are more than one parses",
       String
"the rest are shown in comments, with probabilities if the order is biased.",
       String
"The probabilities flag and configuration file is similar to the commands",
       String
"gr and rt. Notice that the command doesn't change the environment,",
       String
"but the resulting .gf file must be imported separately."
       ],
     options :: [(String, String)]
options = [
       (String
"api",String
"convert trees to overloaded API expressions (using Syntax not Lang)")
       ],
     flags :: [(String, String)]
flags = [
       (String
"file",String
"the file to be converted (suffix .gfe must be given)"),
       (String
"lang",String
"the language in which to parse"),
       (String
"probs",String
"file with probabilities to rank the parses")
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
_ env :: PGFEnv
env@(Env PGF
pgf Map Language Morpho
mos) -> do
       let file :: String
file = [Option] -> String
optFile [Option]
opts
       PGF
pgf <- [Option] -> PGF -> SIO PGF
optProbs [Option]
opts PGF
pgf
       let printer :: Expr -> String
printer = if (String -> [Option] -> Bool
isOpt String
"api" [Option]
opts) then Expr -> String
exprToAPI else ([Language] -> Expr -> String
showExpr [])
       let conf :: ExConfiguration
conf = PGF -> Morpho -> Language -> (Expr -> String) -> ExConfiguration
configureExBased PGF
pgf (PGFEnv -> [Option] -> Morpho
optMorpho PGFEnv
env [Option]
opts) (PGF -> [Option] -> Language
optLang PGF
pgf [Option]
opts) Expr -> String
printer
       (String
file',[String]
ws) <- IO (String, [String]) -> SIO (String, [String])
forall a. IO a -> SIO a
restricted (IO (String, [String]) -> SIO (String, [String]))
-> IO (String, [String]) -> SIO (String, [String])
forall a b. (a -> b) -> a -> b
$ ExConfiguration -> String -> IO (String, [String])
parseExamplesInGrammar ExConfiguration
conf String
file
       if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ws then () -> SIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> SIO ()
putStrLn (String
"unknown words: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
ws)
       CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CommandOutput
fromString (String
"wrote " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file')),
     needsTypeCheck :: Bool
needsTypeCheck = Bool
False
     }),
  (String
"gr", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"generate_random",
     synopsis :: String
synopsis = String
"generate random trees in the current abstract syntax",
     syntax :: String
syntax = String
"gr [-cat=CAT] [-number=INT]",
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx String
"gr                     -- one tree in the startcat of the current grammar",
       String -> (String, String)
mkEx String
"gr -cat=NP -number=16  -- 16 trees in the category NP",
       String -> (String, String)
mkEx String
"gr -lang=LangHin,LangTha -cat=Cl  -- Cl, both in LangHin and LangTha",
       String -> (String, String)
mkEx String
"gr -probs=FILE         -- generate with bias",
       String -> (String, String)
mkEx String
"gr (AdjCN ? (UseN ?))  -- generate trees of form (AdjCN ? (UseN ?))"
       ],
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Generates a list of random trees, by default one tree.",
       String
"If a tree argument is given, the command completes the Tree with values to",
       String
"all metavariables in the tree. The generation can be biased by probabilities,",
       String
"given in a file in the -probs flag."
       ],
     flags :: [(String, String)]
flags = [
       (String
"cat",String
"generation category"),
       (String
"lang",String
"uses only functions that have linearizations in all these languages"),
       (String
"number",String
"number of trees generated"),
       (String
"depth",String
"the maximum generation depth"),
       (String
"probs", String
"file with biased probabilities (format 'f 0.4' one by line)")
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
arg (Env PGF
pgf Map Language Morpho
mos) -> do
       PGF
pgf <- [Option] -> PGF -> SIO PGF
optProbs [Option]
opts ([Option] -> PGF -> PGF
optRestricted [Option]
opts PGF
pgf)
       StdGen
gen <- SIO StdGen
newStdGen
       let dp :: Int
dp = String -> Int -> [Option] -> Int
valIntOpts String
"depth" Int
4 [Option]
opts
       let ts :: [Expr]
ts  = case [Expr] -> Maybe Expr
forall a. [a] -> Maybe a
mexp (CommandArguments -> [Expr]
toExprs CommandArguments
arg) of
                   Just Expr
ex -> StdGen -> PGF -> Expr -> Maybe Int -> [Expr]
forall g. RandomGen g => g -> PGF -> Expr -> Maybe Int -> [Expr]
generateRandomFromDepth StdGen
gen PGF
pgf Expr
ex (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
dp)
                   Maybe Expr
Nothing -> StdGen -> PGF -> Type -> Maybe Int -> [Expr]
forall g. RandomGen g => g -> PGF -> Type -> Maybe Int -> [Expr]
generateRandomDepth     StdGen
gen PGF
pgf (PGF -> [Option] -> Type
optType PGF
pgf [Option]
opts) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
dp)
       [Expr] -> SIO CommandOutput
forall (m :: * -> *). Monad m => [Expr] -> m CommandOutput
returnFromExprs ([Expr] -> SIO CommandOutput) -> [Expr] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
take ([Option] -> Int
optNum [Option]
opts) [Expr]
ts
     }),
  (String
"gt", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"generate_trees",
     synopsis :: String
synopsis = String
"generates a list of trees, by default exhaustive",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Generates all trees of a given category. By default, ",
       String
"the depth is limited to 4, but this can be changed by a flag.",
       String
"If a Tree argument is given, the command completes the Tree with values",
       String
"to all metavariables in the tree."
       ],
     flags :: [(String, String)]
flags = [
       (String
"cat",String
"the generation category"),
       (String
"depth",String
"the maximum generation depth"),
       (String
"lang",String
"excludes functions that have no linearization in this language"),
       (String
"number",String
"the number of trees generated")
       ],
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx String
"gt                     -- all trees in the startcat, to depth 4",
       String -> (String, String)
mkEx String
"gt -cat=NP -number=16  -- 16 trees in the category NP",
       String -> (String, String)
mkEx String
"gt -cat=NP -depth=2    -- trees in the category NP to depth 2",
       String -> (String, String)
mkEx String
"gt (AdjCN ? (UseN ?))  -- trees of form (AdjCN ? (UseN ?))"
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
arg (Env PGF
pgf Map Language Morpho
mos) -> do
       let pgfr :: PGF
pgfr = [Option] -> PGF -> PGF
optRestricted [Option]
opts PGF
pgf
       let dp :: Int
dp = String -> Int -> [Option] -> Int
valIntOpts String
"depth" Int
4 [Option]
opts
       let ts :: [Expr]
ts = case [Expr] -> Maybe Expr
forall a. [a] -> Maybe a
mexp (CommandArguments -> [Expr]
toExprs CommandArguments
arg) of
                  Just Expr
ex -> PGF -> Expr -> Maybe Int -> [Expr]
generateFromDepth PGF
pgfr Expr
ex (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
dp)
                  Maybe Expr
Nothing -> PGF -> Type -> Maybe Int -> [Expr]
generateAllDepth PGF
pgfr (PGF -> [Option] -> Type
optType PGF
pgf [Option]
opts) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
dp)
       [Expr] -> SIO CommandOutput
forall (m :: * -> *). Monad m => [Expr] -> m CommandOutput
returnFromExprs ([Expr] -> SIO CommandOutput) -> [Expr] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
take ([Option] -> Int
optNumInf [Option]
opts) [Expr]
ts
     }),
  (String
"i", CommandInfo m
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"import",
     synopsis :: String
synopsis = String
"import a grammar from source code or compiled .pgf file",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Reads a grammar from File and compiles it into a GF runtime grammar.",
       String
"If its abstract is different from current state, old modules are discarded.",
       String
"If its abstract is the same and a concrete with the same name is already in the state",
       String
"it is overwritten - but only if compilation succeeds.",
       String
"The grammar parser depends on the file name suffix:",
       String
"  .cf    context-free (labelled BNF) source",
       String
"  .ebnf  extended BNF source",
       String
"  .gfm   multi-module GF source",
       String
"  .gf    normal GF source",
       String
"  .gfo   compiled GF source",
       String
"  .pgf   precompiled grammar in Portable Grammar Format"
       ],
     flags :: [(String, String)]
flags = [
       (String
"probs",String
"file with biased probabilities for generation")
       ],
     options :: [(String, String)]
options = [
       -- ["gfo", "src", "no-cpu", "cpu", "quiet", "verbose"]
       (String
"retain",String
"retain operations (used for cc command)"),
       (String
"src",   String
"force compilation from source"),
       (String
"v",     String
"be verbose - show intermediate status information")
       ],
     needsTypeCheck :: Bool
needsTypeCheck = Bool
False
     }),
  (String
"l", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"linearize",
     synopsis :: String
synopsis = String
"convert an abstract syntax expression to string",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Shows the linearization of a Tree by the grammars in scope.",
       String
"The -lang flag can be used to restrict this to fewer languages.",
       String
"A sequence of string operations (see command ps) can be given",
       String
"as options, and works then like a pipe to the ps command, except",
       String
"that it only affect the strings, not e.g. the table labels.",
       String
"These can be given separately to each language with the unlexer flag",
       String
"whose results are prepended to the other lexer flags. The value of the",
       String
"unlexer flag is a space-separated list of comma-separated string operation",
       String
"sequences; see example."
       ],
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx String
"l -lang=LangSwe,LangNor no_Utt   -- linearize tree to LangSwe and LangNor",
       String -> (String, String)
mkEx String
"gr -lang=LangHin -cat=Cl | l -table -to_devanagari -- hindi table",
       String -> (String, String)
mkEx String
"l -unlexer=\"LangAra=to_arabic LangHin=to_devanagari\" -- different unlexers"
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
ts (Env PGF
pgf Map Language Morpho
mos) -> CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> ([Expr] -> CommandOutput) -> [Expr] -> SIO CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> CommandOutput
fromStrings ([String] -> CommandOutput)
-> ([Expr] -> [String]) -> [Expr] -> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> [Option] -> [Expr] -> [String]
optLins PGF
pgf [Option]
opts ([Expr] -> SIO CommandOutput) -> [Expr] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ CommandArguments -> [Expr]
toExprs CommandArguments
ts,
     options :: [(String, String)]
options = [
       (String
"all",    String
"show all forms and variants, one by line (cf. l -list)"),
       (String
"bracket",String
"show tree structure with brackets and paths to nodes"),
       (String
"groups", String
"all languages, grouped by lang, remove duplicate strings"),
       (String
"list",String
"show all forms and variants, comma-separated on one line (cf. l -all)"),
       (String
"multi",String
"linearize to all languages (default)"),
       (String
"table",String
"show all forms labelled by parameters"),
       (String
"tabtreebank",String
"show the tree and its linearizations on a tab-separated line"),
       (String
"treebank",String
"show the tree and tag linearizations with language names")
       ] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
stringOpOptions,
     flags :: [(String, String)]
flags = [
       (String
"lang",String
"the languages of linearization (comma-separated, no spaces)"),
       (String
"unlexer",String
"set unlexers separately to each language (space-separated)")
       ]
     }),
  (String
"lc", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"linearize_chunks",
     synopsis :: String
synopsis = String
"linearize a tree that has metavariables in maximal chunks without them",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"A hopefully temporary command, intended to work around the type checker that fails",
       String
"trees where a function node is a metavariable."
       ],
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx String
"l -lang=LangSwe,LangNor -chunks ? a b (? c d)"
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
ts (Env PGF
pgf Map Language Morpho
mos) -> CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> ([String] -> CommandOutput) -> [String] -> SIO CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> CommandOutput
fromStrings ([String] -> SIO CommandOutput) -> [String] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ PGF -> [Option] -> [Expr] -> [String]
optLins PGF
pgf ([Option]
opts [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [String -> Option
OOpt String
"chunks"]) (CommandArguments -> [Expr]
toExprs CommandArguments
ts),
     options :: [(String, String)]
options = [
       (String
"treebank",String
"show the tree and tag linearizations with language names")
       ] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
stringOpOptions,
     flags :: [(String, String)]
flags = [
       (String
"lang",String
"the languages of linearization (comma-separated, no spaces)")
       ],
     needsTypeCheck :: Bool
needsTypeCheck = Bool
False
     }),
  (String
"ma", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"morpho_analyse",
     synopsis :: String
synopsis = String
"print the morphological analyses of all words in the string",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Prints all the analyses of space-separated words in the input string,",
       String
"using the morphological analyser of the actual grammar (see command pg)"
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec  = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \[Option]
opts CommandArguments
ts PGFEnv
env -> case [Option]
opts of
               [Option]
_ | String -> [Option] -> Bool
isOpt String
"missing" [Option]
opts ->
                    CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> ([String] -> CommandOutput) -> [String] -> SIO CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CommandOutput
fromString (String -> CommandOutput)
-> ([String] -> String) -> [String] -> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Morpho -> [String] -> [String]
morphoMissing (PGFEnv -> [Option] -> Morpho
optMorpho PGFEnv
env [Option]
opts) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
words ([String] -> SIO CommandOutput) -> [String] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ CommandArguments -> [String]
toStrings CommandArguments
ts
               [Option]
_ | String -> [Option] -> Bool
isOpt String
"known" [Option]
opts ->
                    CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> ([String] -> CommandOutput) -> [String] -> SIO CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CommandOutput
fromString (String -> CommandOutput)
-> ([String] -> String) -> [String] -> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Morpho -> [String] -> [String]
morphoKnown (PGFEnv -> [Option] -> Morpho
optMorpho PGFEnv
env [Option]
opts) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
words ([String] -> SIO CommandOutput) -> [String] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ CommandArguments -> [String]
toStrings CommandArguments
ts
               [Option]
_ -> CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> ([String] -> CommandOutput) -> [String] -> SIO CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CommandOutput
fromString (String -> CommandOutput)
-> ([String] -> String) -> [String] -> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    ((String, [(Language, String)]) -> String)
-> [(String, [(Language, String)])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [(Language, String)]) -> String
prMorphoAnalysis ([(String, [(Language, String)])] -> [String])
-> ([String] -> [(String, [(Language, String)])])
-> [String]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [(String, [(Language, String)])])
-> [String] -> [(String, [(Language, String)])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PGFEnv -> [Option] -> String -> [(String, [(Language, String)])]
morphos PGFEnv
env [Option]
opts) ([String] -> [(String, [(Language, String)])])
-> ([String] -> [String])
-> [String]
-> [(String, [(Language, String)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
words ([String] -> SIO CommandOutput) -> [String] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ CommandArguments -> [String]
toStrings CommandArguments
ts,
     flags :: [(String, String)]
flags = [
       (String
"lang",String
"the languages of analysis (comma-separated, no spaces)")
       ],
     options :: [(String, String)]
options = [
       (String
"known",  String
"return only the known words, in order of appearance"),
       (String
"missing",String
"show the list of unknown words, in order of appearance")
       ]
     }),

  (String
"mq", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"morpho_quiz",
     synopsis :: String
synopsis = String
"start a morphology quiz",
     syntax :: String
syntax   = String
"mq (-cat=CAT)? (-probs=FILE)? TREE?",
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
arg (Env PGF
pgf Map Language Morpho
mos) -> do
         let lang :: Language
lang = PGF -> [Option] -> Language
optLang PGF
pgf [Option]
opts
         let typ :: Type
typ  = PGF -> [Option] -> Type
optType PGF
pgf [Option]
opts
         PGF
pgf <- [Option] -> PGF -> SIO PGF
optProbs [Option]
opts PGF
pgf
         let mt :: Maybe Expr
mt = [Expr] -> Maybe Expr
forall a. [a] -> Maybe a
mexp (CommandArguments -> [Expr]
toExprs CommandArguments
arg)
         IO () -> SIO ()
forall a. IO a -> SIO a
restricted (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ Maybe Expr -> PGF -> Language -> Type -> IO ()
morphologyQuiz Maybe Expr
mt PGF
pgf Language
lang Type
typ
         CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void,
     flags :: [(String, String)]
flags = [
       (String
"lang",String
"language of the quiz"),
       (String
"cat",String
"category of the quiz"),
       (String
"number",String
"maximum number of questions"),
       (String
"probs",String
"file with biased probabilities for generation")
       ]
     }),

  (String
"p", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"parse",
     synopsis :: String
synopsis = String
"parse a string to abstract syntax expression",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Shows all trees returned by parsing a string in the grammars in scope.",
       String
"The -lang flag can be used to restrict this to fewer languages.",
       String
"The default start category can be overridden by the -cat flag.",
       String
"See also the ps command for lexing and character encoding.",
       String
"",
       String
"The -openclass flag is experimental and allows some robustness in ",
       String
"the parser. For example if -openclass=\"A,N,V\" is given, the parser",
       String
"will accept unknown adjectives, nouns and verbs with the resource grammar."
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
ts (Env PGF
pgf Map Language Morpho
mos) ->
              CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ [Option]
-> [(String, (ParseOutput, BracketedString))] -> CommandOutput
forall (t :: * -> *).
Foldable t =>
[Option]
-> t (String, (ParseOutput, BracketedString)) -> CommandOutput
fromParse [Option]
opts ([[(String, (ParseOutput, BracketedString))]]
-> [(String, (ParseOutput, BracketedString))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [((ParseOutput, BracketedString)
 -> (String, (ParseOutput, BracketedString)))
-> [(ParseOutput, BracketedString)]
-> [(String, (ParseOutput, BracketedString))]
forall a b. (a -> b) -> [a] -> [b]
map ((,) String
s) (PGF -> [Option] -> String -> [(ParseOutput, BracketedString)]
par PGF
pgf [Option]
opts String
s) | String
s <- CommandArguments -> [String]
toStrings CommandArguments
ts]),
     flags :: [(String, String)]
flags = [
       (String
"cat",String
"target category of parsing"),
       (String
"lang",String
"the languages of parsing (comma-separated, no spaces)"),
       (String
"openclass",String
"list of open-class categories for robust parsing"),
       (String
"depth",String
"maximal depth for proof search if the abstract syntax tree has meta variables")
       ],
     options :: [(String, String)]
options = [
       (String
"bracket",String
"prints the bracketed string from the parser")
       ]
     }),
  (String
"pg", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo { -----
     longname :: String
longname = String
"print_grammar",
     synopsis :: String
synopsis = String
"print the actual grammar with the given printer",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Prints the actual grammar, with all involved languages.",
       String
"In some printers, this can be restricted to a subset of languages",
       String
"with the -lang=X,Y flag (comma-separated, no spaces).",
       String
"The -printer=P flag sets the format in which the grammar is printed.",
       String
"N.B.1 Since grammars are compiled when imported, this command",
       String
"generally shows a grammar that looks rather different from the source.",
       String
"N.B.2 Another way to produce different formats is to use 'gf -make',",
       String
"the batch compiler. The following values are available both for",
       String
"the batch compiler (flag -output-format) and the print_grammar",
       String
"command (flag -printer):",
       String
""
       ] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ([String] -> [String]
forall a. Ord a => [a] -> [a]
sort [
        String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expl |
           ((String
opt,OutputFormat
_),String
expl) <- [((String, OutputFormat), String)]
outputFormatsExpl, Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
expl String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"*"
       ]),
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec  = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \[Option]
opts CommandArguments
_ PGFEnv
env -> PGFEnv -> [Option] -> SIO CommandOutput
prGrammar PGFEnv
env [Option]
opts,
     flags :: [(String, String)]
flags = [
       --"cat",
       (String
"file",   String
"set the file name when printing with -pgf option"),
       (String
"lang",   String
"select languages for the some options (default all languages)"),
       (String
"printer",String
"select the printing format (see flag values above)")
       ],
     options :: [(String, String)]
options = [
       (String
"cats",   String
"show just the names of abstract syntax categories"),
       (String
"fullform", String
"print the fullform lexicon"),
       (String
"funs",   String
"show just the names and types of abstract syntax functions"),
       (String
"langs",  String
"show just the names of top concrete syntax modules"),
       (String
"lexc", String
"print the lexicon in Xerox LEXC format"),
       (String
"missing",String
"show just the names of functions that have no linearization"),
       (String
"opt",    String
"optimize the generated pgf"),
       (String
"pgf",    String
"write current pgf image in file"),
       (String
"words", String
"print the list of words")
       ],
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx (String
"pg -funs | ? grep \" S ;\"  -- show functions with value cat S")
       ]
     }),
  (String
"pt", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"put_tree",
     syntax :: String
syntax = String
"pt OPT? TREE",
     synopsis :: String
synopsis = String
"return a tree, possibly processed with a function",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Returns a tree obtained from its argument tree by applying",
       String
"tree processing functions in the order given in the command line",
       String
"option list. Thus 'pt -f -g s' returns g (f s). Typical tree processors",
       String
"are type checking and semantic computation."
       ],
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx String
"pt -compute (plus one two)                               -- compute value"
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
arg (Env PGF
pgf Map Language Morpho
mos) ->
            [Expr] -> SIO CommandOutput
forall (m :: * -> *). Monad m => [Expr] -> m CommandOutput
returnFromExprs ([Expr] -> SIO CommandOutput)
-> ([Expr] -> [Expr]) -> [Expr] -> SIO CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Option] -> [Expr] -> [Expr]
forall a. [Option] -> [a] -> [a]
takeOptNum [Option]
opts ([Expr] -> [Expr]) -> ([Expr] -> [Expr]) -> [Expr] -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> [Option] -> [Expr] -> [Expr]
treeOps PGF
pgf [Option]
opts ([Expr] -> SIO CommandOutput) -> [Expr] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ CommandArguments -> [Expr]
toExprs CommandArguments
arg,
     options :: [(String, String)]
options = PGF -> [(String, String)]
treeOpOptions PGF
forall a. HasCallStack => a
undefined{-pgf-},
     flags :: [(String, String)]
flags = [(String
"number",String
"take at most this many trees")] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ PGF -> [(String, String)]
treeOpFlags PGF
forall a. HasCallStack => a
undefined{-pgf-}
     }),
  (String
"rf",  CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"read_file",
     synopsis :: String
synopsis = String
"read string or tree input from a file",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Reads input from file. The filename must be in double quotes.",
       String
"The input is interpreted as a string by default, and can hence be",
       String
"piped e.g. to the parse command. The option -tree interprets the",
       String
"input as a tree, which can be given e.g. to the linearize command.",
       String
"The option -lines will result in a list of strings or trees, one by line."
       ],
     options :: [(String, String)]
options = [
       (String
"lines",String
"return the list of lines, instead of the singleton of all contents"),
       (String
"paragraphs",String
"return the list of paragraphs, as separated by empty lines"),
       (String
"tree",String
"convert strings into trees")
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
_ (Env PGF
pgf Map Language Morpho
mos) -> do
       let file :: String
file = String -> String -> [Option] -> String
valStrOpts String
"file" String
"_gftmp" [Option]
opts
       let exprs :: [(a2, String)] -> ([Expr], Doc)
exprs []         = ([],Doc
empty)
           exprs ((a2
n,String
s):[(a2, String)]
ls) | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s
                            = [(a2, String)] -> ([Expr], Doc)
exprs [(a2, String)]
ls
           exprs ((a2
n,String
s):[(a2, String)]
ls) = case String -> Maybe Expr
readExpr String
s of
                                Just Expr
e  -> let ([Expr]
es,Doc
err) = [(a2, String)] -> ([Expr], Doc)
exprs [(a2, String)]
ls
                                           in case PGF -> Expr -> Either TcError (Expr, Type)
inferExpr PGF
pgf Expr
e of
                                                Right (Expr
e,Type
t) -> (Expr
eExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[Expr]
es,Doc
err)
                                                Left TcError
tcerr  -> ([Expr]
es,String
"on line" String -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
n Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Char
':' Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$ Int -> Doc -> Doc
forall a. Pretty a => Int -> a -> Doc
nest Int
2 (TcError -> Doc
ppTcError TcError
tcerr) Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$ Doc
err)
                                Maybe Expr
Nothing -> let ([Expr]
es,Doc
err) = [(a2, String)] -> ([Expr], Doc)
exprs [(a2, String)]
ls
                                           in ([Expr]
es,String
"on line" String -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> a2
n Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Char
':' Doc -> String -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> String
"parse error" Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$ Doc
err)
           returnFromLines :: [(a2, String)] -> m CommandOutput
returnFromLines [(a2, String)]
ls = case [(a2, String)] -> ([Expr], Doc)
forall a2. Pretty a2 => [(a2, String)] -> ([Expr], Doc)
exprs [(a2, String)]
ls of
                                  ([Expr]
es, Doc
err) | [Expr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expr]
es   -> CommandOutput -> m CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> m CommandOutput)
-> CommandOutput -> m CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
pipeMessage (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ Doc -> String
forall a. Pretty a => a -> String
render (Doc
err Doc -> String -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$ String
"no trees found")
                                            | Bool
otherwise -> CommandOutput -> m CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> m CommandOutput)
-> CommandOutput -> m CommandOutput
forall a b. (a -> b) -> a -> b
$ [Expr] -> String -> CommandOutput
pipeWithMessage [Expr]
es (Doc -> String
forall a. Pretty a => a -> String
render Doc
err)

       String
s <- IO String -> SIO String
forall a. IO a -> SIO a
restricted (IO String -> SIO String) -> IO String -> SIO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
file
       case [Option]
opts of
         [Option]
_ | String -> [Option] -> Bool
isOpt String
"lines" [Option]
opts Bool -> Bool -> Bool
&& String -> [Option] -> Bool
isOpt String
"tree" [Option]
opts ->
               [(Int, String)] -> SIO CommandOutput
forall a2 (m :: * -> *).
(Pretty a2, Monad m) =>
[(a2, String)] -> m CommandOutput
returnFromLines ([Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1::Int ..] (String -> [String]
lines String
s))
         [Option]
_ | String -> [Option] -> Bool
isOpt String
"tree" [Option]
opts ->
               [(Int, String)] -> SIO CommandOutput
forall a2 (m :: * -> *).
(Pretty a2, Monad m) =>
[(a2, String)] -> m CommandOutput
returnFromLines [(Int
1::Int,String
s)]
         [Option]
_ | String -> [Option] -> Bool
isOpt String
"lines" [Option]
opts -> CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> CommandOutput
fromStrings ([String] -> CommandOutput) -> [String] -> CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s)
         [Option]
_ | String -> [Option] -> Bool
isOpt String
"paragraphs" [Option]
opts -> CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> CommandOutput
fromStrings ([String] -> CommandOutput) -> [String] -> CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
toParagraphs ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s)
         [Option]
_ -> CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CommandOutput
fromString String
s),
     flags :: [(String, String)]
flags = [(String
"file",String
"the input file name")]
     }),
  (String
"rt", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"rank_trees",
     synopsis :: String
synopsis = String
"show trees in an order of decreasing probability",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Order trees from the most to the least probable, using either",
       String
"even distribution in each category (default) or biased as specified",
       String
"by the file given by flag -probs=FILE, where each line has the form",
       String
"'function probability', e.g. 'youPol_Pron  0.01'."
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
arg (Env PGF
pgf Map Language Morpho
mos) -> do
         let ts :: [Expr]
ts = CommandArguments -> [Expr]
toExprs CommandArguments
arg
         PGF
pgf <- [Option] -> PGF -> SIO PGF
optProbs [Option]
opts PGF
pgf
         let tds :: [(Expr, Double)]
tds = PGF -> [Expr] -> [(Expr, Double)]
rankTreesByProbs PGF
pgf [Expr]
ts
         if String -> [Option] -> Bool
isOpt String
"v" [Option]
opts
           then String -> SIO ()
putStrLn (String -> SIO ()) -> String -> SIO ()
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
unlines [[Language] -> Expr -> String
showExpr []  Expr
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
d | (Expr
t,Double
d) <- [(Expr, Double)]
tds]
           else () -> SIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         [Expr] -> SIO CommandOutput
forall (m :: * -> *). Monad m => [Expr] -> m CommandOutput
returnFromExprs ([Expr] -> SIO CommandOutput) -> [Expr] -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ ((Expr, Double) -> Expr) -> [(Expr, Double)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Expr, Double) -> Expr
forall a b. (a, b) -> a
fst [(Expr, Double)]
tds,
     flags :: [(String, String)]
flags = [
       (String
"probs",String
"probabilities from this file (format 'f 0.6' per line)")
       ],
     options :: [(String, String)]
options = [
       (String
"v",String
"show all trees with their probability scores")
       ],
     examples :: [(String, String)]
examples = [
      String -> (String, String)
mkEx String
"p \"you are here\" | rt -probs=probs | pt -number=1 -- most probable result"
      ]
     }),
  (String
"tq", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"translation_quiz",
     syntax :: String
syntax   = String
"tq -from=LANG -to=LANG (-cat=CAT)? (-probs=FILE)? TREE?",
     synopsis :: String
synopsis = String
"start a translation quiz",
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
arg (Env PGF
pgf Map Language Morpho
mos) -> do
         let from :: Language
from = String -> PGF -> [Option] -> Language
optLangFlag String
"from" PGF
pgf [Option]
opts
         let to :: Language
to   = String -> PGF -> [Option] -> Language
optLangFlag String
"to" PGF
pgf [Option]
opts
         let typ :: Type
typ  = PGF -> [Option] -> Type
optType PGF
pgf [Option]
opts
         let mt :: Maybe Expr
mt   = [Expr] -> Maybe Expr
forall a. [a] -> Maybe a
mexp (CommandArguments -> [Expr]
toExprs CommandArguments
arg)
         PGF
pgf <- [Option] -> PGF -> SIO PGF
optProbs [Option]
opts PGF
pgf
         IO () -> SIO ()
forall a. IO a -> SIO a
restricted (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ Maybe Expr -> PGF -> Language -> Language -> Type -> IO ()
translationQuiz Maybe Expr
mt PGF
pgf Language
from Language
to Type
typ
         CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void,
     flags :: [(String, String)]
flags = [
       (String
"from",String
"translate from this language"),
       (String
"to",String
"translate to this language"),
       (String
"cat",String
"translate in this category"),
       (String
"number",String
"the maximum number of questions"),
       (String
"probs",String
"file with biased probabilities for generation")
       ],
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx (String
"tq -from=Eng -to=Swe                               -- any trees in startcat"),
       String -> (String, String)
mkEx (String
"tq -from=Eng -to=Swe (AdjCN (PositA ?2) (UseN ?))  -- only trees of this form")
       ]
     }),


  (String
"vd", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"visualize_dependency",
     synopsis :: String
synopsis = String
"show word dependency tree graphically",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Prints a dependency tree in the .dot format (the graphviz format, default)",
       String
"or LaTeX (flag -output=latex)",
       String
"or the CoNLL/MaltParser format (flag -output=conll for training, malt_input",
       String
"for unanalysed input).",
       String
"By default, the last argument is the head of every abstract syntax",
       String
"function; moreover, the head depends on the head of the function above.",
       String
"The graph can be saved in a file by the wf command as usual.",
       String
"If the -view flag is defined, the graph is saved in a temporary file",
       String
"which is processed by dot (graphviz) and displayed by the program indicated",
       String
"by the view flag. The target format is png, unless overridden by the",
       String
"flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).",
       String
"See also 'vp -showdep' for another visualization of dependencies." 
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
arg (Env PGF
pgf Map Language Morpho
mos) -> do
         let absname :: Language
absname = PGF -> Language
abstractName PGF
pgf
         let es :: [Expr]
es = CommandArguments -> [Expr]
toExprs CommandArguments
arg
         let debug :: Bool
debug = String -> [Option] -> Bool
isOpt String
"v" [Option]
opts
         let abslabels :: String
abslabels = String -> String -> [Option] -> String
valStrOpts String
"abslabels" (String -> String -> [Option] -> String
valStrOpts String
"file" String
"" [Option]
opts) [Option]
opts
         let cnclabels :: String
cnclabels = String -> String -> [Option] -> String
valStrOpts String
"cnclabels" String
"" [Option]
opts
         let outp :: String
outp = String -> String -> [Option] -> String
valStrOpts String
"output" String
"dot" [Option]
opts
         Maybe Labels
mlab <- case String
abslabels of
           String
"" -> Maybe Labels -> SIO (Maybe Labels)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Labels
forall a. Maybe a
Nothing
           String
_  -> (Labels -> Maybe Labels
forall a. a -> Maybe a
Just (Labels -> Maybe Labels)
-> (String -> Labels) -> String -> Maybe Labels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Labels
getDepLabels) (String -> Maybe Labels) -> SIO String -> SIO (Maybe Labels)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO String -> SIO String
forall a. IO a -> SIO a
restricted (String -> IO String
readFile String
abslabels)
         Maybe CncLabels
mclab <- case String
cnclabels of
           String
"" -> Maybe CncLabels -> SIO (Maybe CncLabels)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CncLabels
forall a. Maybe a
Nothing
           String
_  -> (CncLabels -> Maybe CncLabels
forall a. a -> Maybe a
Just (CncLabels -> Maybe CncLabels)
-> (String -> CncLabels) -> String -> Maybe CncLabels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CncLabels
getCncDepLabels) (String -> Maybe CncLabels) -> SIO String -> SIO (Maybe CncLabels)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO String -> SIO String
forall a. IO a -> SIO a
restricted (String -> IO String
readFile String
cnclabels)
         let lang :: Language
lang = PGF -> [Option] -> Language
optLang PGF
pgf [Option]
opts
         let grphs :: [String]
grphs = (Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
-> Bool
-> Maybe Labels
-> Maybe CncLabels
-> PGF
-> Language
-> Expr
-> String
graphvizDependencyTree String
outp Bool
debug Maybe Labels
mlab Maybe CncLabels
mclab PGF
pgf Language
lang) [Expr]
es
         if String -> [Option] -> Bool
isOpt String
"conll2latex" [Option]
opts
           then CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> String
conlls2latexDoc ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
stanzas (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ CommandArguments -> [String]
toStrings CommandArguments
arg
           else if String -> [Option] -> Bool
isFlag String
"view" [Option]
opts Bool -> Bool -> Bool
&& String -> String -> [Option] -> String
valStrOpts String
"output" String
"" [Option]
opts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"latex"
             then do
               let view :: String
view = [Option] -> String
optViewGraph [Option]
opts
               String -> String -> [String] -> SIO CommandOutput
viewLatex String
view String
"_grphd_" [String]
grphs
             else if String -> [Option] -> Bool
isFlag String
"view" [Option]
opts Bool -> Bool -> Bool
|| String -> [Option] -> Bool
isFlag String
"format" [Option]
opts
               then do
                 let view :: String
view = [Option] -> String
optViewGraph [Option]
opts
                 let format :: String
format = [Option] -> String
optViewFormat [Option]
opts
                 String -> String -> String -> [String] -> SIO CommandOutput
viewGraphviz String
view String
format String
"_grphd_" [String]
grphs
               else CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"" [String]
grphs,
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx String
"gr | vd              -- generate a tree and show dependency tree in .dot",
       String -> (String, String)
mkEx String
"gr | vd -view=open   -- generate a tree and display dependency tree on with Mac's 'open'",
       String -> (String, String)
mkEx String
"gr | vd -view=open -output=latex   -- generate a tree and display latex dependency tree with Mac's 'open'",
       String -> (String, String)
mkEx String
"gr -number=1000 | vd -abslabels=Lang.labels -cnclabels=LangSwe.labels -output=conll  -- generate a random treebank",
       String -> (String, String)
mkEx String
"rf -file=ex.conll | vd -conll2latex | wf -file=ex.tex   -- convert conll file to latex"
       ],
     options :: [(String, String)]
options = [
       (String
"v",String
"show extra information"),
       (String
"conll2latex", String
"convert conll to latex")
       ],
     flags :: [(String, String)]
flags = [
       (String
"abslabels",String
"abstract configuration file for labels, format per line 'fun label*'"),
       (String
"cnclabels",String
"concrete configuration file for labels, format per line 'fun {words|*} pos label head'"),
       (String
"file",     String
"same as abslabels (abstract configuration file)"),
       (String
"format",   String
"format of the visualization file using dot (default \"png\")"),
       (String
"output",   String
"output format of graph source (latex, conll, dot (default but deprecated))"),
       (String
"view",     String
"program to open the resulting graph file (default \"open\")"),
       (String
"lang",     String
"the language of analysis")
       ]
    }),


  (String
"vp", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"visualize_parse",
     synopsis :: String
synopsis = String
"show parse tree graphically",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Prints a parse tree in the .dot format (the graphviz format).",
       String
"The graph can be saved in a file by the wf command as usual.",
       String
"If the -view flag is defined, the graph is saved in a temporary file",
       String
"which is processed by dot (graphviz) and displayed by the program indicated",
       String
"by the view flag. The target format is png, unless overridden by the",
       String
"flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick)."
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
arg (Env PGF
pgf Map Language Morpho
mos) -> do
         let es :: [Expr]
es = CommandArguments -> [Expr]
toExprs CommandArguments
arg
         let lang :: Language
lang = PGF -> [Option] -> Language
optLang PGF
pgf [Option]
opts
         let gvOptions :: GraphvizOptions
gvOptions = GraphvizOptions :: Bool
-> Bool
-> Bool
-> Bool
-> String
-> String
-> String
-> String
-> String
-> String
-> GraphvizOptions
GraphvizOptions {noLeaves :: Bool
noLeaves = String -> [Option] -> Bool
isOpt String
"noleaves" [Option]
opts Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> [Option] -> Bool
isOpt String
"showleaves" [Option]
opts),
                                          noFun :: Bool
noFun = String -> [Option] -> Bool
isOpt String
"nofun" [Option]
opts Bool -> Bool -> Bool
|| Bool -> Bool
not (String -> [Option] -> Bool
isOpt String
"showfun" [Option]
opts),
                                          noCat :: Bool
noCat = String -> [Option] -> Bool
isOpt String
"nocat" [Option]
opts Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> [Option] -> Bool
isOpt String
"showcat" [Option]
opts),
                                          noDep :: Bool
noDep = Bool -> Bool
not (String -> [Option] -> Bool
isOpt String
"showdep" [Option]
opts),
                                          nodeFont :: String
nodeFont = String -> String -> [Option] -> String
valStrOpts String
"nodefont" String
"" [Option]
opts,
                                          leafFont :: String
leafFont = String -> String -> [Option] -> String
valStrOpts String
"leaffont" String
"" [Option]
opts,
                                          nodeColor :: String
nodeColor = String -> String -> [Option] -> String
valStrOpts String
"nodecolor" String
"" [Option]
opts,
                                          leafColor :: String
leafColor = String -> String -> [Option] -> String
valStrOpts String
"leafcolor" String
"" [Option]
opts,
                                          nodeEdgeStyle :: String
nodeEdgeStyle = String -> String -> [Option] -> String
valStrOpts String
"nodeedgestyle" String
"solid" [Option]
opts,
                                          leafEdgeStyle :: String
leafEdgeStyle = String -> String -> [Option] -> String
valStrOpts String
"leafedgestyle" String
"dashed" [Option]
opts
                                         }
         let depfile :: String
depfile = String -> String -> [Option] -> String
valStrOpts String
"file" String
"" [Option]
opts
         Maybe Labels
mlab <- case String
depfile of
           String
"" -> Maybe Labels -> SIO (Maybe Labels)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Labels
forall a. Maybe a
Nothing
           String
_  -> (Labels -> Maybe Labels
forall a. a -> Maybe a
Just (Labels -> Maybe Labels)
-> (String -> Labels) -> String -> Maybe Labels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Labels
getDepLabels) (String -> Maybe Labels) -> SIO String -> SIO (Maybe Labels)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO String -> SIO String
forall a. IO a -> SIO a
restricted (String -> IO String
readFile String
depfile)
         let grphs :: [String]
grphs = (Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Labels
-> PGF -> Language -> GraphvizOptions -> Expr -> String
graphvizParseTreeDep Maybe Labels
mlab PGF
pgf Language
lang GraphvizOptions
gvOptions) [Expr]
es
         if String -> [Option] -> Bool
isFlag String
"view" [Option]
opts Bool -> Bool -> Bool
|| String -> [Option] -> Bool
isFlag String
"format" [Option]
opts
           then do
             let view :: String
view = [Option] -> String
optViewGraph [Option]
opts
             let format :: String
format = [Option] -> String
optViewFormat [Option]
opts
             String -> String -> String -> [String] -> SIO CommandOutput
viewGraphviz String
view String
format String
"_grphp_" [String]
grphs
           else CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
grphs,
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx String
"p \"John walks\" | vp  -- generate a tree and show parse tree as .dot script",
       String -> (String, String)
mkEx String
"gr | vp -view=open -- generate a tree and display parse tree on a Mac",
       String -> (String, String)
mkEx String
"p \"she loves us\" | vp -view=open -showdep -file=uddeps.labels -nocat  -- show a visual variant of a dependency tree"
       ],
     options :: [(String, String)]
options = [
       (String
"showcat",String
"show categories in the tree nodes (default)"),
       (String
"nocat",String
"don't show categories"),
       (String
"showdep",String
"show dependency labels"),
       (String
"showfun",String
"show function names in the tree nodes"),
       (String
"nofun",String
"don't show function names (default)"),
       (String
"showleaves",String
"show the leaves of the tree (default)"),
       (String
"noleaves",String
"don't show the leaves of the tree (i.e., only the abstract tree)")
       ],
     flags :: [(String, String)]
flags = [
       (String
"lang",String
"the language to visualize"),
       (String
"file",String
"configuration file for dependency labels with -deps, format per line 'fun label*'"),
       (String
"format",String
"format of the visualization file (default \"png\")"),
       (String
"view",String
"program to open the resulting file (default \"open\")"),
       (String
"nodefont",String
"font for tree nodes (default: Times -- graphviz standard font)"),
       (String
"leaffont",String
"font for tree leaves (default: nodefont)"),
       (String
"nodecolor",String
"color for tree nodes (default: black -- graphviz standard color)"),
       (String
"leafcolor",String
"color for tree leaves (default: nodecolor)"),
       (String
"nodeedgestyle",String
"edge style between tree nodes (solid/dashed/dotted/bold, default: solid)"),
       (String
"leafedgestyle",String
"edge style for links to leaves (solid/dashed/dotted/bold, default: dashed)")
       ]
    }),


  (String
"vt", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"visualize_tree",
     synopsis :: String
synopsis = String
"show a set of trees graphically",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"Prints a set of trees in the .dot format (the graphviz format).",
       String
"The graph can be saved in a file by the wf command as usual.",
       String
"If the -view flag is defined, the graph is saved in a temporary file",
       String
"which is processed by dot (graphviz) and displayed by the command indicated",
       String
"by the view flag. The target format is postscript, unless overridden by the",
       String
"flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).",
       String
"With option -mk, use for showing library style function names of form 'mkC'."
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
arg (Env PGF
pgf Map Language Morpho
mos) ->
      let es :: [Expr]
es = CommandArguments -> [Expr]
toExprs CommandArguments
arg in
       if String -> [Option] -> Bool
isOpt String
"mk" [Option]
opts
       then CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (PGF -> Expr -> String
tree2mk PGF
pgf) [Expr]
es
       else if String -> [Option] -> Bool
isOpt String
"api" [Option]
opts
       then do
         let ss :: [String]
ss = (Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> String
exprToAPI [Expr]
es
         (String -> SIO ()) -> [String] -> SIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> SIO ()
putStrLn [String]
ss
         CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void
       else do
         let funs :: Bool
funs = Bool -> Bool
not (String -> [Option] -> Bool
isOpt String
"nofun" [Option]
opts)
         let cats :: Bool
cats = Bool -> Bool
not (String -> [Option] -> Bool
isOpt String
"nocat" [Option]
opts)
         let grphs :: [String]
grphs = (Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (PGF -> (Bool, Bool) -> Expr -> String
graphvizAbstractTree PGF
pgf (Bool
funs,Bool
cats)) [Expr]
es
         if String -> [Option] -> Bool
isFlag String
"view" [Option]
opts Bool -> Bool -> Bool
|| String -> [Option] -> Bool
isFlag String
"format" [Option]
opts
           then do
             let view :: String
view = [Option] -> String
optViewGraph [Option]
opts
             let format :: String
format = [Option] -> String
optViewFormat [Option]
opts
             String -> String -> String -> [String] -> SIO CommandOutput
viewGraphviz String
view String
format String
"_grpht_" [String]
grphs
           else CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
grphs,
     examples :: [(String, String)]
examples = [
       String -> (String, String)
mkEx String
"p \"hello\" | vt              -- parse a string and show trees as graph script",
       String -> (String, String)
mkEx String
"p \"hello\" | vt -view=\"open\" -- parse a string and display trees on a Mac"
       ],
     options :: [(String, String)]
options = [
       (String
"api", String
"show the tree with function names converted to 'mkC' with value cats C"),
       (String
"mk",  String
"similar to -api, deprecated"),
       (String
"nofun",String
"don't show functions but only categories"),
       (String
"nocat",String
"don't show categories but only functions")
       ],
     flags :: [(String, String)]
flags = [
       (String
"format",String
"format of the visualization file (default \"png\")"),
       (String
"view",String
"program to open the resulting file (default \"open\")")
       ]
     }),
  (String
"ai", CommandInfo Any
forall (m :: * -> *). CommandInfo m
emptyCommandInfo {
     longname :: String
longname = String
"abstract_info",
     syntax :: String
syntax = String
"ai IDENTIFIER  or  ai EXPR",
     synopsis :: String
synopsis = String
"Provides an information about a function, an expression or a category from the abstract syntax",
     explanation :: String
explanation = [String] -> String
unlines [
       String
"The command has one argument which is either function, expression or",
       String
"a category defined in the abstract syntax of the current grammar. ",
       String
"If the argument is a function then ?its type is printed out.",
       String
"If it is a category then the category definition is printed.",
       String
"If a whole expression is given it prints the expression with refined",
       String
"metavariables and the type of the expression."
       ],
     exec :: [Option] -> CommandArguments -> m CommandOutput
exec = ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option] -> CommandArguments -> m CommandOutput
forall (m :: * -> *) t t b.
HasPGFEnv m =>
(t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv (([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
 -> [Option] -> CommandArguments -> m CommandOutput)
-> ([Option] -> CommandArguments -> PGFEnv -> SIO CommandOutput)
-> [Option]
-> CommandArguments
-> m CommandOutput
forall a b. (a -> b) -> a -> b
$ \ [Option]
opts CommandArguments
arg (Env PGF
pgf Map Language Morpho
mos) -> do
       case CommandArguments -> [Expr]
toExprs CommandArguments
arg of
         [EFun Language
id] -> case Language
-> Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
-> Maybe (Type, Int, Maybe ([Equation], [[Instr]]), Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
id (Abstr
-> Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
funs (PGF -> Abstr
abstract PGF
pgf)) of
                        Just (Type, Int, Maybe ([Equation], [[Instr]]), Double)
fd -> do String -> SIO ()
putStrLn (String -> SIO ()) -> String -> SIO ()
forall a b. (a -> b) -> a -> b
$ Doc -> String
forall a. Pretty a => a -> String
render (Language
-> (Type, Int, Maybe ([Equation], [[Instr]]), Double) -> Doc
ppFun Language
id (Type, Int, Maybe ([Equation], [[Instr]]), Double)
fd)
                                      let (Type
_,Int
_,Maybe ([Equation], [[Instr]])
_,Double
prob) = (Type, Int, Maybe ([Equation], [[Instr]]), Double)
fd
                                      String -> SIO ()
putStrLn (String
"Probability: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Double -> String
forall a. Show a => a -> String
show Double
prob)
                                      CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void
                        Maybe (Type, Int, Maybe ([Equation], [[Instr]]), Double)
Nothing -> case Language
-> Map Language ([Hypo], [(Double, Language)], Double)
-> Maybe ([Hypo], [(Double, Language)], Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
id (Abstr -> Map Language ([Hypo], [(Double, Language)], Double)
cats (PGF -> Abstr
abstract PGF
pgf)) of
                                     Just ([Hypo], [(Double, Language)], Double)
cd   -> do String -> SIO ()
putStrLn (String -> SIO ()) -> String -> SIO ()
forall a b. (a -> b) -> a -> b
$
                                                        Doc -> String
forall a. Pretty a => a -> String
render (Language -> ([Hypo], [(Double, Language)], Double) -> Doc
ppCat Language
id ([Hypo], [(Double, Language)], Double)
cd Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                                                if [(Language, Type)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PGF -> Language -> [(Language, Type)]
functionsToCat PGF
pgf Language
id)
                                                                  then Doc
empty
                                                                  else Char
' ' Char -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                                                       [Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat [Language
-> (Type, Int, Maybe ([Equation], [[Instr]]), Double) -> Doc
ppFun Language
fid (Type
ty,Int
0,([Equation], [[Instr]]) -> Maybe ([Equation], [[Instr]])
forall a. a -> Maybe a
Just ([],[]),Double
0) | (Language
fid,Type
ty) <- PGF -> Language -> [(Language, Type)]
functionsToCat PGF
pgf Language
id] Doc -> Char -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                                                                       Char
' ')
                                                     let ([Hypo]
_,[(Double, Language)]
_,Double
prob) = ([Hypo], [(Double, Language)], Double)
cd
                                                     String -> SIO ()
putStrLn (String
"Probability: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Double -> String
forall a. Show a => a -> String
show Double
prob)
                                                     CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void
                                     Maybe ([Hypo], [(Double, Language)], Double)
Nothing   -> do String -> SIO ()
putStrLn (String
"unknown category of function identifier "String -> String -> String
forall a. [a] -> [a] -> [a]
++Language -> String
forall a. Show a => a -> String
show Language
id)
                                                     CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void
         [Expr
e]         -> case PGF -> Expr -> Either TcError (Expr, Type)
inferExpr PGF
pgf Expr
e of
                          Left TcError
tcErr   -> String -> SIO CommandOutput
forall a. String -> a
errorWithoutStackTrace (String -> SIO CommandOutput) -> String -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ Doc -> String
forall a. Pretty a => a -> String
render (TcError -> Doc
ppTcError TcError
tcErr)
                          Right (Expr
e,Type
ty) -> do String -> SIO ()
putStrLn (String
"Expression:  "String -> String -> String
forall a. [a] -> [a] -> [a]
++[Language] -> Expr -> String
showExpr [] Expr
e)
                                             String -> SIO ()
putStrLn (String
"Type:        "String -> String -> String
forall a. [a] -> [a] -> [a]
++[Language] -> Type -> String
showType [] Type
ty)
                                             String -> SIO ()
putStrLn (String
"Probability: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Double -> String
forall a. Show a => a -> String
show (PGF -> Expr -> Double
probTree PGF
pgf Expr
e))
                                             CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void
         [Expr]
_           -> do String -> SIO ()
putStrLn String
"a single identifier or expression is expected from the command"
                           CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void,
     needsTypeCheck :: Bool
needsTypeCheck = Bool
False
     })
  ]
 where
   getEnv :: (t -> t -> PGFEnv -> SIO b) -> t -> t -> m b
getEnv t -> t -> PGFEnv -> SIO b
exec t
opts t
ts = SIO b -> m b
forall (m :: * -> *) a. MonadSIO m => SIO a -> m a
liftSIO (SIO b -> m b) -> (PGFEnv -> SIO b) -> PGFEnv -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t -> PGFEnv -> SIO b
exec t
opts t
ts (PGFEnv -> m b) -> m PGFEnv -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m PGFEnv
forall (m :: * -> *). HasPGFEnv m => m PGFEnv
getPGFEnv

   par :: PGF -> [Option] -> String -> [(ParseOutput, BracketedString)]
par PGF
pgf [Option]
opts String
s = case [Option] -> [Type]
optOpenTypes [Option]
opts of
                  []        -> [PGF
-> Language
-> Type
-> Maybe Int
-> String
-> (ParseOutput, BracketedString)
parse_ PGF
pgf Language
lang (PGF -> [Option] -> Type
optType PGF
pgf [Option]
opts) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
dp) String
s | Language
lang <- PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts]
                  [Type]
open_typs -> [PGF
-> Language
-> Type
-> [Type]
-> Maybe Int
-> String
-> (ParseOutput, BracketedString)
parseWithRecovery PGF
pgf Language
lang (PGF -> [Option] -> Type
optType PGF
pgf [Option]
opts) [Type]
open_typs (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
dp) String
s | Language
lang <- PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts]
     where
       dp :: Int
dp = String -> Int -> [Option] -> Int
valIntOpts String
"depth" Int
4 [Option]
opts

   fromParse :: [Option]
-> t (String, (ParseOutput, BracketedString)) -> CommandOutput
fromParse [Option]
opts = ((String, (ParseOutput, BracketedString))
 -> CommandOutput -> CommandOutput)
-> CommandOutput
-> t (String, (ParseOutput, BracketedString))
-> CommandOutput
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CommandOutput -> CommandOutput -> CommandOutput
joinPiped (CommandOutput -> CommandOutput -> CommandOutput)
-> ((String, (ParseOutput, BracketedString)) -> CommandOutput)
-> (String, (ParseOutput, BracketedString))
-> CommandOutput
-> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Option]
-> (String, (ParseOutput, BracketedString)) -> CommandOutput
fromParse1 [Option]
opts) CommandOutput
void

   joinPiped :: CommandOutput -> CommandOutput -> CommandOutput
joinPiped (Piped (CommandArguments
es1,String
ms1)) (Piped (CommandArguments
es2,String
ms2)) = (CommandArguments, String) -> CommandOutput
Piped (CommandArguments -> CommandArguments -> CommandArguments
jA CommandArguments
es1 CommandArguments
es2,String
ms1String -> String -> String
+++-String
ms2)
     where
       jA :: CommandArguments -> CommandArguments -> CommandArguments
jA (Exprs [Expr]
es1) (Exprs [Expr]
es2) = [Expr] -> CommandArguments
Exprs ([Expr]
es1[Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++[Expr]
es2)
       -- ^ fromParse1 always output Exprs

   fromParse1 :: [Option]
-> (String, (ParseOutput, BracketedString)) -> CommandOutput
fromParse1 [Option]
opts (String
s,(ParseOutput
po,BracketedString
bs))
     | String -> [Option] -> Bool
isOpt String
"bracket" [Option]
opts = String -> CommandOutput
pipeMessage (BracketedString -> String
showBracketedString BracketedString
bs)
     | Bool
otherwise            =
         case ParseOutput
po of
           ParseOk [Expr]
ts      -> [Expr] -> CommandOutput
fromExprs [Expr]
ts
           ParseFailed Int
i   -> String -> CommandOutput
pipeMessage (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ String
"The parser failed at token "
                                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++String
": "
                                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (String -> [String]
words String
s [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
                                          -- ++ " in " ++ show s
           ParseOutput
ParseIncomplete -> String -> CommandOutput
pipeMessage String
"The sentence is not complete"
           TypeError [(Int, TcError)]
errs  ->
             String -> CommandOutput
pipeMessage (String -> CommandOutput)
-> (Doc -> String) -> Doc -> CommandOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Pretty a => a -> String
render (Doc -> CommandOutput) -> Doc -> CommandOutput
forall a b. (a -> b) -> a -> b
$
               String
"The parsing is successful but the type checking failed with error(s):"
               String -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$ Int -> Doc -> Doc
forall a. Pretty a => Int -> a -> Doc
nest Int
2 ([Doc] -> Doc
forall a. Pretty a => [a] -> Doc
vcat (((Int, TcError) -> Doc) -> [(Int, TcError)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (TcError -> Doc
ppTcError (TcError -> Doc)
-> ((Int, TcError) -> TcError) -> (Int, TcError) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, TcError) -> TcError
forall a b. (a, b) -> b
snd) [(Int, TcError)]
errs))

   optLins :: PGF -> [Option] -> [Expr] -> [String]
optLins PGF
pgf [Option]
opts [Expr]
ts = case [Option]
opts of
     [Option]
_ | String -> [Option] -> Bool
isOpt String
"groups" [Option]
opts ->
       ((Language, [String]) -> [String])
-> [(Language, [String])] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Language, [String]) -> [String]
forall a b. (a, b) -> b
snd ([(Language, [String])] -> [String])
-> [(Language, [String])] -> [String]
forall a b. (a -> b) -> a -> b
$ [[(Language, String)]] -> [(Language, [String])]
groupResults
         [[(Language
lang, String
s) | Language
lang <- PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts,String
s <- PGF -> [Option] -> Language -> Expr -> [String]
linear PGF
pgf [Option]
opts Language
lang Expr
t] | Expr
t <- [Expr]
ts]
     [Option]
_ -> (Expr -> [String]) -> [Expr] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PGF -> [Option] -> Expr -> [String]
optLin PGF
pgf [Option]
opts) [Expr]
ts
   optLin :: PGF -> [Option] -> Expr -> [String]
optLin PGF
pgf [Option]
opts Expr
t =
     case [Option]
opts of
       [Option]
_ | String -> [Option] -> Bool
isOpt String
"treebank" [Option]
opts Bool -> Bool -> Bool
&& String -> [Option] -> Bool
isOpt String
"chunks" [Option]
opts ->
         (Language -> String
showCId (PGF -> Language
abstractName PGF
pgf) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Language] -> Expr -> String
showExpr [] Expr
t) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
         [Language -> String
showCId Language
lang String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
li | (Language
lang,String
li) <- PGF -> [Option] -> Expr -> [(Language, String)]
linChunks PGF
pgf [Option]
opts Expr
t] --linear pgf opts lang t | lang <- optLangs pgf opts]
       [Option]
_ | String -> [Option] -> Bool
isOpt String
"treebank" [Option]
opts ->
         (Language -> String
showCId (PGF -> Language
abstractName PGF
pgf) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Language] -> Expr -> String
showExpr [] Expr
t) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
         [Language -> String
showCId Language
lang String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s | Language
lang <- PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts, String
s<-PGF -> [Option] -> Language -> Expr -> [String]
linear PGF
pgf [Option]
opts Language
lang Expr
t]
       [Option]
_ | String -> [Option] -> Bool
isOpt String
"tabtreebank" [Option]
opts ->
         String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\t" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ([Language] -> Expr -> String
showExpr [] Expr
t) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                   [String
s | Language
lang <- PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts, String
s <- PGF -> [Option] -> Language -> Expr -> [String]
linear PGF
pgf [Option]
opts Language
lang Expr
t]
       [Option]
_ | String -> [Option] -> Bool
isOpt String
"chunks" [Option]
opts -> ((Language, String) -> String) -> [(Language, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Language, String) -> String
forall a b. (a, b) -> b
snd ([(Language, String)] -> [String])
-> [(Language, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ PGF -> [Option] -> Expr -> [(Language, String)]
linChunks PGF
pgf [Option]
opts Expr
t   
       [Option]
_ -> [String
s | Language
lang <- PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts, String
s<-PGF -> [Option] -> Language -> Expr -> [String]
linear PGF
pgf [Option]
opts Language
lang Expr
t]
   linChunks :: PGF -> [Option] -> Expr -> [(Language, String)]
linChunks PGF
pgf [Option]
opts Expr
t = 
     [(Language
lang, [String] -> String
unwords (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"<+>" ((Expr -> String) -> [Expr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unlines ([String] -> String) -> (Expr -> [String]) -> Expr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> [Option] -> Language -> Expr -> [String]
linear PGF
pgf [Option]
opts Language
lang) (Expr -> [Expr]
treeChunks Expr
t)))) | Language
lang <- PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts]

   linear :: PGF -> [Option] -> CId -> Expr -> [String]
   linear :: PGF -> [Option] -> Language -> Expr -> [String]
linear PGF
pgf [Option]
opts Language
lang = let unl :: String -> String
unl = [Option] -> Language -> String -> String
unlex [Option]
opts Language
lang in case [Option]
opts of
       [Option]
_ | String -> [Option] -> Bool
isOpt String
"all"     [Option]
opts -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> (Expr -> [[String]]) -> Expr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. -- intersperse [[]] .
                                   ([(String, String)] -> [String])
-> [[(String, String)]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
unl (String -> String)
-> ((String, String) -> String) -> (String, String) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd)) ([[(String, String)]] -> [[String]])
-> (Expr -> [[(String, String)]]) -> Expr -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Language -> Expr -> [[(String, String)]]
tabularLinearizes PGF
pgf Language
lang
       [Option]
_ | String -> [Option] -> Bool
isOpt String
"list"    [Option]
opts -> (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> (Expr -> String) -> Expr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
commaList ([String] -> String) -> (Expr -> [String]) -> Expr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> (Expr -> [[String]]) -> Expr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   ([(String, String)] -> [String])
-> [[(String, String)]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
unl (String -> String)
-> ((String, String) -> String) -> (String, String) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd)) ([[(String, String)]] -> [[String]])
-> (Expr -> [[(String, String)]]) -> Expr -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Language -> Expr -> [[(String, String)]]
tabularLinearizes PGF
pgf Language
lang
       [Option]
_ | String -> [Option] -> Bool
isOpt String
"table"   [Option]
opts -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> (Expr -> [[String]]) -> Expr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. -- intersperse [[]] .
                    ([(String, String)] -> [String])
-> [[(String, String)]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
p,String
v) -> String
pString -> String -> String
+++String
":"String -> String -> String
+++String -> String
unl String
v)) ([[(String, String)]] -> [[String]])
-> (Expr -> [[(String, String)]]) -> Expr -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Language -> Expr -> [[(String, String)]]
tabularLinearizes PGF
pgf Language
lang
       [Option]
_ | String -> [Option] -> Bool
isOpt String
"bracket" [Option]
opts -> (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> (Expr -> String) -> Expr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> (Expr -> [String]) -> Expr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BracketedString -> String) -> [BracketedString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map BracketedString -> String
showBracketedString ([BracketedString] -> [String])
-> (Expr -> [BracketedString]) -> Expr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Language -> Expr -> [BracketedString]
bracketedLinearize PGF
pgf Language
lang
       [Option]
_                        -> (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> (Expr -> String) -> Expr -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
unl (String -> String) -> (Expr -> String) -> Expr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PGF -> Language -> Expr -> String
linearize PGF
pgf Language
lang

   -- replace each non-atomic constructor with mkC, where C is the val cat
   tree2mk :: PGF -> Expr -> String
tree2mk PGF
pgf = [Language] -> Expr -> String
showExpr [] (Expr -> String) -> (Expr -> Expr) -> Expr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
t2m where
     t2m :: Expr -> Expr
t2m Expr
t = case Expr -> Maybe (Language, [Expr])
unApp Expr
t of
       Just (Language
cid,ts :: [Expr]
ts@(Expr
_:[Expr]
_)) -> Language -> [Expr] -> Expr
mkApp (Language -> Language
mk Language
cid) ((Expr -> Expr) -> [Expr] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
t2m [Expr]
ts)
       Maybe (Language, [Expr])
_ -> Expr
t
     mk :: Language -> Language
mk = String -> Language
mkCId (String -> Language)
-> (Language -> String) -> Language -> Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"mk" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Language -> String) -> Language -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> String
showCId (Language -> String)
-> (Language -> Language) -> Language -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Abstr -> Language -> Language
lookValCat (PGF -> Abstr
abstract PGF
pgf)

   unlex :: [Option] -> Language -> String -> String
unlex [Option]
opts Language
lang = Maybe (String, String) -> [String] -> String -> String
stringOps Maybe (String, String)
forall a. Maybe a
Nothing ([Option] -> Language -> [String]
getUnlex [Option]
opts Language
lang [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Option -> String
prOpt [Option]
opts) ----

   getUnlex :: [Option] -> Language -> [String]
getUnlex [Option]
opts Language
lang = case String -> [String]
words (String -> String -> [Option] -> String
valStrOpts String
"unlexer" String
"" [Option]
opts) of
     [String]
lexs -> case Language -> [(Language, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Language
lang
               [(String -> Language
mkCId String
la,String -> String
forall a. [a] -> [a]
tail String
le) | String
lex <- [String]
lexs, let (String
la,String
le) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'=') String
lex, Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
le)] of
       Just String
le -> Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
chunks Char
',' String
le
       Maybe String
_ -> []

   commaList :: [String] -> String
commaList [] = []
   commaList [String]
ws = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
ws String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]
forall a. [a] -> [a]
tail [String]
ws)

-- Proposed logic of coding in unlexing:
--   - If lang has no coding flag, or -to_utf8 is not in opts, just opts are used.
--   - If lang has flag coding=utf8, -to_utf8 is ignored.
--   - If lang has coding=other, and -to_utf8 is in opts, from_other is applied first.
-- THIS DOES NOT WORK UNFORTUNATELY - can't use the grammar flag properly
{-
   unlexx pgf opts lang = {- trace (unwords optsC) $ -} stringOps Nothing optsC where ----
     optsC = case lookConcrFlag pgf (mkCId lang) (mkCId "coding") of
       Just (LStr "utf8") -> filter (/="to_utf8") $ map prOpt opts
       Just (LStr other) | isOpt "to_utf8" opts ->
                      let cod = ("from_" ++ other)
                      in cod : filter (/=cod) (map prOpt opts)
       _ -> map prOpt opts
-}
   optRestricted :: [Option] -> PGF -> PGF
optRestricted [Option]
opts PGF
pgf =
     (Language -> Bool) -> PGF -> PGF
restrictPGF (\Language
f -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [PGF -> Language -> Language -> Bool
hasLin PGF
pgf Language
la Language
f | Language
la <- PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts]) PGF
pgf

   optLang :: PGF -> [Option] -> Language
optLang  = String -> PGF -> [Option] -> Language
optLangFlag String
"lang"
   optLangs :: PGF -> [Option] -> [Language]
optLangs = String -> PGF -> [Option] -> [Language]
optLangsFlag String
"lang"

   optLangsFlag :: String -> PGF -> [Option] -> [Language]
optLangsFlag String
f PGF
pgf [Option]
opts = case String -> String -> [Option] -> String
valStrOpts String
f String
"" [Option]
opts of
     String
"" -> PGF -> [Language]
languages PGF
pgf
     String
lang -> (String -> Language) -> [String] -> [Language]
forall a b. (a -> b) -> [a] -> [b]
map (PGF -> String -> Language
completeLang PGF
pgf) (Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
chunks Char
',' String
lang)
   completeLang :: PGF -> String -> Language
completeLang PGF
pgf String
la = let cla :: Language
cla = (String -> Language
mkCId String
la) in
     if Language -> [Language] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Language
cla (PGF -> [Language]
languages PGF
pgf)
       then Language
cla
       else (String -> Language
mkCId (Language -> String
showCId (PGF -> Language
abstractName PGF
pgf) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
la))

   optLangFlag :: String -> PGF -> [Option] -> Language
optLangFlag String
f PGF
pgf [Option]
opts = [Language] -> Language
forall a. [a] -> a
head ([Language] -> Language) -> [Language] -> Language
forall a b. (a -> b) -> a -> b
$ String -> PGF -> [Option] -> [Language]
optLangsFlag String
f PGF
pgf [Option]
opts [Language] -> [Language] -> [Language]
forall a. [a] -> [a] -> [a]
++ [Language
wildCId]

   optOpenTypes :: [Option] -> [Type]
optOpenTypes [Option]
opts = case String -> String -> [Option] -> String
valStrOpts String
"openclass" String
"" [Option]
opts of
     String
""   -> []
     String
cats -> (String -> Maybe Type) -> [String] -> [Type]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Type
readType (Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
chunks Char
',' String
cats)

   optProbs :: [Option] -> PGF -> SIO PGF
optProbs [Option]
opts PGF
pgf = case String -> String -> [Option] -> String
valStrOpts String
"probs" String
"" [Option]
opts of
     String
""   -> PGF -> SIO PGF
forall (m :: * -> *) a. Monad m => a -> m a
return PGF
pgf
     String
file -> do
       Probabilities
probs <- IO Probabilities -> SIO Probabilities
forall a. IO a -> SIO a
restricted (IO Probabilities -> SIO Probabilities)
-> IO Probabilities -> SIO Probabilities
forall a b. (a -> b) -> a -> b
$ String -> PGF -> IO Probabilities
readProbabilitiesFromFile String
file PGF
pgf
       PGF -> SIO PGF
forall (m :: * -> *) a. Monad m => a -> m a
return (Probabilities -> PGF -> PGF
setProbabilities Probabilities
probs PGF
pgf)

   optFile :: [Option] -> String
optFile [Option]
opts = String -> String -> [Option] -> String
valStrOpts String
"file" String
"_gftmp" [Option]
opts

   optType :: PGF -> [Option] -> Type
optType PGF
pgf [Option]
opts =
     let str :: String
str = String -> String -> [Option] -> String
valStrOpts String
"cat" (Language -> String
showCId (Language -> String) -> Language -> String
forall a b. (a -> b) -> a -> b
$ PGF -> Language
lookStartCat PGF
pgf) [Option]
opts
     in case String -> Maybe Type
readType String
str of
          Just Type
ty -> case PGF -> Type -> Either TcError Type
checkType PGF
pgf Type
ty of
                       Left TcError
tcErr -> String -> Type
forall a. HasCallStack => String -> a
error (String -> Type) -> String -> Type
forall a b. (a -> b) -> a -> b
$ Doc -> String
forall a. Pretty a => a -> String
render (TcError -> Doc
ppTcError TcError
tcErr)
                       Right Type
ty   -> Type
ty
          Maybe Type
Nothing -> String -> Type
forall a. HasCallStack => String -> a
error (String
"Can't parse '"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
strString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"' as a type")
   optViewFormat :: [Option] -> String
optViewFormat [Option]
opts = String -> String -> [Option] -> String
valStrOpts String
"format" String
"png" [Option]
opts
   optViewGraph :: [Option] -> String
optViewGraph [Option]
opts = String -> String -> [Option] -> String
valStrOpts String
"view" String
"open" [Option]
opts
   optNum :: [Option] -> Int
optNum [Option]
opts = String -> Int -> [Option] -> Int
valIntOpts String
"number" Int
1 [Option]
opts
   optNumInf :: [Option] -> Int
optNumInf [Option]
opts = String -> Int -> [Option] -> Int
valIntOpts String
"number" Int
1000000000 [Option]
opts ---- 10^9
   takeOptNum :: [Option] -> [a] -> [a]
takeOptNum [Option]
opts = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([Option] -> Int
optNumInf [Option]
opts)

   returnFromExprs :: [Expr] -> m CommandOutput
returnFromExprs [Expr]
es = CommandOutput -> m CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> m CommandOutput)
-> CommandOutput -> m CommandOutput
forall a b. (a -> b) -> a -> b
$ case [Expr]
es of
     [] -> String -> CommandOutput
pipeMessage String
"no trees found"
     [Expr]
_  -> [Expr] -> CommandOutput
fromExprs [Expr]
es

   prGrammar :: PGFEnv -> [Option] -> SIO CommandOutput
prGrammar (Env PGF
pgf Map Language Morpho
mos) [Option]
opts
     | String -> [Option] -> Bool
isOpt String
"pgf"      [Option]
opts = do
          let pgf1 :: PGF
pgf1 = if String -> [Option] -> Bool
isOpt String
"opt" [Option]
opts then PGF -> PGF
optimizePGF PGF
pgf else PGF
pgf
          let outfile :: String
outfile = String -> String -> [Option] -> String
valStrOpts String
"file" (Language -> String
showCId (PGF -> Language
abstractName PGF
pgf) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".pgf") [Option]
opts
          IO () -> SIO ()
forall a. IO a -> SIO a
restricted (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ String -> PGF -> IO ()
forall a. Binary a => String -> a -> IO ()
encodeFile String
outfile PGF
pgf1
          String -> SIO ()
putStrLn (String -> SIO ()) -> String -> SIO ()
forall a b. (a -> b) -> a -> b
$ String
"wrote file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outfile
          CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void
     | String -> [Option] -> Bool
isOpt String
"cats"     [Option]
opts = CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Language -> String) -> [Language] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Language -> String
showCId ([Language] -> [String]) -> [Language] -> [String]
forall a b. (a -> b) -> a -> b
$ PGF -> [Language]
categories PGF
pgf
     | String -> [Option] -> Bool
isOpt String
"funs"     [Option]
opts = CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Language, Type) -> String) -> [(Language, Type)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Language, Type) -> String
showFun ([(Language, Type)] -> [String]) -> [(Language, Type)] -> [String]
forall a b. (a -> b) -> a -> b
$ PGF -> [(Language, Type)]
funsigs PGF
pgf
     | String -> [Option] -> Bool
isOpt String
"fullform" [Option]
opts = CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ (Language -> String) -> [Language] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Map Language Morpho
-> String -> (Morpho -> String) -> Language -> String
forall k a b. Ord k => Map k a -> b -> (a -> b) -> k -> b
morpho Map Language Morpho
mos String
"" Morpho -> String
prFullFormLexicon) ([Language] -> String) -> [Language] -> String
forall a b. (a -> b) -> a -> b
$ PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts
     | String -> [Option] -> Bool
isOpt String
"langs"    [Option]
opts = CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Language -> String) -> [Language] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Language -> String
showCId ([Language] -> [String]) -> [Language] -> [String]
forall a b. (a -> b) -> a -> b
$ PGF -> [Language]
languages PGF
pgf

     | String -> [Option] -> Bool
isOpt String
"lexc"     [Option]
opts = CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ (Language -> String) -> [Language] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Map Language Morpho
-> String -> (Morpho -> String) -> Language -> String
forall k a b. Ord k => Map k a -> b -> (a -> b) -> k -> b
morpho Map Language Morpho
mos String
"" Morpho -> String
prLexcLexicon) ([Language] -> String) -> [Language] -> String
forall a b. (a -> b) -> a -> b
$ PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts
     | String -> [Option] -> Bool
isOpt String
"missing"  [Option]
opts = CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String] -> String
unwords (Language -> String
showCId Language
laString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
":"String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Language -> String) -> [Language] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Language -> String
showCId [Language]
cs) |
                                                                  Language
la <- PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts, let cs :: [Language]
cs = PGF -> Language -> [Language]
missingLins PGF
pgf Language
la]
     | String -> [Option] -> Bool
isOpt String
"words" [Option]
opts = CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ (Language -> String) -> [Language] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Map Language Morpho
-> String -> (Morpho -> String) -> Language -> String
forall k a b. Ord k => Map k a -> b -> (a -> b) -> k -> b
morpho Map Language Morpho
mos String
"" Morpho -> String
prAllWords) ([Language] -> String) -> [Language] -> String
forall a b. (a -> b) -> a -> b
$ PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts
     | Bool
otherwise             = do OutputFormat
fmt <- String -> SIO OutputFormat
forall (m :: * -> *). MonadFail m => String -> m OutputFormat
readOutputFormat (String -> String -> [Option] -> String
valStrOpts String
"printer" String
"pgf_pretty" [Option]
opts)
                                  CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOutput -> SIO CommandOutput)
-> CommandOutput -> SIO CommandOutput
forall a b. (a -> b) -> a -> b
$ String -> CommandOutput
fromString (String -> CommandOutput) -> String -> CommandOutput
forall a b. (a -> b) -> a -> b
$ ((String, String) -> String) -> [(String, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> String
forall a b. (a, b) -> b
snd ([(String, String)] -> String) -> [(String, String)] -> String
forall a b. (a -> b) -> a -> b
$ Options -> OutputFormat -> PGF -> [(String, String)]
exportPGF Options
noOptions OutputFormat
fmt PGF
pgf

   funsigs :: PGF -> [(Language, Type)]
funsigs PGF
pgf = [(Language
f,Type
ty) | (Language
f,(Type
ty,Int
_,Maybe ([Equation], [[Instr]])
_,Double
_)) <- Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
-> [(Language, (Type, Int, Maybe ([Equation], [[Instr]]), Double))]
forall k a. Map k a -> [(k, a)]
Map.assocs (Abstr
-> Map Language (Type, Int, Maybe ([Equation], [[Instr]]), Double)
funs (PGF -> Abstr
abstract PGF
pgf))]
   showFun :: (Language, Type) -> String
showFun (Language
f,Type
ty) = Language -> String
showCId Language
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Language] -> Type -> String
showType [] Type
ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ;"

   morphos :: PGFEnv -> [Option] -> String -> [(String, [(Language, String)])]
morphos (Env PGF
pgf Map Language Morpho
mos) [Option]
opts String
s =
     [(String
s,Map Language Morpho
-> [(Language, String)]
-> (Morpho -> [(Language, String)])
-> Language
-> [(Language, String)]
forall k a b. Ord k => Map k a -> b -> (a -> b) -> k -> b
morpho Map Language Morpho
mos [] (\Morpho
mo -> Morpho -> String -> [(Language, String)]
lookupMorpho Morpho
mo String
s) Language
la) | Language
la <- PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts]

   morpho :: Map k a -> b -> (a -> b) -> k -> b
morpho Map k a
mos b
z a -> b
f k
la = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
z a -> b
f (Maybe a -> b) -> Maybe a -> b
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
la Map k a
mos

   optMorpho :: PGFEnv -> [Option] -> Morpho
optMorpho (Env PGF
pgf Map Language Morpho
mos) [Option]
opts = Map Language Morpho
-> Morpho -> (Morpho -> Morpho) -> Language -> Morpho
forall k a b. Ord k => Map k a -> b -> (a -> b) -> k -> b
morpho Map Language Morpho
mos (String -> Morpho
forall a. HasCallStack => String -> a
error String
"no morpho") Morpho -> Morpho
forall a. a -> a
id ([Language] -> Language
forall a. [a] -> a
head (PGF -> [Option] -> [Language]
optLangs PGF
pgf [Option]
opts))

   optClitics :: [Option] -> [String]
optClitics [Option]
opts = case String -> String -> [Option] -> String
valStrOpts String
"clitics" String
"" [Option]
opts of
     String
"" -> []
     String
cs -> (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
chunks Char
',' String
cs

   mexp :: [a] -> Maybe a
mexp [a]
xs = case [a]
xs of
     a
t:[a]
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
t
     [a]
_   -> Maybe a
forall a. Maybe a
Nothing

   -- ps -f -g s returns g (f s)
   treeOps :: PGF -> [Option] -> [Expr] -> [Expr]
treeOps PGF
pgf [Option]
opts [Expr]
s = (Option -> [Expr] -> [Expr]) -> [Expr] -> [Option] -> [Expr]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Option -> [Expr] -> [Expr]
app [Expr]
s ([Option] -> [Option]
forall a. [a] -> [a]
reverse [Option]
opts) where
     app :: Option -> [Expr] -> [Expr]
app (OOpt  String
op)         | Just (Left  [Expr] -> [Expr]
f) <- PGF
-> String
-> Maybe (Either ([Expr] -> [Expr]) (Language -> [Expr] -> [Expr]))
treeOp PGF
pgf String
op = [Expr] -> [Expr]
f
     app (OFlag String
op (VId String
x)) | Just (Right Language -> [Expr] -> [Expr]
f) <- PGF
-> String
-> Maybe (Either ([Expr] -> [Expr]) (Language -> [Expr] -> [Expr]))
treeOp PGF
pgf String
op = Language -> [Expr] -> [Expr]
f (String -> Language
mkCId String
x)
     app Option
_                                                    = [Expr] -> [Expr]
forall a. a -> a
id

treeOpOptions :: PGF -> [(String, String)]
treeOpOptions PGF
pgf = [(String
op,String
expl) | (String
op,(String
expl,Left  [Expr] -> [Expr]
_)) <- PGF
-> [(String,
     (String,
      Either ([Expr] -> [Expr]) (Language -> [Expr] -> [Expr])))]
allTreeOps PGF
pgf]
treeOpFlags :: PGF -> [(String, String)]
treeOpFlags   PGF
pgf = [(String
op,String
expl) | (String
op,(String
expl,Right Language -> [Expr] -> [Expr]
_)) <- PGF
-> [(String,
     (String,
      Either ([Expr] -> [Expr]) (Language -> [Expr] -> [Expr])))]
allTreeOps PGF
pgf]

translationQuiz :: Maybe Expr -> PGF -> Language -> Language -> Type -> IO ()
translationQuiz :: Maybe Expr -> PGF -> Language -> Language -> Type -> IO ()
translationQuiz Maybe Expr
mex PGF
pgf Language
ig Language
og Type
typ = do
  [(String, [String])]
tts <- Maybe Expr
-> PGF
-> Language
-> Language
-> Type
-> Int
-> IO [(String, [String])]
translationList Maybe Expr
mex PGF
pgf Language
ig Language
og Type
typ Int
infinity
  String -> [(String, [String])] -> IO ()
mkQuiz String
"Welcome to GF Translation Quiz." [(String, [String])]
tts

morphologyQuiz :: Maybe Expr -> PGF -> Language -> Type -> IO ()
morphologyQuiz :: Maybe Expr -> PGF -> Language -> Type -> IO ()
morphologyQuiz Maybe Expr
mex PGF
pgf Language
ig Type
typ = do
  [(String, [String])]
tts <- Maybe Expr
-> PGF -> Language -> Type -> Int -> IO [(String, [String])]
morphologyList Maybe Expr
mex PGF
pgf Language
ig Type
typ Int
infinity
  String -> [(String, [String])] -> IO ()
mkQuiz String
"Welcome to GF Morphology Quiz." [(String, [String])]
tts

-- | the maximal number of precompiled quiz problems
infinity :: Int
infinity :: Int
infinity = Int
256

prLexcLexicon :: Morpho -> String
prLexcLexicon :: Morpho -> String
prLexcLexicon Morpho
mo =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"Multichar_Symbols"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
multicharsString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
""String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
"LEXICON Root" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [Language -> String -> String
prLexc Language
l String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" # ;" | (String
w,[(Language, String)]
lps) <- [(String, [(Language, String)])]
morpho, (Language
l,String
p) <- [(Language, String)]
lps] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"END"]
 where
  morpho :: [(String, [(Language, String)])]
morpho = Morpho -> [(String, [(Language, String)])]
fullFormLexicon Morpho
mo
  prLexc :: Language -> String -> String
prLexc Language
l String
p = Language -> String
showCId Language
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> [String]
mkTags (String -> [String]
words String
p))
  mkTags :: [String] -> [String]
mkTags [String]
p = case [String]
p of
    String
"s":[String]
ws -> [String] -> [String]
mkTags [String]
ws   --- remove record field
    [String]
ws -> (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char
'+'Char -> String -> String
forall a. a -> [a] -> [a]
:) [String]
ws

  multichars :: String
multichars = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String] -> [String]
mkTags (String -> [String]
words String
p) | (String
w,[(Language, String)]
lps) <- [(String, [(Language, String)])]
morpho, (Language
l,String
p) <- [(Language, String)]
lps]
  -- thick_A+(AAdj+Posit+Gen):thick's # ;

prFullFormLexicon :: Morpho -> String
prFullFormLexicon :: Morpho -> String
prFullFormLexicon Morpho
mo =
  [String] -> String
unlines (((String, [(Language, String)]) -> String)
-> [(String, [(Language, String)])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [(Language, String)]) -> String
prMorphoAnalysis (Morpho -> [(String, [(Language, String)])]
fullFormLexicon Morpho
mo))

prAllWords :: Morpho -> String
prAllWords :: Morpho -> String
prAllWords Morpho
mo =
  [String] -> String
unwords [String
w | (String
w,[(Language, String)]
_) <- Morpho -> [(String, [(Language, String)])]
fullFormLexicon Morpho
mo]

prMorphoAnalysis :: (String,[(Lemma,Analysis)]) -> String
prMorphoAnalysis :: (String, [(Language, String)]) -> String
prMorphoAnalysis (String
w,[(Language, String)]
lps) =
  [String] -> String
unlines (String
wString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[Language -> String
showCId Language
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p | (Language
l,String
p) <- [(Language, String)]
lps])

viewGraphviz :: String -> String -> String -> [String] -> SIO CommandOutput
viewGraphviz :: String -> String -> String -> [String] -> SIO CommandOutput
viewGraphviz String
view String
format String
name [String]
grphs = do
           let file :: String -> String -> String
file String
i String
s = String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
           ((String, Integer) -> SIO ()) -> [(String, Integer)] -> SIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (String
grph,Integer
i) -> IO () -> SIO ()
forall a. IO a -> SIO a
restricted (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeUTF8File (String -> String -> String
file (Integer -> String
forall a. Show a => a -> String
show Integer
i) String
"dot") String
grph) ([String] -> [Integer] -> [(String, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
grphs [Integer
1..])
           (Int -> SIO ExitCode) -> [Int] -> SIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> String -> SIO ExitCode
restrictedSystem (String -> SIO ExitCode) -> String -> SIO ExitCode
forall a b. (a -> b) -> a -> b
$ String
"dot -T" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
format String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
file (Int -> String
forall a. Show a => a -> String
show Int
i) String
"dot" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" > " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
file (Int -> String
forall a. Show a => a -> String
show Int
i) String
format) [Int
1..[String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
grphs]
           if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
grphs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
             then do
               let files :: String
files = [String] -> String
unwords [String -> String -> String
file (Int -> String
forall a. Show a => a -> String
show Int
i) String
format | Int
i <- [Int
1..[String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
grphs]]
               String -> SIO ExitCode
restrictedSystem (String -> SIO ExitCode) -> String -> SIO ExitCode
forall a b. (a -> b) -> a -> b
$ String
"convert " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
files String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
file String
"all" String
"pdf"
               String -> SIO ExitCode
restrictedSystem (String -> SIO ExitCode) -> String -> SIO ExitCode
forall a b. (a -> b) -> a -> b
$ String
view String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
file String
"all" String
"pdf"
             else String -> SIO ExitCode
restrictedSystem (String -> SIO ExitCode) -> String -> SIO ExitCode
forall a b. (a -> b) -> a -> b
$ String
view String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
file String
"1" String
format
---           restrictedSystem $ "rm " ++ file "*" format  --- removing temporary files
---           restrictedSystem $ "rm " ++ file "*" "dot"
---           restrictedSystem $ "rm " ++ file "all" "pdf"
           CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void

viewLatex :: String -> String -> [String] -> SIO CommandOutput
viewLatex :: String -> String -> [String] -> SIO CommandOutput
viewLatex String
view String
name [String]
grphs = do
  let texfile :: String
texfile = String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".tex"
  let pdffile :: String
pdffile = String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".pdf"
  IO () -> SIO ()
forall a. IO a -> SIO a
restricted (IO () -> SIO ()) -> IO () -> SIO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeUTF8File String
texfile ([String] -> String
latexDoc [String]
grphs)
  String -> SIO ExitCode
restrictedSystem (String -> SIO ExitCode) -> String -> SIO ExitCode
forall a b. (a -> b) -> a -> b
$ String
"pdflatex " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
texfile
  String -> SIO ExitCode
restrictedSystem (String -> SIO ExitCode) -> String -> SIO ExitCode
forall a b. (a -> b) -> a -> b
$ String
view String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pdffile
  CommandOutput -> SIO CommandOutput
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOutput
void
  
---- copied from VisualizeTree ; not sure about proper place AR Nov 2015
latexDoc :: [String] -> String
latexDoc :: [String] -> String
latexDoc [String]
body = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    String
"\\batchmode"
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"\\documentclass{article}"
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"\\usepackage[utf8]{inputenc}"  
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"\\begin{document}"
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
spaces [String]
body
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"\\end{document}"]
 where
   spaces :: [String] -> [String]
spaces = String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\\vspace{6mm}"
   ---- also reduce the size for long sentences

stanzas :: String -> [String]
stanzas :: String -> [String]
stanzas = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unlines ([[String]] -> [String])
-> (String -> [[String]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]]
chop ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines where
  chop :: [String] -> [[String]]
chop [String]
ls = case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"") [String]
ls of
    ([String]
ls1,[])  -> [[String]
ls1]
    ([String]
ls1,String
_:[String]
ls2) -> [String]
ls1 [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: [String] -> [[String]]
chop [String]
ls2

#if !(MIN_VERSION_base(4,9,0))
errorWithoutStackTrace = error
#endif