Share helper functions between Ruby and Python pretty-printer.

src/Data/Reprinting/Splice.hs

@@ -7,7 +7,9 @@ module Data.Reprinting.Splice
   , defer
   , Splice(..)
   , emit
+  , emitIf
   , layout
+  , indent
   , layouts
   , space
   , Whitespace(..)
@@ -53,10 +55,20 @@ data Splice
 emit :: Text -> Plan k Splice ()
 emit = yield . Emit
 
+-- | Emit the provided 'Text' if the given predicate is true.
+emitIf :: Bool -> Text -> Plan k Splice ()
+emitIf p = when p . emit
+
 -- | Construct a layout 'Splice'.
 layout :: Whitespace -> Plan k Splice ()
 layout = yield . Layout
 
+-- | @indent w n@ emits @w@ 'Spaces' @n@ times.
+indent :: Int -> Int -> Plan k Splice ()
+indent width times
+  | times > 0 = replicateM_ times (layout (Indent width Spaces))
+  | otherwise = pure ()
+
 -- | Construct multiple layouts.
 layouts :: [Whitespace] -> Plan k Splice ()
 layouts = traverse_ (yield . Layout)

src/Data/Reprinting/Token.hs

@@ -5,6 +5,8 @@ module Data.Reprinting.Token
   , Element (..)
   , Control (..)
   , Context (..)
+  , imperativeDepth
+  , precedenceOf
   , Operator (..)
   ) where
 
@@ -71,6 +73,18 @@ data Context
   | Imperative
     deriving (Show, Eq)
 
+precedenceOf :: [Context] -> Int
+precedenceOf cs = case filter isInfix cs of
+  (TInfixL _ n:_) -> n
+  _ -> 0
+  where isInfix (TInfixL _ _) = True
+        isInfix _             = False
+
+
+-- | Depth of imperative scope.
+imperativeDepth :: [Context] -> Int
+imperativeDepth = length . filter (== Imperative)
+
 -- | A sum type representing every concievable infix operator a
 -- language can define. These are handled by instances of 'Concrete'
 -- and given appropriate precedence.

src/Language/Python/PrettyPrint.hs

@@ -23,7 +23,7 @@ step (Defer el cs)  = case (el, cs) of
   (TOpen,  TFunction:_)         -> emit "def" *> space
   (TOpen,  TParams:TFunction:_) -> emit "("
   (TClose, TParams:TFunction:_) -> emit "):"
-  (TClose, TFunction:xs)        -> endContext (depth xs)
+  (TClose, TFunction:xs)        -> endContext (imperativeDepth xs)
 
   -- Return statements
   (TOpen,  TReturn:_) -> emit "return" *> space
@@ -35,7 +35,7 @@ step (Defer el cs)  = case (el, cs) of
   -- If statements
   (TOpen,  TIf:_)  -> emit "if" *> space
   (TThen,  TIf:_)  -> emit ":"
-  (TElse,  TIf:xs) -> endContext (depth xs) *> emit "else:"
+  (TElse,  TIf:xs) -> endContext (imperativeDepth xs) *> emit "else:"
   (TClose, TIf:_)  -> pure ()
 
   -- Booleans
@@ -43,11 +43,11 @@ step (Defer el cs)  = case (el, cs) of
   (Truth False, _) -> emit "False"
 
   -- Infix binary operators
-  (TOpen,  TInfixL _ p:xs)       -> emitIf (p < prec xs) "("
+  (TOpen,  TInfixL _ p:xs)       -> emitIf (p < precedenceOf xs) "("
   (TSym,   TInfixL Add _:_)      -> space *> emit "+" *> space
   (TSym,   TInfixL Multiply _:_) -> space *> emit "*" *> space
   (TSym,   TInfixL Subtract _:_) -> space *> emit "-" *> space
-  (TClose, TInfixL _ p:xs)       -> emitIf (p < prec xs) ")"
+  (TClose, TInfixL _ p:xs)       -> emitIf (p < precedenceOf xs) ")"
 
   -- General params handling
   (TOpen,  TParams:_) -> emit "("
@@ -57,29 +57,11 @@ step (Defer el cs)  = case (el, cs) of
   -- Imperative context and whitespace handling
   (TOpen,  [Imperative])  -> pure ()            -- Don't indent at the top-level imperative context...
   (TClose, [Imperative])  -> layout HardWrap -- but end the program with a newline.
-  (TOpen,  Imperative:xs) -> layout HardWrap *> indent (depth xs)
-  (TSep,   Imperative:xs) -> layout HardWrap *> indent (depth xs)
+  (TOpen,  Imperative:xs) -> layout HardWrap *> indent 4 (imperativeDepth xs)
+  (TSep,   Imperative:xs) -> layout HardWrap *> indent 4 (imperativeDepth xs)
   (TClose, Imperative:_)  -> pure ()
 
   _ -> lift (throwError (NoTranslation el cs))
 
   where
