packages feed

language-thrift 0.6.0.1 → 0.6.1.0

raw patch · 7 files changed

+195/−94 lines, 7 filesdep ~ansi-wl-pprintPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ansi-wl-pprint

API changes (from Hackage documentation)

Files

CHANGES.md view
@@ -1,3 +1,9 @@+0.6.1.0+=======++-   Output generated by the `ansi-wl-pprint` pretty printer will be colored+    using ANSI escape codes.+ 0.6.0.1 =======
Language/Thrift/Pretty.hs view
@@ -14,7 +14,7 @@ -- This module provides a pretty printer for Thrift IDLs. The pretty printer -- preserves docstrings specified for types. ----- The specifics of the printer can be configured using 'Config' objects.+-- The behavior of the printer can be customized using 'Config' objects. -- -- The module also exports instances of the 'Pretty' typeclass for elements of -- the AST.@@ -51,7 +51,6 @@     , defaultConfig     ) where -import           Text.PrettyPrint.Leijen hiding (encloseSep, indent, text)-import qualified Text.PrettyPrint.Leijen as PP-+#define PrettyPrinter Text.PrettyPrint.Leijen #include "Pretty/PrettyInc.hs"+#undef PrettyPrinter
Language/Thrift/Pretty/ANSI.hs view
@@ -11,13 +11,20 @@ -- Maintainer  :  Abhinav Gupta <mail@abhinavg.net> -- Stability   :  experimental ----- This module is the same as "Language.Thrift.Pretty" but the pretty printer--- used is the one provided by ansi-wl-pprint.+-- This module provides a pretty printer for Thrift IDLs that produces colored+-- output. It is essentially the same as "Language.Thrift.Pretty" with the+-- exception of the colored output. ----- The specifics of the printer can be configured using 'Config' objects.+-- The behavior of the printer can be customized using 'Config' objects. --+-- The system uses ANSI escape codes to produce colored output. That makes the+-- text output of this pretty printer unparseable without printing to a+-- supported terminal. If this is undesirable, use+-- 'Text.PrettyPrint.ANSI.Leijen.plain' to discard coloring information, or+-- simply use the "Language.Thrift.Pretty" pretty printer instead.+-- -- As with "Language.Thrift.Pretty", this module exports instances of the--- 'Pretty' typeclass for @ansi-wl-pprint@.+-- 'Pretty' typeclass for elements of the AST. module Language.Thrift.Pretty.ANSI     (       prettyPrint@@ -51,7 +58,8 @@     , defaultConfig     ) where -import           Text.PrettyPrint.ANSI.Leijen hiding (encloseSep, indent, text)-import qualified Text.PrettyPrint.ANSI.Leijen as PP-+#define PrettyPrinter Text.PrettyPrint.ANSI.Leijen+#define PrettyPrinterSupportsHighlighting #include "PrettyInc.hs"+#undef PrettyPrinterSupportsHighlighting+#undef PrettyPrinter
Language/Thrift/Pretty/PrettyInc.hs view
@@ -2,18 +2,39 @@ -- ansi-wl-pprint in scope.  #if __GLASGOW_HASKELL__ >= 709-import Prelude hiding ((<$>), lines)+import Prelude hiding (lines, (<$>)) #else import Prelude hiding (lines) #endif -import Data.Text (Text, unpack, lines, strip)+import Data.Text     (Text, lines, strip, unpack)+import PrettyPrinter (Doc, align, double, dquotes, empty, nest, enclose, group, hcat, Pretty(..),+                      hsep, integer, line, linebreak, space, vsep, (<$$>),+                      (<$>), (<+>), (<>)) +import qualified PrettyPrinter as P+ import qualified Language.Thrift.Internal.Types as T  import Language.Thrift.Pretty.Types  +bold, dullblue, magenta, yellow, cyan :: Doc -> Doc+#ifdef PrettyPrinterSupportsHighlighting+bold = P.bold+dullblue = P.dullblue+magenta = P.magenta+yellow = P.yellow+cyan = P.cyan+#else+bold = id+dullblue = id+magenta = id+yellow = id+cyan = id+#endif++ -- | Top-level pretty printer for Thrift documents that uses the default -- configuration ('defaultConfig') for pretty printing. prettyPrint :: T.Program ann -> Doc@@ -38,14 +59,14 @@     pretty = header  include :: T.Include ann -> Doc-include T.Include{..} = text "include" <+> literal includePath+include T.Include{..} = reserved "include" <+> literal includePath  instance Pretty (T.Include a) where     pretty = include  namespace :: T.Namespace ann -> Doc namespace T.Namespace{..} = hsep-    [text "namespace", text namespaceLanguage, text namespaceName]+    [reserved "namespace", text namespaceLanguage, text namespaceName]  instance Pretty (T.Namespace a) where     pretty = namespace@@ -61,10 +82,10 @@  constant :: Config -> T.Const ann -> Doc constant c T.Const{..} = constDocstring $$ hsep-    [ text "const"+    [ reserved "const"     , typeReference c constValueType-    , text constName-    , text "="+    , declare constName+    , equals     , constantValue c constValue     ] @@ -74,13 +95,13 @@ service :: Config -> T.Service ann -> Doc service c@Config{indentWidth} T.Service{..} =   serviceDocstring $$-    text "service" <+> text serviceName <> extends <+>+    reserved "service" <+> declare serviceName <> extends <+>     block indentWidth (line <> line) (map (function c) serviceFunctions) <>     typeAnnots c serviceAnnotations   where     extends = case serviceExtends of       Nothing -> empty-      Just name -> space <> text "extends" <+> text name+      Just name -> space <> reserved "extends" <+> text name  instance Pretty (T.Service a) where     pretty = service defaultConfig@@ -97,14 +118,14 @@   where     exceptions = case functionExceptions of       Nothing -> empty-      Just es -> space <> text "throws" <+>+      Just es -> space <> reserved "throws" <+>         encloseSep indentWidth lparen rparen comma (map (field c) es)     returnType = case functionReturnType of-      Nothing -> text "void"+      Nothing -> reserved "void"       Just rt -> typeReference c rt     oneway =       if functionOneWay-          then text "oneway" <> space+          then reserved "oneway" <> space           else empty  instance Pretty (T.Function a) where@@ -124,15 +145,15 @@  typedef :: Config -> T.Typedef ann -> Doc typedef c T.Typedef{..} = typedefDocstring $$-    text "typedef" <+> typeReference c typedefTargetType <+> text typedefName-    <> typeAnnots c typedefAnnotations+    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 $$-    text "enum" <+> text enumName <+>+    reserved "enum" <+> declare enumName <+>       block indentWidth (comma <> line) (map (enumValue c) enumValues)     <> typeAnnots c enumAnnotations @@ -141,7 +162,7 @@  struct :: Config -> T.Struct ann -> Doc struct c@Config{indentWidth} T.Struct{..} = structDocstring $$-    text "struct" <+> text structName <+>+    reserved "struct" <+> declare structName <+>       block indentWidth line (map (\f -> field c f <> semi) structFields)     <> typeAnnots c structAnnotations @@ -150,7 +171,7 @@  union :: Config -> T.Union ann -> Doc union c@Config{indentWidth} T.Union{..} = unionDocstring $$-    text "union" <+> text unionName <+>+    reserved "union" <+> declare unionName <+>       block indentWidth line (map (\f -> field c f <> semi) unionFields)     <> typeAnnots c unionAnnotations @@ -159,7 +180,7 @@  exception :: Config -> T.Exception ann -> Doc exception c@Config{indentWidth} T.Exception{..} = exceptionDocstring $$-    text "exception" <+> text exceptionName <+>+    reserved "exception" <+> declare exceptionName <+>       block indentWidth line (map (\f -> field c f <> semi) exceptionFields)     <> typeAnnots c exceptionAnnotations @@ -168,7 +189,7 @@  senum :: Config -> T.Senum ann -> Doc senum c@Config{indentWidth} T.Senum{..} = senumDocstring $$-    text "senum" <+> text senumName <+>+    reserved "senum" <+> declare senumName <+>       encloseSep indentWidth lbrace rbrace comma (map literal senumValues)     <> typeAnnots c senumAnnotations @@ -176,34 +197,31 @@     pretty = senum defaultConfig  field :: Config -> T.Field ann -> Doc-field c f = fieldDocstring $$-    hcat [fid, req, typeReference c typ, space, text fieldName, def, annots]-  where-    T.Field-        { fieldValueType = typ-        , fieldRequiredness = requiredness-        , ..-        } = f-    fid = case fieldIdentifier of-      Nothing -> empty-      Just i -> integer i <> colon <> space-    req = case requiredness of-      Nothing -> empty-      Just r  -> fieldRequiredness r <> space-    def = case fieldDefaultValue of-      Nothing -> empty-      Just v -> space <> equals <+> constantValue c v-    annots = typeAnnots c fieldAnnotations+field c T.Field{..} = fieldDocstring $$ hcat+    [ case fieldIdentifier of+        Nothing -> empty+        Just i  -> yellow (integer i) <> colon <> space+    , case fieldRequiredness of+        Nothing -> empty+        Just r  -> requiredness r <> space+    , typeReference c fieldValueType+    , space+    , text fieldName+    , case fieldDefaultValue of+        Nothing -> empty+        Just v  -> space <> equals <+> constantValue c v+    , typeAnnots c fieldAnnotations+    ]  instance Pretty (T.Field a) where     pretty = field defaultConfig -fieldRequiredness :: T.FieldRequiredness -> Doc-fieldRequiredness T.Optional = text "optional"-fieldRequiredness T.Required = text "required"+requiredness :: T.FieldRequiredness -> Doc+requiredness T.Optional = reserved "optional"+requiredness T.Required = reserved "required"  instance Pretty T.FieldRequiredness where-    pretty = fieldRequiredness+    pretty = requiredness  enumValue :: Config -> T.EnumDef ann -> Doc enumValue c T.EnumDef{..} = enumDefDocstring $$@@ -211,7 +229,7 @@   where     value = case enumDefValue of       Nothing -> empty-      Just v  -> space <> text "=" <+> integer v+      Just v  -> space <> equals <+> integer v  instance Pretty (T.EnumDef a) where     pretty = enumValue defaultConfig@@ -221,23 +239,29 @@ typeReference c ft = case ft of   T.DefinedType t _ -> text t -  T.StringType anns -> text "string" <> typeAnnots c anns-  T.BinaryType anns -> text "binary" <> typeAnnots c anns-  T.SListType  anns -> text "slist"  <> typeAnnots c anns-  T.BoolType   anns -> text "bool"   <> typeAnnots c anns-  T.ByteType   anns -> text "byte"   <> typeAnnots c anns-  T.I16Type    anns -> text "i16"    <> typeAnnots c anns-  T.I32Type    anns -> text "i32"    <> typeAnnots c anns-  T.I64Type    anns -> text "i64"    <> typeAnnots c anns-  T.DoubleType anns -> text "double" <> typeAnnots c anns+  T.StringType anns -> reserved "string" <> typeAnnots c anns+  T.BinaryType anns -> reserved "binary" <> typeAnnots c anns+  T.SListType  anns -> reserved "slist"  <> typeAnnots c anns+  T.BoolType   anns -> reserved "bool"   <> typeAnnots c anns+  T.ByteType   anns -> reserved "byte"   <> typeAnnots c anns+  T.I16Type    anns -> reserved "i16"    <> typeAnnots c anns+  T.I32Type    anns -> reserved "i32"    <> typeAnnots c anns+  T.I64Type    anns -> reserved "i64"    <> typeAnnots c anns+  T.DoubleType anns -> reserved "double" <> typeAnnots c anns    T.MapType k v anns ->-    text "map" <> angles (typeReference c k <> comma <+> typeReference c v)-               <> typeAnnots c anns+    reserved "map"+        <> enclose langle rangle+            (typeReference c k <> comma <+> typeReference c v)+        <> typeAnnots c anns   T.SetType v anns ->-    text "set" <> angles (typeReference c v) <> typeAnnots c anns+    reserved "set"+        <> enclose langle rangle (typeReference c v)+        <> typeAnnots c anns   T.ListType v anns ->-    text "list" <> angles (typeReference c v) <> typeAnnots c anns+    reserved "list"+        <> enclose langle rangle (typeReference c v)+        <> typeAnnots c anns  instance Pretty (T.TypeReference a) where     pretty = typeReference defaultConfig@@ -275,18 +299,26 @@     pretty = typeAnnot  literal :: Text -> Doc-literal = dquotes . text+literal = cyan . dquotes . text     -- TODO: escaping?  text :: Text -> Doc-text = PP.text . unpack+text = P.text . unpack +reserved :: String -> Doc+reserved = magenta . P.text +op :: String -> Doc+op = yellow . P.text++declare :: Text -> Doc+declare = bold . text+ ($$) :: T.Docstring -> Doc -> Doc ($$) Nothing y = y ($$) (Just t) y = case lines (strip t) of   [] -> y-  ls -> wrapComments ls <$> y+  ls -> dullblue (wrapComments ls) <$> y   where     wrapComments ls = align . vsep       $ text "/**"@@ -297,7 +329,7 @@   block :: Int -> Doc -> [Doc] -> Doc-block indent s items = braces $+block indent s items = enclose lbrace rbrace $     nest indent (linebreak <> (items `sepBy` s)) <> linebreak  sepBy :: [Doc] -> Doc -> Doc@@ -313,3 +345,39 @@   where go [] = empty         go [x] = x         go (x:xs) = (x <> s) <$> go xs++lbrace :: Doc+lbrace = op "{"++rbrace :: Doc+rbrace = op "}"++lparen :: Doc+lparen = op "("++rparen :: Doc+rparen = op ")"++lbracket :: Doc+lbracket = op "["++rbracket :: Doc+rbracket = op "]"++langle :: Doc+langle = op "<"++rangle :: Doc+rangle = op ">"++comma :: Doc+comma = op ","++semi :: Doc+semi = op ";"++colon :: Doc+colon = op ":"++equals :: Doc+equals = op "="
README.md view
@@ -9,7 +9,8 @@ The parser uses [`parsers`] to allow plugging in the underlying parser. A default [`trifecta`] based parser is provided. -The pretty printer supports both, [wl-pprint] and [ansi-wl-pprint].+The pretty printer supports both, [`wl-pprint`] and [`ansi-wl-pprint`]. The+`ansi-wl-pprint`-based pretty printer produces colored output.  Haddock-generated docs are available on [Hackage] and [here]. @@ -17,7 +18,7 @@   [Thrift IDL format]: http://thrift.apache.org/docs/idl   [`parsers`]: http://hackage.haskell.org/package/parsers   [`trifecta`]: http://hackage.haskell.org/package/trifecta-  [wl-pprint]: http://hackage.haskell.org/package/wl-pprint-  [ansi-wl-pprint]: http://hackage.haskell.org/package/ansi-wl-pprint+  [`wl-pprint`]: http://hackage.haskell.org/package/wl-pprint+  [`ansi-wl-pprint`]: http://hackage.haskell.org/package/ansi-wl-pprint   [Hackage]: http://hackage.haskell.org/package/language-thrift   [here]: http://abhinavg.net/language-thrift/
language-thrift.cabal view
@@ -1,5 +1,5 @@ name: language-thrift-version: 0.6.0.1+version: 0.6.1.0 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -49,6 +49,7 @@     main-is: Main.hs     build-depends:         base -any,+        ansi-wl-pprint -any,         hspec >=2.0,         hspec-discover >=2.1,         QuickCheck >=2.5,
test/Language/Thrift/TypesSpec.hs view
@@ -3,60 +3,78 @@  import Test.Hspec import Test.Hspec.QuickCheck-import Text.PrettyPrint.Leijen (Doc)-import Text.Parser.Token       (whiteSpace)+import Text.Parser.Token     (whiteSpace) +import qualified Text.PrettyPrint.ANSI.Leijen as PPA (Doc, plain)+import qualified Text.PrettyPrint.Leijen      as PP (Doc)+ import Language.Thrift.Arbitrary () import TestUtils -import qualified Language.Thrift.Parser as P-import qualified Language.Thrift.Pretty as PP+import qualified Language.Thrift.Parser      as P+import qualified Language.Thrift.Pretty      as PP+import qualified Language.Thrift.Pretty.ANSI as PPA  spec :: Spec spec =     describe "Parser and Printer" $ do          prop "can round-trip type references" $-            roundtrip PP.typeReference P.typeReference+            roundtrip PP.typeReference PPA.typeReference P.typeReference          prop "can round-trip constant values" $-            roundtrip PP.constantValue P.constantValue+            roundtrip PP.constantValue PPA.constantValue P.constantValue          prop "can round-trip typedefs" $-            roundtrip PP.typedef (whiteSpace >> P.typedef)+            roundtrip PP.typedef PPA.typedef (whiteSpace >> P.typedef)          prop "can round-trip enums" $-            roundtrip PP.enum (whiteSpace >> P.enum)+            roundtrip PP.enum PPA.enum (whiteSpace >> P.enum)          prop "can round-trip structs" $-            roundtrip PP.struct (whiteSpace >> P.struct)+            roundtrip PP.struct PPA.struct (whiteSpace >> P.struct)          prop "can round-trip unions" $-            roundtrip PP.union (whiteSpace >> P.union)+            roundtrip PP.union PPA.union (whiteSpace >> P.union)          prop "can round-trip exceptions" $-            roundtrip PP.exception (whiteSpace >> P.exception)+            roundtrip PP.exception PPA.exception (whiteSpace >> P.exception)          prop "can round-trip senums" $-            roundtrip PP.senum (whiteSpace >> P.senum)+            roundtrip PP.senum PPA.senum (whiteSpace >> P.senum)          prop "can round-trip services" $-            roundtrip PP.service (whiteSpace >> P.service)+            roundtrip PP.service PPA.service (whiteSpace >> P.service)          prop "can round-trip constants" $-            roundtrip PP.constant (whiteSpace >> P.constant)+            roundtrip PP.constant PPA.constant (whiteSpace >> P.constant)          prop "can round-trip includes" $-            roundtrip (const PP.include) (whiteSpace >> P.include)+            roundtrip+                (const PP.include)+                (const PPA.include)+                (whiteSpace >> P.include)          prop "can round-trip namespaces" $-            roundtrip (const PP.namespace) (whiteSpace >> P.namespace)+            roundtrip+                (const PP.namespace)+                (const PPA.namespace)+                (whiteSpace >> P.namespace)          prop "can round-trip documents" $-            roundtrip PP.program P.program+            roundtrip PP.program PPA.program P.program   roundtrip-    :: (Show a, Eq a) => (PP.Config -> a -> Doc) -> Parser a -> a -> IO ()-roundtrip printer parser value =-    assertParses parser value (show $ printer (PP.Config 4) value)+    :: (Show a, Eq a)+    => (PP.Config  -> a ->  PP.Doc)+    -> (PPA.Config -> a -> PPA.Doc)+    ->  Parser a   -> a -> IO ()+roundtrip printer ansiPrinter parser value = do+    assertParses parser value+        (show $ printer (PP.Config 4) value)++    -- For the ANSI pretty printer, we need to discard the color information+    -- for the document to be parseable.+    assertParses parser value+        (show . PPA.plain $ ansiPrinter (PPA.Config 4) value)