Adding GF.Infra.Location and GF.Text.Pretty (forgot to 'darcs add' them before)

src/compiler/GF/Infra/Location.hs

@@ -0,0 +1,31 @@
+module GF.Infra.Location where
+import GF.Text.Pretty
+
+class HasSourcePath a where sourcePath :: a -> FilePath
+
+data Location 
+  = NoLoc
+  | Local Int Int
+  | External FilePath Location
+  deriving (Show,Eq,Ord)
+
+-- | Attaching location information
+data L a = L Location a deriving Show
+
+instance Functor L where fmap f (L loc x) = L loc (f x)
+
+unLoc :: L a -> a
+unLoc (L _ x) = x
+
+noLoc = L NoLoc
+
+ppLocation :: FilePath -> Location -> Doc
+ppLocation fpath NoLoc          = pp fpath
+ppLocation fpath (External p l) = ppLocation p l
+ppLocation fpath (Local b e)
+  | b == e    = fpath <> ":" <> b
+  | otherwise = fpath <> ":" <> b <> "-" <> e
+
+
+ppL (L loc x) msg = hang (ppLocation "" loc<>":") 4
+                         ("In"<+>x<>":"<+>msg)

src/compiler/GF/Text/Pretty.hs

@@ -0,0 +1,47 @@
+-- | Pretty printing with class
+module GF.Text.Pretty(module GF.Text.Pretty,module PP) where
+import qualified Text.PrettyPrint as PP
+import Text.PrettyPrint as PP(Doc,Style(..),Mode(..),style,empty,isEmpty)
+
+class Pretty a where
+  pp :: a -> Doc
+  ppList :: [a] -> Doc
+  ppList = fsep . map pp -- hmm
+
+instance Pretty Doc where pp = id
+instance Pretty Int where pp = PP.int
+instance Pretty Integer where pp = PP.integer
+instance Pretty Float where pp = PP.float
+instance Pretty Double where pp = PP.double
+instance Pretty Char where pp = PP.char; ppList = PP.text
+
+instance Pretty a => Pretty [a] where
+  pp = ppList
+  ppList = fsep . map pp -- hmm
+
+render x = PP.render (pp x)
+renderStyle s x = PP.renderStyle s (pp x)
+
+infixl 5 $$,$+$
+infixl 6 <>,<+>
+
+x $$ y = pp x PP.$$ pp y
+x $+$ y = pp x PP.$+$ pp y
+x <+> y = pp x PP.<+> pp y
+x <> y = pp x PP.<> pp y
+
+braces x = PP.braces (pp x)
+brackets x = PP.brackets (pp x)
+cat xs = PP.cat (map pp xs)
+doubleQuotes x = PP.doubleQuotes (pp x)
+fcat xs = PP.fcat (map pp xs)
+fsep xs = PP.fsep (map pp xs)
+hang x d y = PP.hang (pp x) d (pp y)
+hcat xs = PP.hcat (map pp xs)
+hsep xs = PP.hsep (map pp xs)
+nest d x = PP.nest d (pp x)
+parens x = PP.parens (pp x)
+punctuate x ys = PP.punctuate (pp x) (map pp ys)
+quotes x = PP.quotes (pp x)
+sep xs = PP.sep (map pp xs)
+vcat xs = PP.vcat (map pp xs)