diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,7 +1,13 @@ +0.13.0.0 (2024-04-05) +===================== + +- ([#18](https://github.com/abhinav/language-thrift/pull/18)) + Migrate pretty printer to `prettyprinter`. + 0.12.0.1 (2021-12-04) ===================== -- Allow semigroups 0.20 +- Allow semigroups 0.20 0.12.0.0 (2020-12-31) ===================== diff --git a/language-thrift.cabal b/language-thrift.cabal --- a/language-thrift.cabal +++ b/language-thrift.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack -- --- hash: 3e937cba14cc7d2b64284d4ab69cac1944266faa7871aa91fbd6c4800138236e +-- hash: bcd2435f3966b5f41ce6a7537716d75c2f9d49461f232f94bc99d7508746aa7e name: language-thrift -version: 0.12.0.1 +version: 0.13.0.0 synopsis: Parser and pretty printer for the Thrift IDL format. description: This package provides a parser and pretty printer for the . @@ -43,12 +43,12 @@ Paths_language_thrift hs-source-dirs: src - ghc-options: -Wall + ghc-options: -Wall -Wunused-packages build-depends: - ansi-wl-pprint ==0.6.* - , base >=4.7 && <5 + base >=4.7 && <5 , containers >=0.5 && <0.7 , megaparsec >=9.0 && <10.0 + , prettyprinter-compat-ansi-wl-pprint >=1.0 && <2.0 , scientific ==0.3.* , semigroups >=0.18 && <0.21 , text >=1.2 @@ -61,17 +61,17 @@ hs-source-dirs: src test - ghc-options: -Wall + ghc-options: -Wall -Wunused-packages build-tool-depends: hspec-discover:hspec-discover >=2.1 build-depends: QuickCheck >=2.5 - , ansi-wl-pprint ==0.6.* , base >=4.7 && <5 , containers >=0.5 && <0.7 , hspec >=2.0 , language-thrift , megaparsec >=9.0 && <10.0 + , prettyprinter-compat-ansi-wl-pprint >=1.0 && <2.0 , scientific ==0.3.* , semigroups >=0.18 && <0.21 , text >=1.2 diff --git a/src/Language/Thrift/Parser.hs b/src/Language/Thrift/Parser.hs --- a/src/Language/Thrift/Parser.hs +++ b/src/Language/Thrift/Parser.hs @@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- | -- Module : Language.Thrift.Parser -- Copyright : (c) Abhinav Gupta 2016 @@ -38,6 +39,7 @@ , include , namespace + , functionParameters , definition , constant , typeDefinition @@ -200,7 +202,7 @@ indent <- fromIntegral . P.unPos <$> PL.indentLevel isNewLine <- maybeEOL chunks <- loop isNewLine (indent - 1) [] - return $! Text.intercalate "\n" chunks + return $! Text.intercalate "\n" (Text.dropWhileEnd (== ' ') <$> chunks) where maybeEOL = (PC.eol >> return True) <|> return False @@ -639,11 +641,15 @@ <$> ((reserved "oneway" $> True) <|> pure False) <*> ((reserved "void" $> Nothing) <|> Just <$> typeReference) <*> identifier - <*> parens (many field) + <*> functionParameters <*> optional (reserved "throws" *> parens (many field)) <*> typeAnnotations <* optionalSep +functionParameters + :: (P.TraversableStream s, P.Token s ~ Char) + => Parser s [T.Field P.SourcePos] +functionParameters = parens $ many field -- | Type annotations on entitites. -- diff --git a/src/Language/Thrift/Pretty.hs b/src/Language/Thrift/Pretty.hs --- a/src/Language/Thrift/Pretty.hs +++ b/src/Language/Thrift/Pretty.hs @@ -2,7 +2,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module : Language.Thrift.Pretty -- Copyright : (c) Abhinav Gupta 2016 @@ -37,6 +37,7 @@ , include , namespace + , functionParameters , definition , constant , typeDefinition @@ -64,12 +65,12 @@ import Prelude hiding ((<$>)) #endif +import qualified Data.List as List import Data.Text (Text) import qualified Data.Text as Text import Text.PrettyPrint.ANSI.Leijen ( Doc - , Pretty (..) , align , bold , cyan @@ -79,6 +80,7 @@ , empty , enclose , group + , hardline , hcat , hsep , integer @@ -93,11 +95,10 @@ , (<$$>) , (<$>) , (<+>) - , (<>) ) +import qualified Text.PrettyPrint.ANSI.Leijen as PP import qualified Language.Thrift.Internal.AST as T -import qualified Text.PrettyPrint.ANSI.Leijen as P -- | Configuration for the pretty printer. data Config = Config @@ -127,39 +128,24 @@ else vsep (map header programHeaders) <$> line ) <> map (definition c) programDefinitions `sepBy` (line <> line) -instance Pretty (T.Program a) where - pretty = program defaultConfig - -- | Print the headers for a program. header :: T.Header ann -> Doc header (T.HeaderInclude inc) = include inc header (T.HeaderNamespace ns) = namespace ns -instance Pretty (T.Header a) where - pretty = header - include :: T.Include ann -> Doc include T.Include{..} = reserved "include" <+> literal includePath -instance Pretty (T.Include a) where - pretty = include - namespace :: T.Namespace ann -> Doc namespace T.Namespace{..} = hsep [reserved "namespace", text namespaceLanguage, text namespaceName] -instance Pretty (T.Namespace a) where - pretty = namespace - -- | Print a constant, type, or service definition. definition :: Config -> T.Definition ann -> Doc definition c (T.ConstDefinition cd) = constant c cd definition c (T.TypeDefinition def) = typeDefinition c def definition c (T.ServiceDefinition s) = service c s -instance Pretty (T.Definition a) where - pretty = definition defaultConfig - constant :: Config -> T.Const ann -> Doc constant c T.Const{..} = constDocstring $$ hsep [ reserved "const" @@ -169,9 +155,6 @@ , constantValue c constValue ] -instance Pretty (T.Const a) where - pretty = constant defaultConfig - service :: Config -> T.Service ann -> Doc service c@Config{indentWidth} T.Service{..} = serviceDocstring $$ @@ -183,18 +166,18 @@ Nothing -> empty Just name -> space <> reserved "extends" <+> text name -instance Pretty (T.Service a) where - pretty = service defaultConfig +functionParameters :: Config -> [T.Field ann] -> Doc +functionParameters c@Config{..} + = encloseSep indentWidth lparen rparen comma + . map (field c) -- | Pretty print a function definition. -- function :: Config -> T.Function ann -> Doc -function c@Config{indentWidth} T.Function{..} = functionDocstring $$ - oneway <> returnType <+> text functionName <> - encloseSep - indentWidth lparen rparen comma - (map (field c) functionParameters) <> - exceptions <> typeAnnots c functionAnnotations <> semi +function c@Config{indentWidth} T.Function{functionParameters = params, ..} = functionDocstring $$ + oneway <> returnType <+> text functionName + <> functionParameters c params + <> exceptions <> typeAnnots c functionAnnotations <> semi where exceptions = case functionExceptions of Nothing -> empty @@ -208,9 +191,6 @@ then reserved "oneway" <> space else empty -instance Pretty (T.Function a) where - pretty = function defaultConfig - typeDefinition :: Config -> T.Type ann -> Doc typeDefinition c td = case td of T.TypedefType t -> c `typedef` t @@ -218,26 +198,17 @@ T.StructType t -> c `struct` t T.SenumType t -> c `senum` t -instance Pretty (T.Type a) where - pretty = typeDefinition defaultConfig - typedef :: Config -> T.Typedef ann -> Doc typedef c T.Typedef{..} = typedefDocstring $$ reserved "typedef" <+> typeReference c typedefTargetType <+> declare typedefName <> typeAnnots c typedefAnnotations -instance Pretty (T.Typedef a) where - pretty = typedef defaultConfig - enum :: Config -> T.Enum ann -> Doc enum c@Config{indentWidth} T.Enum{..} = enumDocstring $$ reserved "enum" <+> declare enumName <+> block indentWidth (comma <> line) (map (enumValue c) enumValues) <> typeAnnots c enumAnnotations -instance Pretty (T.Enum a) where - pretty = enum defaultConfig - struct :: Config -> T.Struct ann -> Doc struct c@Config{indentWidth} T.Struct{..} = structDocstring $$ kind <+> declare structName <+> @@ -249,9 +220,6 @@ T.UnionKind -> reserved "union" T.ExceptionKind -> reserved "exception" -instance Pretty (T.Struct a) where - pretty = struct defaultConfig - union :: Config -> T.Struct ann -> Doc union = struct {-# DEPRECATED union "Use struct." #-} @@ -266,9 +234,6 @@ encloseSep indentWidth lbrace rbrace comma (map literal senumValues) <> typeAnnots c senumAnnotations -instance Pretty (T.Senum a) where - pretty = senum defaultConfig - field :: Config -> T.Field ann -> Doc field c T.Field{..} = fieldDocstring $$ hcat [ case fieldIdentifier of @@ -286,16 +251,10 @@ , typeAnnots c fieldAnnotations ] -instance Pretty (T.Field a) where - pretty = field defaultConfig - requiredness :: T.FieldRequiredness -> Doc requiredness T.Optional = reserved "optional" requiredness T.Required = reserved "required" -instance Pretty T.FieldRequiredness where - pretty = requiredness - enumValue :: Config -> T.EnumDef ann -> Doc enumValue c T.EnumDef{..} = enumDefDocstring $$ text enumDefName <> value <> typeAnnots c enumDefAnnotations @@ -304,9 +263,6 @@ Nothing -> empty Just v -> space <> equals <+> integer v -instance Pretty (T.EnumDef a) where - pretty = enumValue defaultConfig - -- | Pretty print a field type. typeReference :: Config -> T.TypeReference ann -> Doc typeReference c ft = case ft of @@ -336,9 +292,6 @@ <> enclose langle rangle (typeReference c v) <> typeAnnots c anns -instance Pretty (T.TypeReference a) where - pretty = typeReference defaultConfig - -- | Pretty print a constant value. constantValue :: Config -> T.ConstValue ann -> Doc constantValue c@Config{indentWidth} value = case value of @@ -352,9 +305,6 @@ encloseSep indentWidth lbrace rbrace comma $ map (\(k, v) -> constantValue c k <> colon <+> constantValue c v) vs -instance Pretty (T.ConstValue a) where - pretty = constantValue defaultConfig - typeAnnots :: Config -> [T.TypeAnnotation] -> Doc typeAnnots _ [] = empty typeAnnots Config{indentWidth} anns = @@ -368,21 +318,18 @@ Nothing -> empty Just v -> space <> equals <+> literal v -instance Pretty T.TypeAnnotation where - pretty = typeAnnot - literal :: Text -> Doc literal = cyan . dquotes . text -- TODO: escaping? text :: Text -> Doc -text = P.text . Text.unpack +text = PP.text . Text.unpack reserved :: String -> Doc -reserved = magenta . P.text +reserved = magenta . PP.text op :: String -> Doc -op = yellow . P.text +op = yellow . PP.text declare :: Text -> Doc declare = bold . text @@ -401,7 +348,8 @@ docstring :: Text -> Doc docstring = dullblue . wrapComments . Text.lines where - wrapComments ls = align . vsep + wrapComments [l] = text "/** " <> text l <> " */" + wrapComments ls = align . mconcat . List.intersperse hardline $ text "/**" : map (\l -> text " *" <+> text l) ls ++ [text " */"] diff --git a/test/Language/Thrift/ASTSpec.hs b/test/Language/Thrift/ASTSpec.hs --- a/test/Language/Thrift/ASTSpec.hs +++ b/test/Language/Thrift/ASTSpec.hs @@ -1,15 +1,22 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-deprecations #-} + module Language.Thrift.ASTSpec (spec) where import Control.Monad (void) import Test.Hspec import Test.Hspec.QuickCheck import Text.Megaparsec (SourcePos) +import Test.QuickCheck (Arbitrary(..)) import qualified Text.PrettyPrint.ANSI.Leijen as PP (Doc, plain) import Language.Thrift.Arbitrary () +import Language.Thrift.AST (Field(..)) import TestUtils +import Data.Functor.Const import qualified Language.Thrift.Parser as P import qualified Language.Thrift.Pretty as PP @@ -48,16 +55,33 @@ prop "can round-trip namespaces" $ roundtrip (const PP.namespace) (P.whiteSpace >> P.namespace) + prop "can round-trip docstrings" $ + roundtrip (const $ PP.docstring . getConst) (Const <$> P.docstring) + + prop "can round-trip function params" $ + roundtrip + (\conf -> PP.functionParameters conf . getFunctionParams) + (FunctionParams <$> P.functionParameters) + prop "can round-trip documents" $ roundtrip PP.program P.program +-- We could alternatively just use Data.Functor.Compose, but then +-- we'd have to implement Eq1 for a bunch of things, which is a whole +-- world of pain. +newtype FunctionParams a + = FunctionParams { getFunctionParams :: [Field a] } + deriving (Functor, Eq, Show) +instance Arbitrary (FunctionParams ()) where + arbitrary = FunctionParams <$> arbitrary + roundtrip :: (Show (n ()), Eq (n ()), Functor n) => (PP.Config -> n () -> PP.Doc) -> Parser (n SourcePos) -> n () -> IO () -roundtrip printer parser value = - assertParses (void `fmap` parser) value +roundtrip printer parser value + = assertParses (void `fmap` parser) value (show . PP.plain $ printer (PP.Config 4) value) diff --git a/test/Language/Thrift/ParserSpec.hs b/test/Language/Thrift/ParserSpec.hs --- a/test/Language/Thrift/ParserSpec.hs +++ b/test/Language/Thrift/ParserSpec.hs @@ -32,7 +32,7 @@ ] it "can parse docstrings" $ forM_ - [ ( return "/** foo */", "foo " ) + [ ( return "/** foo */", "foo" ) , ( return "/** foo\n */", "foo" ) , ( readFile "test/data/docstring-1.txt" , "Hello. This is the first\n" ++