From 30cda5151651e712803527b6ab4e5abc07536f2c Mon Sep 17 00:00:00 2001 From: hallgren Date: Sun, 27 Jul 2014 22:06:23 +0000 Subject: Introducing GF.Text.Pretty for more concise pretty printers and GF.Infra.Location for modularity GF.Text.Pretty provides the class Pretty and overloaded versions of the pretty printing combinators in Text.PrettyPrint, allowing pretty printable values to be used directly instead of first having to convert them to Doc with functions like text, int, char and ppIdent. Some modules have been converted to use GF.Text.Pretty, but not all. Precedences could be added to simplify the pretty printers for terms and patterns. GF.Infra.Location contains the types Location and L, factored out from GF.Grammar.Grammar, and the class HasSourcePath. This allowed the import of GF.Grammar.Grammar to be removed from GF.Infra.CheckM, making it more like a pure library module. --- src/compiler/GF/Command/Commands.hs | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) (limited to 'src/compiler/GF/Command') diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index b6a992232..701a98f3b 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -47,7 +47,7 @@ import Data.Maybe import qualified Data.Map as Map --import System.Cmd(system) -- use GF.Infra.UseIO.restricedSystem instead! import GF.System.Process -import Text.PrettyPrint +import GF.Text.Pretty import Data.List (sort) --import Debug.Trace --import System.Random (newStdGen) ---- @@ -762,19 +762,19 @@ allCommands = Map.fromList [ Just e -> let (es,err) = exprs ls in case inferExpr pgf e of Right (e,t) -> (e:es,err) - Left tcerr -> (es,text "on line" <+> int n <> colon $$ nest 2 (ppTcError tcerr) $$ err) + Left tcerr -> (es,"on line" <+> n <> ':' $$ nest 2 (ppTcError tcerr) $$ err) Nothing -> let (es,err) = exprs ls - in (es,text "on line" <+> int n <> colon <+> text "parse error" $$ err) + in (es,"on line" <+> n <> ':' <+> "parse error" $$ err) returnFromLines ls = case exprs ls of - (es, err) | null es -> return $ pipeMessage $ render (err $$ text "no trees found") + (es, err) | null es -> return $ pipeMessage $ render (err $$ "no trees found") | otherwise -> return $ pipeWithMessage es (render err) s <- restricted $ readFile file case opts of _ | isOpt "lines" opts && isOpt "tree" opts -> - returnFromLines (zip [1..] (lines s)) + returnFromLines (zip [1::Int ..] (lines s)) _ | isOpt "tree" opts -> - returnFromLines [(1,s)] + returnFromLines [(1::Int,s)] _ | isOpt "lines" opts -> return (fromStrings $ lines s) _ -> return (fromString s), flags = [("file","the input file name")] @@ -1145,9 +1145,9 @@ allCommands = Map.fromList [ render (ppCat id cd $$ if null (functionsToCat pgf id) then empty - else space $$ + else ' ' $$ vcat [ppFun fid (ty,0,Just [],0,0) | (fid,ty) <- functionsToCat pgf id] $$ - space) + ' ') let (_,_,prob,_) = cd putStrLn ("Probability: "++show prob) return void @@ -1290,7 +1290,7 @@ allCommands = Map.fromList [ | otherwise = case po of ParseOk ts -> let Piped (es',msg') = fromExprs ts in (es'++es,msg'++msg) - TypeError errs -> ([], render (text "The parsing is successful but the type checking failed with error(s):" $$ + TypeError errs -> ([], render ("The parsing is successful but the type checking failed with error(s):" $$ nest 2 (vcat (map (ppTcError . snd) errs))) ++ "\n" ++ msg) ParseFailed i -> ([], "The parser failed at token " ++ show (words s !! max 0 (i-1)) @@ -1448,13 +1448,13 @@ execToktok (pgf, _) opts exprs = do trie = render . pptss . toTrie . map toATree where - pptss [ts] = text "*"<+>nest 2 (ppts ts) - pptss tss = vcat [int i<+>nest 2 (ppts ts)|(i,ts)<-zip [1..] tss] + pptss [ts] = "*"<+>nest 2 (ppts ts) + pptss tss = vcat [i<+>nest 2 (ppts ts)|(i,ts)<-zip [(1::Int)..] tss] ppts = vcat . map ppt ppt t = case t of - Oth e -> text (showExpr [] e) - Ap f [[]] -> text (showCId f) - Ap f tss -> text (showCId f) $$ nest 2 (pptss tss) + Oth e -> pp (showExpr [] e) + Ap f [[]] -> pp (showCId f) + Ap f tss -> showCId f $$ nest 2 (pptss tss) -- cgit v1.2.3