From 47f6c1beb139e2283e28ddf5229ad57add884bed Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 12 Sep 2018 12:23:00 -0400 Subject: [PATCH] Share helper functions between Ruby and Python pretty-printer. --- src/Data/Reprinting/Splice.hs | 12 ++++++++++ src/Data/Reprinting/Token.hs | 14 ++++++++++++ src/Language/Python/PrettyPrint.hs | 32 ++++++--------------------- src/Language/Ruby/PrettyPrint.hs | 35 +++++++----------------------- 4 files changed, 41 insertions(+), 52 deletions(-) diff --git a/src/Data/Reprinting/Splice.hs b/src/Data/Reprinting/Splice.hs index 46eb44473..d491e89f1 100644 --- a/src/Data/Reprinting/Splice.hs +++ b/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) diff --git a/src/Data/Reprinting/Token.hs b/src/Data/Reprinting/Token.hs index b6a17afe8..cf0474244 100644 --- a/src/Data/Reprinting/Token.hs +++ b/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. diff --git a/src/Language/Python/PrettyPrint.hs b/src/Language/Python/PrettyPrint.hs index e70337be7..10af0295b 100644 --- a/src/Language/Python/PrettyPrint.hs +++ b/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) diff --git a/src/Language/Ruby/PrettyPrint.hs b/src/Language/Ruby/PrettyPrint.hs index d59ebd1ec..4bd5dd9a3 100644 --- a/src/Language/Ruby/PrettyPrint.hs +++ b/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)