-    emitIf predicate txt = when predicate (emit txt)
-    endContext times = layout HardWrap *> indent (pred times)
-
-prec :: [Context] -> Int
-prec cs = case filter isInfix cs of
-  (TInfixL _ n:_) -> n
-  _ -> 0
-  where isInfix (TInfixL _ _) = True
-        isInfix _             = False
-
--- | Depth of imperative scope.
-depth :: [Context] -> Int
-depth = length . filter (== Imperative)
-
--- | Indent n times.
-indent :: Int -> Plan k Splice ()
-indent times
-  | times > 0 = replicateM_ times (layout (Indent 4 Spaces))
-  | otherwise = pure ()
+    endContext times = layout HardWrap *> indent 4 (pred times)

src/Language/Ruby/PrettyPrint.hs

@@ -2,7 +2,6 @@
 
 module Language.Ruby.PrettyPrint ( printingRuby ) where
 
-import Control.Monad
 import Control.Monad.Trans (lift)
 import Control.Monad.Effect
 import Control.Monad.Effect.Exception (Exc, throwError)
@@ -20,52 +19,34 @@ step (Verbatim txt) = emit txt
 step (New _ _ txt)  = emit txt
 step (Defer el cs)  = case (el, cs) of
   (TOpen,  TMethod:_)  -> emit "def" *> space
-  (TClose, TMethod:xs) -> endContext (depth xs) *> emit "end"
+  (TClose, TMethod:xs) -> endContext (imperativeDepth xs) *> emit "end"
 
   -- TODO: do..end vs {..} should be configurable.
   (TOpen,  TFunction:_)         -> space *> emit "do" *> space
   (TOpen,  TParams:TFunction:_) -> emit "|"
   (TClose, TParams:TFunction:_) -> emit "|"
-  (TClose, TFunction:xs)        -> endContext (depth xs) *> emit "end"
+  (TClose, TFunction:xs)        -> endContext (imperativeDepth xs) *> emit "end"
 
   -- TODO: Parens for calls are a style choice, make configurable.
   (TOpen,  TParams:_) -> emit "("
   (TSep,   TParams:_) -> emit "," *> space
   (TClose, TParams:_) -> emit ")"
 
-  (TOpen,  TInfixL _ p:xs)       -> emitIf (p < prec xs) "("
+  (TOpen,  TInfixL _ p:xs)       -> emitIf (p < precedenceOf xs) "("
   (TSym,   TInfixL Add _:_)      -> space *> emit "+" *> space
   (TSym,   TInfixL Multiply _:_) -> space *> emit "*" *> space
   (TSym,   TInfixL Subtract _:_) -> space *> emit "-" *> space
-  (TClose, TInfixL _ p:xs)       -> emitIf (p < prec xs) ")"
+  (TClose, TInfixL _ p:xs)       -> emitIf (p < precedenceOf xs) ")"
 
   (TOpen,  [Imperative])  -> pure ()
-  (TOpen,  Imperative:xs) -> layout HardWrap *> indent (depth xs)
-  (TSep,   Imperative:xs) -> layout HardWrap *> indent (depth xs)
+  (TOpen,  Imperative:xs) -> layout HardWrap *> indent 2 (imperativeDepth xs)
+  (TSep,   Imperative:xs) -> layout HardWrap *> indent 2 (imperativeDepth xs)
   (TClose, [Imperative])  -> layout HardWrap
-  (TClose, Imperative:xs) -> indent (pred (depth xs))
+  (TClose, Imperative:xs) -> indent 2 (pred (imperativeDepth xs))
 
   (TSep, TCall:_) -> emit "."
 
   _ -> lift (throwError (NoTranslation el cs))
 
   where
-    emitIf predicate txt = when predicate (emit txt)
-    endContext times = layout HardWrap *> indent (pred times)
-
-prec :: [Context] -> Int
-prec cs = case filter isInfix cs of
-  (TInfixL _ n:_) -> n
-  _ -> 0
-  where isInfix (TInfixL _ _) = True
-        isInfix _             = False
-
--- | Depth of imperative scope.
-depth :: [Context] -> Int
-depth = length . filter (== Imperative)
-
--- | Indent n times.
-indent :: Int -> Plan k Splice ()
-indent times
-  | times > 0 = replicateM_ times (layout (Indent 2 Spaces))
-  | otherwise = pure ()
+    endContext times = layout HardWrap *> indent 2 (pred times)