Pretty printing of the limited stuff that's there.

src/Bang/Syntax/AST.hs

@@ -1,8 +1,9 @@
 module Bang.Syntax.AST
  where
 
-import Data.Text.Lazy(Text)
+import Data.Text.Lazy(Text, unpack)
 import Bang.Syntax.Location
+import Text.PrettyPrint.Annotated
 
 data NameEnvironment = ModuleEnv | TypeEnv | VarEnv
  deriving (Eq, Ord, Show)
@@ -10,26 +11,67 @@ data NameEnvironment = ModuleEnv | TypeEnv | VarEnv
 data Name = Name Location NameEnvironment Word Text
  deriving (Show)
 
+ppName :: Name -> Doc a
+ppName (Name _ _ _ t) = text' t
+
 data Module = Module Name [Declaration]
  deriving (Show)
 
-data Declaration = TypeDeclaration  !Name !Type
-                 | ValueDeclaration !Name !Expression
-                 | PrimTypeDecl           !PrimitiveType
+ppModule :: Module -> Doc a
+ppModule (Module name decls) =
+  vcat ([text "module" <> space <> ppName name, text ""] ++
+        map ppDeclaration decls)
+
+data Declaration = TypeDeclaration     Name Type
+                 | ValueDeclaration    Name Expression
+                 | PrimTypeDeclaration Name Text
  deriving (Show)
 
-data PrimitiveType = PrimType Name Text
- deriving (Show)
+ppDeclaration :: Declaration -> Doc a
+ppDeclaration d =
+  case d of
+    TypeDeclaration n t ->
+      ppName n <> space <> text "::" <> space <> ppType t
+    ValueDeclaration n e ->
+      ppName n <> space <> text "=" <> space <> ppExpression e
+    PrimTypeDeclaration n t ->
+      text "primitive" <> space <> text "type" <> space <>
+      ppName n <> space <> text "=" <> space <> text' t
 
-data Expression = ConstantExp  Location ConstantVal
+data Expression = ConstantExp  Location ConstantValue
                 | ReferenceExp Location Name
  deriving (Show)
 
-data ConstantVal = ConstantInt    Word Text
-                 | ConstantChar        Text
-                 | ConstantString      Text
-                 | ConstantFloat       Text
+ppExpression :: Expression -> Doc a
+ppExpression e =
+  case e of
+    ConstantExp  _ v -> ppConstantValue v
+    ReferenceExp _ n -> ppName n
+
+data ConstantValue = ConstantInt    Word Text
+                   | ConstantChar        Text
+                   | ConstantString      Text
+                   | ConstantFloat       Text
  deriving (Show)
 
+ppConstantValue :: ConstantValue -> Doc a
+ppConstantValue cv =
+  case cv of
+    ConstantInt    2  t -> text "0b" <> text' t
+    ConstantInt    8  t -> text "0o" <> text' t
+    ConstantInt    10 t ->              text' t
+    ConstantInt    16 t -> text "0x" <> text' t
+    ConstantChar      c -> text' c
+    ConstantString    s -> text' s
+    ConstantFloat     f -> text' f
+
 data Type = TypeRef Location Name
  deriving (Show)
+
+ppType :: Type -> Doc a
+ppType t =
+  case t of
+    TypeRef _ n -> ppName n
+
+text' :: Text -> Doc a
+text' = text . unpack

src/Bang/Syntax/Parser.y

@@ -143,7 +143,7 @@ declaration :: { Maybe Declaration }
        do let Located src (TypeIdent rawName) = $3
               Located _   (StringTok rawText) = $5
           name <- registerName False src TypeEnv rawName
-          return (Just (PrimTypeDecl (PrimType name rawText))) }
+          return (Just (PrimTypeDeclaration name rawText)) }
 
 Type :: { Type }
   : TypeIdent   {%

src/Main.hs

@@ -1,4 +1,5 @@
 import           Bang.CommandLine
+import           Bang.Syntax.AST(ppModule)
 import           Bang.Syntax.Lexer
 import           Bang.Syntax.Location
 import           Bang.Syntax.Parser
@@ -8,6 +9,7 @@ import qualified Data.Text.Lazy.IO as T
 import           Data.Version(showVersion)
 import           Paths_bang(version)
 import           System.IO.Error(isDoesNotExistError)
+import           Text.PrettyPrint.Annotated(render)
 
 main :: IO ()
 main = getCommand >>= \ cmd ->
@@ -34,5 +36,9 @@ runParser _cmd opts =
      case mtxt of
        Left  _   -> fail ("Unable to open file: " ++ path)
        Right txt ->
-         do let mod = parseModule (File path) txt
-            putStrLn (show mod)
+         do let res = parseModule (File path) txt
+            case res of
+              Left err ->
+                putStrLn (show err)
+              Right mod ->
+                putStrLn (render (ppModule mod))