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.

3 files changed, 11 insertions, 12 deletions

diff --git a/src/compiler/GF/Infra/CheckM.hs b/src/compiler/GF/Infra/CheckM.hs
index 045ba4852..24fbc3644 100644
--- a/src/compiler/GF/Infra/CheckM.hs
+++ b/src/compiler/GF/Infra/CheckM.hs
@@ -21,11 +21,11 @@ module GF.Infra.CheckM
 
 import GF.Data.Operations
 --import GF.Infra.Ident
-import GF.Grammar.Grammar(msrc) -- ,Context
-import GF.Grammar.Printer(ppLocation)
+--import GF.Grammar.Grammar(msrc) -- ,Context
+import GF.Infra.Location(ppLocation,sourcePath)
 
 import qualified Data.Map as Map
-import Text.PrettyPrint
+import GF.Text.Pretty
 import System.FilePath(makeRelative)
 import Control.Parallel.Strategies(parList,rseq,using)
 import Control.Monad(liftM)
@@ -51,7 +51,7 @@ instance Monad Check where
                  (ws,Fail msg)  -> (ws,Fail msg)
 
 instance ErrorMonad Check where
-  raise s = checkError (text s)
+  raise s = checkError (pp s)
   handle f h = handle' f (h . render)
 
 handle' f h = Check (\{-ctxt-} msgs -> case unCheck f {-ctxt-} msgs of
@@ -67,7 +67,7 @@ checkCond s b = if b then return () else checkError s
 
 -- | warnings should be reversed in the end
 checkWarn :: Message -> Check ()
-checkWarn msg = Check $ \{-ctxt-} (es,ws) -> ((es,(text "Warning:" <+> msg) : ws),Success ())
+checkWarn msg = Check $ \{-ctxt-} (es,ws) -> ((es,("Warning:" <+> msg) : ws),Success ())
 
 checkWarnings = mapM_ checkWarn
 
@@ -151,6 +151,6 @@ checkIn msg c = Check $ \{-ctxt-} msgs0 ->
 -- | Augment error messages with a relative path to the source module and
 -- an contextual hint (which can be left 'empty')
 checkInModule cwd mi loc context =
-    checkIn (ppLocation relpath loc <> colon $$ nest 2 context)
+    checkIn (ppLocation relpath loc <> ':' $$ nest 2 context)
   where
-    relpath = makeRelative cwd (msrc mi)
+    relpath = makeRelative cwd (sourcePath mi)
diff --git a/src/compiler/GF/Infra/Ident.hs b/src/compiler/GF/Infra/Ident.hs
index 390c5ba84..272efca03 100644
--- a/src/compiler/GF/Infra/Ident.hs
+++ b/src/compiler/GF/Infra/Ident.hs
@@ -13,7 +13,7 @@
 -----------------------------------------------------------------------------
 
 module GF.Infra.Ident (-- * Identifiers
-	      Ident, ident2utf8, showIdent, ppIdent, prefixIdent,
+	      Ident, ident2utf8, showIdent, prefixIdent,
 	      identS, identC, identV, identA, identAV, identW,
 	      argIdent, isArgIdent, getArgIndex,
               varStr, varX, isWildIdent, varIndex,
@@ -31,7 +31,7 @@ import qualified Data.ByteString.Char8 as BS(append,isPrefixOf)
                  -- UTF-8-encoded bytestrings!
 import Data.Char(isDigit)
 import PGF.Internal(Binary(..))
-import Text.PrettyPrint(Doc,text)
+import GF.Text.Pretty
 
 
 -- | the constructors labelled /INTERNAL/ are
@@ -81,8 +81,7 @@ ident2raw = Id . ident2utf8
 showIdent :: Ident -> String
 showIdent i = unpack $! ident2utf8 i
 
-ppIdent :: Ident -> Doc
-ppIdent = text . showIdent
+instance Pretty Ident where pp = pp . showIdent
 
 identS :: String -> Ident
 identS = identC . rawIdentS
diff --git a/src/compiler/GF/Infra/UseIO.hs b/src/compiler/GF/Infra/UseIO.hs
index fe1d01423..aa0c7d7ff 100644
--- a/src/compiler/GF/Infra/UseIO.hs
+++ b/src/compiler/GF/Infra/UseIO.hs
@@ -54,7 +54,7 @@ errOptIO os e m = case m of
     return e
 -}
 type FileName = String
-type InitPath = String
+type InitPath = String -- ^ the directory portion of a pathname
 type FullPath = String
 
 gfLibraryPath    = "GF_LIB_PATH"