Skip to content
Permalink
Browse files

fix parens in marlowe pretty printer

  • Loading branch information...
David Smith
David Smith committed Mar 14, 2019
1 parent 5db3d04 commit e5e24a9ad4278932d6fbb592bfd79f727b913cf2
Showing with 13 additions and 22 deletions.
  1. +6 −21 meadow-client/src/Marlowe/Pretty.purs
  2. +7 −1 meadow-client/src/Marlowe/Types.purs
@@ -4,30 +4,12 @@ import Prelude

import Data.Array (uncons)
import Data.Foldable (foldl)
import Data.Generic.Rep
( class Generic
, Argument(..)
, Constructor(..)
, NoArguments
, NoConstructors
, Product(..)
, Sum(..)
, from
)
import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments, NoConstructors, Product(..), Sum(..), from)
import Data.Maybe (Maybe(..))
import Data.Monoid (mempty)
import Data.String (Pattern(..), contains, length)
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Text.PrettyPrint.Leijen
( Doc
( Empty
)
, appendWithLine
, hang
, parens
, text
, (<+>)
)
import Text.PrettyPrint.Leijen (Doc(Empty), appendWithLine, comma, encloseSep, hang, lbracket, parens, rbracket, text, (<+>))

class Pretty a where
pretty :: a -> Doc
@@ -61,7 +43,7 @@ instance genericPrettyConstructor ::
args -> case uncons args of
Just { head: x, tail: [] } -> hang ((length ctor) + 1) (text ctor <+> (parens' x))
Just { head: x, tail: xs } -> hang ((length ctor) + 1) (text ctor <+> (parens' x) `appendWithLine'` (foldl (\a b ->
(parens' (appendWithLine' a b)))) mempty xs)
(appendWithLine' a (parens' b))) mempty xs))
Nothing -> text ctor
where
ctor ::
@@ -94,5 +76,8 @@ instance genericPrettyString :: Pretty String where
instance genericPrettyInt :: Pretty Int where
pretty a = text (show a)

instance prettyArray :: (Pretty a, Show a) => Pretty (Array a) where
pretty a = encloseSep lbracket rbracket comma (map pretty a)

genericPretty :: forall a rep. Generic a rep => Pretty rep => a -> Doc
genericPretty x = pretty (from x)
@@ -112,6 +112,9 @@ derive instance genericObservation :: Generic Observation _
instance showObservation :: Show Observation where
show o = genericShow o

instance prettyObservation :: Pretty Observation where
pretty a = genericPretty a

data Contract
= Null
| Commit IdAction IdCommit Person Value Timeout Timeout Contract Contract
@@ -131,4 +134,7 @@ derive instance ordContract :: Ord Contract
derive instance genericContract :: Generic Contract _

instance showContract :: Show Contract where
show c = genericShow c
show c = genericShow c

instance prettyContract :: Pretty Contract where
pretty a = genericPretty a

0 comments on commit e5e24a9

Please sign in to comment.
You can’t perform that action at this time.