haskell/Printer.hs

   1 module Printer
   2 ( _pr_str, _pr_list )
   3 where
   4
   5 import qualified Data.Map as Map
   6 import Data.IORef (readIORef)
   7
   8 import Types
   9
  10 _pr_list :: Bool -> String -> [MalVal] -> IO String
  11 _pr_list _  _   []     = return $ []
  12 _pr_list pr _   [x]    = _pr_str pr x
  13 _pr_list pr sep (x:xs) = format <$> _pr_str pr x <*> _pr_list pr sep xs where
  14     format l r = l ++ sep ++ r
  15
  16 _flatTuples :: [(String, MalVal)] -> [MalVal]
  17 _flatTuples ((a,b):xs) = MalString a : b : _flatTuples xs
  18 _flatTuples _          = []
  19
  20 unescape :: Char -> String
  21 unescape '\n' = "\\n"
  22 unescape '\\' = "\\\\"
  23 unescape '"'  = "\\\""
  24 unescape c    = [c]
  25
  26 _pr_str :: Bool -> MalVal -> IO String
  27 _pr_str _     (MalString (c : cs)) | c == keywordMagic
  28                                  = return $ ':' : cs
  29 _pr_str True  (MalString str)    = return $ "\"" ++ concatMap unescape str ++ "\""
  30 _pr_str False (MalString str)    = return str
  31 _pr_str _     (MalSymbol name)   = return name
  32 _pr_str _     (MalNumber num)    = return $ show num
  33 _pr_str _     (MalBoolean True)  = return "true"
  34 _pr_str _     (MalBoolean False) = return $ "false"
  35 _pr_str _     Nil                = return "nil"
  36 _pr_str pr (MalSeq _ (Vect False) items) = format <$> _pr_list pr " " items where
  37     format x = "(" ++ x ++ ")"
  38 _pr_str pr (MalSeq _ (Vect True)  items) = format <$> _pr_list pr " " items where
  39     format x = "[" ++ x ++ "]"
  40 _pr_str pr (MalHashMap _ m) = format <$> _pr_list pr " " (_flatTuples $ Map.assocs m) where
  41     format x = "{" ++ x ++ "}"
  42 _pr_str pr (MalAtom _ r) = format  <$> (_pr_str pr =<< readIORef r) where
  43     format x = "(atom " ++ x ++ ")"
  44 _pr_str _ (MalFunction {f_ast=Nil}) = pure "#<function>"
  45 _pr_str _ (MalFunction {f_ast=a, f_params=p, macro=False}) = format <$> _pr_str True a where
  46     format x = "(fn* " ++ show p ++ " -> " ++ x ++ ")"
  47 _pr_str _ (MalFunction {f_ast=a, f_params=p, macro=True})  = format <$> _pr_str True a where
  48     format x = "(macro* " ++ show p ++ " -> " ++ x ++ ")"