From 1037b209ae225d5de604ff832d915c590ced4c38 Mon Sep 17 00:00:00 2001 From: Inari Listenmaa Date: Mon, 9 Sep 2024 19:38:27 +0200 Subject: add whitespace on list comprehensions, applications etc. text editor interprets these things as errors (e.g. unterminated qq for list comprehension) and underlines red, even though there is no real error. --- src/server/PGFService.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/server') diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index 260c2e278..bcf3d32f2 100644 --- a/src/server/PGFService.hs +++ b/src/server/PGFService.hs @@ -448,7 +448,7 @@ pgfMain lcs@(alc,clc) path command tpgf@(t,pgf) = "linearizeTable" -> o =<< doLinearizeTabular pgf # tree % to "random" -> o =<< join (doRandom pgf # cat % depth % limit % to) "generate" -> o =<< doGenerate pgf # cat % depth % limit % to - "translate" -> o =<< doTranslate pgf # input % cat %to%limit%treeopts + "translate" -> o =<< doTranslate pgf # input % cat % to % limit % treeopts "translategroup" -> o =<< doTranslateGroup pgf # input % cat % to % limit "lookupmorpho" -> o =<< doLookupMorpho pgf # from1 % textInput "grammar" -> join $ doGrammar tpgf @@ -1092,7 +1092,7 @@ linearizeTabular pgf (tos,unlex) tree = [(to,lintab to (transfer to tree)) | to <- langs] where langs = if null tos then PGF.languages pgf else tos - lintab to t = [(p,map unlex (nub [t|(p',t)<-vs,p'==p]))|p<-ps] + lintab to t = [(p,map unlex (nub [t | (p',t)<-vs,p'==p])) | p<-ps] where ps = nub (map fst vs) vs = concat (PGF.tabularLinearizes pgf to t) -- cgit v1.2.3 From bbf12458c7c4b783897851f7e0bddea54f2d984e Mon Sep 17 00:00:00 2001 From: Inari Listenmaa Date: Mon, 9 Sep 2024 19:44:49 +0200 Subject: use openFd from unix >= 2.8 --- gf.cabal | 2 +- src/server/CGIUtils.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'src/server') diff --git a/gf.cabal b/gf.cabal index 21093ae0b..a0b0c01dd 100644 --- a/gf.cabal +++ b/gf.cabal @@ -347,7 +347,7 @@ library else build-depends: terminfo >=0.4.0 && < 0.5, - unix >= 2.7.2 && < 2.8 + unix >= 2.8 if impl(ghc>=8.2) ghc-options: -fhide-source-paths diff --git a/src/server/CGIUtils.hs b/src/server/CGIUtils.hs index 3c5ce2274..b593a2b07 100644 --- a/src/server/CGIUtils.hs +++ b/src/server/CGIUtils.hs @@ -34,8 +34,8 @@ stderrToFile :: FilePath -> IO () stderrToFile file = do let mode = ownerReadMode<>ownerWriteMode<>groupReadMode<>otherReadMode (<>) = unionFileModes - flags = defaultFileFlags { append = True } - fileFd <- openFd file WriteOnly (Just mode) flags + flags = defaultFileFlags { append = True, creat = Just mode } + fileFd <- openFd file WriteOnly flags dupTo fileFd stdError return () #else -- cgit v1.2.3 From 155b9da861fc95e55ec3352e7beb45eba5f41812 Mon Sep 17 00:00:00 2001 From: Inari Listenmaa Date: Thu, 20 Mar 2025 17:54:41 +0100 Subject: choose openFd based on version of unix --- src/server/CGIUtils.hs | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'src/server') diff --git a/src/server/CGIUtils.hs b/src/server/CGIUtils.hs index b593a2b07..0a04c3a6f 100644 --- a/src/server/CGIUtils.hs +++ b/src/server/CGIUtils.hs @@ -34,8 +34,13 @@ stderrToFile :: FilePath -> IO () stderrToFile file = do let mode = ownerReadMode<>ownerWriteMode<>groupReadMode<>otherReadMode (<>) = unionFileModes +#if MIN_VERSION_unix(2,8,0) flags = defaultFileFlags { append = True, creat = Just mode } fileFd <- openFd file WriteOnly flags +#else + flags = defaultFileFlags { append = True } + fileFd <- openFd file WriteOnly (Just mode) flags +#endif dupTo fileFd stdError return () #else -- cgit v1.2.3 From 3e0c0fa463f9a58084439cf52c334c1577ebc808 Mon Sep 17 00:00:00 2001 From: Inari Listenmaa Date: Sat, 2 Aug 2025 21:46:13 +0200 Subject: define default depths for shell and server only once --- src/compiler/GF/Command/Commands.hs | 44 ++++++++++++++++--------------- src/compiler/GF/Command/CommonCommands.hs | 6 +++++ src/server/PGFService.hs | 6 +++-- 3 files changed, 33 insertions(+), 23 deletions(-) (limited to 'src/server') diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 7f27e8a45..876449136 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -22,6 +22,7 @@ import GF.Infra.SIO import GF.Command.Abstract import GF.Command.CommandInfo import GF.Command.CommonCommands +import qualified GF.Command.CommonCommands as Common import GF.Text.Clitics import GF.Quiz @@ -166,14 +167,15 @@ pgfCommands = Map.fromList [ synopsis = "generate random trees in the current abstract syntax", syntax = "gr [-cat=CAT] [-number=INT]", examples = [ - mkEx "gr -- one tree in the startcat of the current grammar", - mkEx "gr -cat=NP -number=16 -- 16 trees in the category NP", - mkEx "gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha", - mkEx "gr -probs=FILE -- generate with bias", - mkEx "gr (AdjCN ? (UseN ?)) -- generate trees of form (AdjCN ? (UseN ?))" + mkEx $ "gr -- one tree in the startcat of the current grammar, up to depth " ++ Common.default_depth_str, + mkEx "gr -cat=NP -number=16 -- 16 trees in the category NP", + mkEx "gr -cat=NP -depth=2 -- one tree in the category NP, up to depth 2", + mkEx "gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha", + mkEx "gr -probs=FILE -- generate with bias", + mkEx "gr (AdjCN ? (UseN ?)) -- generate trees of form (AdjCN ? (UseN ?))" ], explanation = unlines [ - "Generates a list of random trees, by default one tree.", + "Generates a list of random trees, by default one tree up to depth " ++ Common.default_depth_str ++ ".", "If a tree argument is given, the command completes the Tree with values to", "all metavariables in the tree. The generation can be biased by probabilities,", "given in a file in the -probs flag." @@ -182,13 +184,13 @@ pgfCommands = Map.fromList [ ("cat","generation category"), ("lang","uses only functions that have linearizations in all these languages"), ("number","number of trees generated"), - ("depth","the maximum generation depth"), + ("depth","the maximum generation depth (default: " ++ Common.default_depth_str ++ ")"), ("probs", "file with biased probabilities (format 'f 0.4' one by line)") ], exec = getEnv $ \ opts arg (Env pgf mos) -> do pgf <- optProbs opts (optRestricted opts pgf) gen <- newStdGen - let dp = valIntOpts "depth" 4 opts + let dp = valIntOpts "depth" Common.default_depth opts let ts = case mexp (toExprs arg) of Just ex -> generateRandomFromDepth gen pgf ex (Just dp) Nothing -> generateRandomDepth gen pgf (optType pgf opts) (Just dp) @@ -199,25 +201,25 @@ pgfCommands = Map.fromList [ synopsis = "generates a list of trees, by default exhaustive", explanation = unlines [ "Generates all trees of a given category. By default, ", - "the depth is limited to 4, but this can be changed by a flag.", + "the depth is limited to " ++ Common.default_depth_str ++ ", but this can be changed by a flag.", "If a Tree argument is given, the command completes the Tree with values", "to all metavariables in the tree." ], flags = [ ("cat","the generation category"), - ("depth","the maximum generation depth"), + ("depth","the maximum generation depth (default: " ++ Common.default_depth_str ++ ")"), ("lang","excludes functions that have no linearization in this language"), ("number","the number of trees generated") ], examples = [ - mkEx "gt -- all trees in the startcat, to depth 4", - mkEx "gt -cat=NP -number=16 -- 16 trees in the category NP", - mkEx "gt -cat=NP -depth=2 -- trees in the category NP to depth 2", - mkEx "gt (AdjCN ? (UseN ?)) -- trees of form (AdjCN ? (UseN ?))" + mkEx $ "gt -- all trees in the startcat, to depth " ++ Common.default_depth_str, + mkEx "gt -cat=NP -number=16 -- 16 trees in the category NP", + mkEx "gt -cat=NP -depth=2 -- trees in the category NP to depth 2", + mkEx "gt (AdjCN ? (UseN ?)) -- trees of form (AdjCN ? (UseN ?))" ], exec = getEnv $ \ opts arg (Env pgf mos) -> do let pgfr = optRestricted opts pgf - let dp = valIntOpts "depth" 4 opts + let dp = valIntOpts "depth" Common.default_depth opts let ts = case toExprs arg of [] -> generateAllDepth pgfr (optType pgf opts) (Just dp) es -> concat [generateFromDepth pgfr e (Just dp) | e <- es] @@ -547,7 +549,7 @@ pgfCommands = Map.fromList [ "which is processed by dot (graphviz) and displayed by the program indicated", "by the view flag. The target format is png, unless overridden by the", "flag -format. Results from multiple trees are combined to pdf with convert (ImageMagick).", - "See also 'vp -showdep' for another visualization of dependencies." + "See also 'vp -showdep' for another visualization of dependencies." ], exec = getEnv $ \ opts arg (Env pgf mos) -> do let absname = abstractName pgf @@ -760,7 +762,7 @@ pgfCommands = Map.fromList [ [] -> [parse_ pgf lang (optType pgf opts) (Just dp) s | lang <- optLangs pgf opts] open_typs -> [parseWithRecovery pgf lang (optType pgf opts) open_typs (Just dp) s | lang <- optLangs pgf opts] where - dp = valIntOpts "depth" 4 opts + dp = valIntOpts "depth" Common.default_depth opts fromParse opts = foldr (joinPiped . fromParse1 opts) void @@ -800,9 +802,9 @@ pgfCommands = Map.fromList [ _ | isOpt "tabtreebank" opts -> return $ concat $ intersperse "\t" $ (showExpr [] t) : [s | lang <- optLangs pgf opts, s <- linear pgf opts lang t] - _ | isOpt "chunks" opts -> map snd $ linChunks pgf opts t + _ | isOpt "chunks" opts -> map snd $ linChunks pgf opts t _ -> [s | lang <- optLangs pgf opts, s<-linear pgf opts lang t] - linChunks pgf opts t = + linChunks pgf opts t = [(lang, unwords (intersperse "<+>" (map (unlines . linear pgf opts lang) (treeChunks t)))) | lang <- optLangs pgf opts] linear :: PGF -> [Option] -> CId -> Expr -> [String] @@ -1006,13 +1008,13 @@ viewLatex view name grphs = do restrictedSystem $ "pdflatex " ++ texfile restrictedSystem $ view ++ " " ++ pdffile return void - + ---- copied from VisualizeTree ; not sure about proper place AR Nov 2015 latexDoc :: [String] -> String latexDoc body = unlines $ "\\batchmode" : "\\documentclass{article}" - : "\\usepackage[utf8]{inputenc}" + : "\\usepackage[utf8]{inputenc}" : "\\begin{document}" : spaces body ++ ["\\end{document}"] diff --git a/src/compiler/GF/Command/CommonCommands.hs b/src/compiler/GF/Command/CommonCommands.hs index c685fc525..f1faa258e 100644 --- a/src/compiler/GF/Command/CommonCommands.hs +++ b/src/compiler/GF/Command/CommonCommands.hs @@ -19,6 +19,12 @@ import Data.Char (isSpace) import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..)) +-- store default generation depth in a variable and use everywhere +default_depth :: Int +default_depth = 5 +default_depth_str = show default_depth + + extend old new = Map.union (Map.fromList new) old -- Map.union is left-biased commonCommands :: (Monad m,MonadSIO m) => Map.Map String (CommandInfo m) diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index bcf3d32f2..6e72ce5ea 100644 --- a/src/server/PGFService.hs +++ b/src/server/PGFService.hs @@ -571,6 +571,8 @@ limit, depth :: CGI (Maybe Int) limit = readInput "limit" depth = readInput "depth" +default_depth_server = 4 + start :: CGI Int start = maybe 0 id # readInput "start" @@ -781,7 +783,7 @@ doRandom pgf mcat mdepth mlimit to = | tree <- limit trees] where cat = fromMaybe (PGF.startCat pgf) mcat limit = take (fromMaybe 1 mlimit) - depth = fromMaybe 4 mdepth + depth = fromMaybe default_depth_server mdepth doGenerate :: PGF -> Maybe PGF.Type -> Maybe Int -> Maybe Int -> To -> JSValue doGenerate pgf mcat mdepth mlimit tos = @@ -794,7 +796,7 @@ doGenerate pgf mcat mdepth mlimit tos = trees = PGF.generateAllDepth pgf cat (Just depth) cat = fromMaybe (PGF.startCat pgf) mcat limit = take (fromMaybe 1 mlimit) - depth = fromMaybe 4 mdepth + depth = fromMaybe default_depth_server mdepth doGrammar :: (UTCTime,PGF) -> Either IOError (UTCTime,l) -> Maybe (Accept Language) -> CGI CGIResult doGrammar (t1,pgf) elbls macc = out t $ showJSON $ makeObj -- cgit v1.2.3