language-thrift 0.3.0.0 → 0.4.0.0

raw patch · 9 files changed

+659/−50 lines, 9 filesdep +QuickCheckdep +hspecdep +hspec-discoverdep ~basedep ~textdep ~trifectaPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, hspec, hspec-discover, language-thrift, wl-pprint

Dependency ranges changed: base, text, trifecta

API changes (from Hackage documentation)

Files

• CHANGES.md +17/−7
• Language/Thrift/Parser.hs +32/−30
• Language/Thrift/Pretty.hs +265/−0
• Language/Thrift/Types.hs +2/−2
• README.md +8/−4
• examples/reformatIDL.hs +25/−0
• language-thrift.cabal +26/−7
• test/Language/Thrift/TypesSpec.hs +283/−0
• test/Spec.hs +1/−0

@@ -1,24 +1,34 @@+0.4.0.0+=======++-   Add pretty printing module.+-   Parsers of different constructors are no longer exported by the parsing+    module; instead only the parsers for their corresponding types are+    exported.+-   Rename record for field requiredness from `fieldRequiredNess` to+    `fieldRequiredness`.+ 0.3.0.0 =======  -   Allow changing the underlying parser to any parser that implements the-    `TokenParsing` class from `parsers`--   Add `thriftIDLParser` for standard use cases+    `TokenParsing` class from `parsers`.+-   Add `thriftIDLParser` for standard use cases. -   Add `Language.Thrift.Parser.Trifecta` with a standard Trifecta-based-    parser+    parser.  0.2.0.0 ======= --   Track starting positions in source annotations--   Move docs to a separate field+-   Track starting positions in source annotations.+-   Move docs to a separate field.  0.1.0.1 ======= --   Allow `base` 4.9+-   Allow `base` 4.9.  0.1.0.0 ======= --   Initial release+-   Initial release.

@@ -24,36 +24,21 @@ -- for example, you could define a string value for an int constant. -- module Language.Thrift.Parser-    (--      thriftIDL--    -- * Parser type--    , ThriftParser-    , runThriftParser+    ( thriftIDL -    -- * Parser components+    -- * Components      , program     , header     , definition-    , typeDefinition-    , typedef-    , enum-    , enumDef-    , senum-    , struct-    , union-    , exception-    , fieldRequiredness+    , function     , fieldType-    , field-    , constant     , constantValue-    , service-    , function-    , typeAnnotations++    -- * Parser++    , ThriftParser+    , runThriftParser     ) where  import Control.Applicative@@ -176,9 +161,10 @@               ]             sanitizeDocstring :: Text -> Text             sanitizeDocstring =-                Text.unlines . map (Text.dropWhile ignore) . Text.lines-              where-                ignore c = c == '*' || c == ' '+                Text.intercalate "\n"+              . map (Text.dropWhile ignore)+              . Text.lines+              where ignore c = c == '*' || c == ' '   -- | Type of identifiers allowed by Thrift.@@ -234,7 +220,9 @@ -- > data Foo = Foo { bar :: Bar, doc :: Docstring, pos :: Delta } -- > -- > parseFoo = docstring $ Foo <$> parseBar-docstring :: Monad p => ThriftParser p n (T.Docstring -> n -> a) -> ThriftParser p n a+docstring+    :: (Functor p, Monad p)+    => ThriftParser p n (T.Docstring -> n -> a) -> ThriftParser p n a docstring p = lastDocstring >>= \s -> do     annot <- ThriftParser . lift $ Reader.ask >>= lift     p <*> pure s <*> pure annot@@ -368,13 +356,27 @@   constList :: (TokenParsing p, MonadPlus p) => ThriftParser p n [T.ConstValue]-constList = brackets $ commaSep (constantValue <* optionalSep)+constList = symbolic '[' *> loop []+  where+    loop xs = choice [+        symbolic ']' *> return (reverse xs)+      , (:) <$> (constantValue <* optionalSep)+            <*> pure xs+            >>= loop+      ]   constMap     :: (TokenParsing p, MonadPlus p)     => ThriftParser p n [(T.ConstValue, T.ConstValue)]-constMap = braces $ commaSep constantValuePair+constMap = symbolic '{' *> loop []+  where+    loop xs = choice [+        symbolic '}' *> return (reverse xs)+      , (:) <$> (constantValuePair <* optionalSep)+            <*> pure xs+            >>= loop+      ]   constantValuePair@@ -455,7 +457,7 @@  -- | Type annotations on entitites. ----- > ("foo" = "bar", "baz" = "qux")+-- > (foo = "bar", baz = "qux") -- -- These do not usually affect code generation but allow for custom logic if -- writing your own code generator.

@@ -0,0 +1,265 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE NamedFieldPuns    #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+-- |+-- Module      :  Language.Thrift.Pretty+-- Copyright   :  (c) Abhinav Gupta 2015+-- License     :  BSD3+--+-- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>+-- Stability   :  experimental+--+-- This module provides a pretty printer for Thrift IDLs. The pretty printer+-- prserves docstrings specified for types.+--+-- The specifics of the printer can be configured using 'Config' objects.+--+module Language.Thrift.Pretty+    (+      prettyPrint++    -- * Components++    , program+    , header+    , definition+    , function+    , fieldType+    , constantValue++    -- * Configuration++    , Config(..)+    , defaultConfig+    ) where++#if __GLASGOW_HASKELL__ >= 709+import Prelude hiding ((<$>))+#endif++import Data.Text               (Text, unpack)+import Text.PrettyPrint.Leijen hiding (encloseSep, indent, text)++import qualified Data.Text               as Text+import qualified Language.Thrift.Types   as T+import qualified Text.PrettyPrint.Leijen as PP+++-- | Configuration for the pretty printer.+data Config = Config+    { indentWidth :: Int+    -- ^ Number of spaces to use for indentation.+    } deriving (Show, Ord, Eq)+++-- | Default pretty printing configuration.+defaultConfig :: Config+defaultConfig = Config 4+++-- | Top-level pretty printer for Thrift documents that uses the default+-- configuration ('defaultConfig') for pretty printing.+prettyPrint :: T.Program ann -> Doc+prettyPrint = program defaultConfig+++-- | Pretty print a Thrift IDL.+program :: Config -> T.Program ann -> Doc+program c T.Program{..} =+    vsep (map header programHeaders) <$> line <>+    map (definition c) programDefinitions `sepBy` (line <> line)+++-- | Print the headers for a program.+header :: T.Header -> Doc+header T.Include{..} =+    text "include" <+> literal includePath+header T.Namespace{..} = hsep+    [text "namespace", text namespaceLanguage, text namespaceName]+++-- | Print a constant, type, or service definition.+definition :: Config -> T.Definition ann -> Doc+definition c T.ConstDefinition{..} = constDocstring $$ hsep+    [ text "const"+    , fieldType c constType+    , text constName+    , text "="+    , constantValue c constValue+    ]++definition c T.TypeDefinition{typeDefinition = def, ..} =+    typeDefinition c def <> typeAnnots c typeAnnotations++definition c@Config{indentWidth} T.ServiceDefinition{..} =+  serviceDocstring $$+    text "service" <+> text 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+++-- | 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+  where+    exceptions = case functionExceptions of+      Nothing -> empty+      Just es -> space <> text "throws" <+>+        encloseSep indentWidth lparen rparen comma (map (field c) es)+    returnType = case functionReturnType of+      Nothing -> text "void"+      Just rt -> fieldType c rt+    oneway =+      if functionOneWay+          then text "oneway" <> space+          else empty+++typeDefinition :: Config -> T.Type ann -> Doc+typeDefinition c@Config{indentWidth} t = case t of+  T.Typedef{..} -> typedefDocstring $$+    text "typedef" <+> fieldType c typedefType <+> text typedefName+  T.Enum{..} -> enumDocstring $$+    text "enum" <+> text enumName <+>+      block indentWidth (comma <> line) (map (enumValue c) enumValues)+  T.Struct{..} -> structDocstring $$+    text "struct" <+> text structName <+>+      block indentWidth line (map (\f -> field c f <> semi) structFields)+  T.Union{..} -> unionDocstring $$+    text "union" <+> text unionName <+>+      block indentWidth line (map (\f -> field c f <> semi) unionFields)+  T.Exception{..} -> exceptionDocstring $$+    text "exception" <+> text exceptionName <+>+      block indentWidth line (map (\f -> field c f <> semi) exceptionFields)+  T.Senum{..} -> senumDocstring $$+    text "senum" <+> text senumName <+>+      encloseSep indentWidth lbrace rbrace comma (map literal senumValues)+++field :: Config -> T.Field ann -> Doc+field c T.Field{fieldType = typ, ..} = fieldDocstring $$+    hcat [fid, req, fieldType c typ, space, text fieldName, def, annots]+  where+    fid = case fieldIdentifier of+      Nothing -> empty+      Just i -> integer i <> colon <> space+    req = case fieldRequiredness of+      Nothing -> empty+      Just T.Optional -> text "optional "+      Just T.Required -> text "required "+    def = case fieldDefault of+      Nothing -> empty+      Just v -> space <> equals <+> constantValue c v+    annots = typeAnnots c fieldAnnotations+++enumValue :: Config -> T.EnumDef ann -> Doc+enumValue c T.EnumDef{..} = enumDefDocstring $$+    text enumDefName <> value <> typeAnnots c enumDefAnnotations+  where+    value = case enumDefValue of+      Nothing -> empty+      Just v  -> space <> text "=" <+> integer v+++-- | Pretty print a field type.+fieldType :: Config -> T.FieldType -> Doc+fieldType 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.MapType k v anns ->+    text "map" <> angles (fieldType c k <> comma <+> fieldType c v)+               <> typeAnnots c anns+  T.SetType v anns ->+    text "set" <> angles (fieldType c v) <> typeAnnots c anns+  T.ListType v anns ->+    text "list" <> angles (fieldType c v) <> typeAnnots c anns+++-- | Pretty print a constant value.+constantValue :: Config -> T.ConstValue -> Doc+constantValue c@Config{indentWidth} value = case value of+  T.ConstInt i -> integer i+  T.ConstFloat f -> double f+  T.ConstLiteral l -> literal l+  T.ConstIdentifier i -> text i++  T.ConstList vs ->+    encloseSep indentWidth lbracket rbracket comma $+        map (constantValue c) vs+  T.ConstMap vs ->+    encloseSep indentWidth lbrace rbrace comma $+      map (\(k, v) -> constantValue c k <> colon <+> constantValue c v)+          vs+++typeAnnots :: Config -> [T.TypeAnnotation] -> Doc+typeAnnots _ [] = empty+typeAnnots Config{indentWidth} anns =+    space <> encloseSep indentWidth lparen rparen comma (map typeAnnot anns)+++typeAnnot :: T.TypeAnnotation -> Doc+typeAnnot T.TypeAnnotation{..} =+    text typeAnnotationName <+> equals <+> literal typeAnnotationValue+++literal :: Text -> Doc+literal = dquotes . text+    -- TODO: escaping?++text :: Text -> Doc+text = PP.text . unpack+++($$) :: T.Docstring -> Doc -> Doc+($$) Nothing y = y+($$) (Just t) y = case Text.lines (Text.strip t) of+  [] -> y+  ls -> wrapComments ls <$> y+  where+    wrapComments ls = align . vsep+      $ text "/**"+      : map (\l -> text " *" <+> text l) ls+     ++ [text " */"]++infixr 1 $$+++block :: Int -> Doc -> [Doc] -> Doc+block indent s items = braces $+    nest indent (linebreak <> (items `sepBy` s)) <> linebreak++sepBy :: [Doc] -> Doc -> Doc+sepBy [] _ = empty+sepBy [x] _ = x+sepBy (x:xs) s = x <> s <> sepBy xs s++encloseSep :: Int -> Doc -> Doc -> Doc -> [Doc] -> Doc+encloseSep _ left right _ [] = left <> right+encloseSep _ left right _ [v] = left <> v <> right+encloseSep indent left right s vs = group $+    nest indent (left <$$> go vs) <$$> right+  where go [x] = x+        go (x:xs) = (x <> s) <$> go xs

@@ -201,7 +201,7 @@     --     -- While this is optional, it is recommended that Thrift files always     -- contain specific field IDs.-    , fieldRequiredNess :: Maybe FieldRequiredness+    , fieldRequiredness :: Maybe FieldRequiredness     -- ^ Whether this field is required or not.     --     -- Behavior may differ between languages if requiredness is not specified.@@ -311,7 +311,7 @@  -- | Type annoations may be added in various places in the form, ----- > ("foo" = "bar", "baz" = "qux")+-- > (foo = "bar", baz = "qux") -- -- These do not usually affect code generation but allow for custom logic if -- writing your own code generator.

@@ -1,15 +1,19 @@-`language-thrift` provides a parser for the [Thrift IDL format]. In addition to-parsing the IDL, it keeps track of Javadoc-style comments (`/** ... */`) and-attaches them to the type, service, function, or field, above which they were-added.+`language-thrift` provides a parser and pretty printer for the [Thrift IDL+format]. In addition to parsing the IDL, it keeps track of Javadoc-style+comments (`/** ... */`) and attaches them to the type, service, function, or+field, above which they were added. These are retained when the document is+sent through the pretty printer.  The parser uses [`parsers`] to allow plugging in the underlying parser. A default [`trifecta`] based parser is provided. +The pretty printer uses [wl-pprint].+ Haddock-generated docs are available on [Hackage] and [here].    [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   [Hackage]: http://hackage.haskell.org/package/language-thrift   [here]: http://abhinavg.net/language-thrift/

@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++-- This program reads Thrift IDLs from stdin and writes their reformatted+-- versions back to stdout.+--+-- Docstrings in the IDL are preserved but COMMENTS WILL BE LOST.++import System.IO (stderr)+import           Text.Trifecta                (Result (..), parseString)+import           Text.Trifecta.Delta          (Delta (Directed))+import           Text.PrettyPrint.Leijen      (putDoc)++import qualified Text.PrettyPrint.ANSI.Leijen as AnsiPP++import Language.Thrift.Pretty (prettyPrint)+import Language.Thrift.Parser.Trifecta (thriftIDL)++main :: IO ()+main = do+    result <- parseString thriftIDL (Directed "stdin" 0 0 0 0) <$> getContents+    case result of+        Success p -> putDoc (prettyPrint p) >> putStrLn ""+        Failure doc ->+            AnsiPP.displayIO stderr $ AnsiPP.renderPretty 0.8 80 doc

@@ -1,6 +1,6 @@ name          : language-thrift-version       : 0.3.0.0-synopsis      : Parser for the Thrift IDL format.+version       : 0.4.0.0+synopsis      : Parser and pretty printer for the Thrift IDL format. homepage      : https://github.com/abhinav/language-thrift license       : BSD3 license-file  : LICENSE@@ -10,7 +10,7 @@ build-type    : Simple cabal-version : >=1.10 description   :-    This package provides a parser for the+    This package provides a parser and pretty printer for the     <http://thrift.apache.org/docs/idl Thrift IDL format>. extra-source-files:     README.md@@ -20,12 +20,31 @@ library   exposed-modules  : Language.Thrift.Parser                    , Language.Thrift.Parser.Trifecta+                   , Language.Thrift.Pretty                    , Language.Thrift.Types-  build-depends    : base     >= 4.7  && < 4.9+  build-depends    : base      >= 4.7  && < 4.9                    , mtl-                   , text     >= 1.2-                   , parsers  >= 0.12 && < 0.13-                   , trifecta >= 1.5  && < 1.6+                   , text      >= 1.2+                   , parsers   >= 0.12 && < 0.13+                   , trifecta  >= 1.5  && < 1.6+                   , wl-pprint >= 1.1+  default-language : Haskell2010+++test-suite spec+  type           : exitcode-stdio-1.0+  hs-source-dirs : test+  main-is        : Spec.hs+  other-modules  : Language.Thrift.TypesSpec+  build-depends  : base+                 , hspec          >= 2.0+                 , hspec-discover >= 2.1+                 , QuickCheck     >= 2.5+                 , text+                 , trifecta+                 , wl-pprint++                 , language-thrift   default-language : Haskell2010  source-repository head

@@ -0,0 +1,283 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Language.Thrift.TypesSpec where++#if __GLASGOW_HASKELL__ < 709+import Control.Applicative+#endif++import Control.Monad           (unless)+import Data.Text               (Text)+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+import Text.PrettyPrint.Leijen (Doc)++import Text.Trifecta       (parseString)+import Text.Trifecta.Delta (Delta (..))++import qualified Data.Text     as Text+import qualified Text.Trifecta as Tri++import qualified Language.Thrift.Parser as P+import qualified Language.Thrift.Pretty as PP+import qualified Language.Thrift.Types  as T+++-- | Halve the maximum size of generated values.+--+-- Generally speaking, it's a good idea to use this for calls that will+-- recursively generate lists of things so that they terminate at some point.+halfSize :: Gen a -> Gen a+halfSize = scale (\n -> truncate (fromIntegral n / 2 :: Double))++newtype Identifier = Identifier { getIdentifier :: Text }++instance Arbitrary Identifier where+    arbitrary = Identifier . Text.pack <$> listOf1 (elements charset)+      where+        charset = ['a'..'z'] ++ ['A'..'Z']++newtype Docstring = Docstring { getDocstring :: Maybe Text }++instance Arbitrary Docstring where+    arbitrary = Docstring <$> oneof [return Nothing, comment]+      where+        commentLine =+            Text.unwords <$> listOf (getIdentifier <$> arbitrary)+        comment = do+            s <- Text.strip . Text.unlines <$> listOf1 (halfSize commentLine)+            if Text.null s+                then return Nothing+                else return (Just s)+++instance Arbitrary (T.Program ()) where+    arbitrary = T.Program <$> arbitrary <*> arbitrary+++instance Arbitrary (T.Definition ()) where+    arbitrary = oneof [arbitraryConst, arbitraryType, arbitraryService]+      where+        arbitraryConst =+            T.ConstDefinition+                <$> arbitrary+                <*> (getIdentifier <$> arbitrary)+                <*> arbitrary+                <*> (getDocstring <$> arbitrary)+                <*> pure ()++        arbitraryType =+            T.TypeDefinition+                <$> arbitrary+                <*> arbitrary++        arbitraryService =+            T.ServiceDefinition+                <$> (getIdentifier <$> arbitrary)+                <*> (fmap getIdentifier <$> arbitrary)+                <*> arbitrary+                <*> arbitrary+                <*> (getDocstring <$> arbitrary)+                <*> pure ()+++instance Arbitrary T.Header where+    arbitrary = oneof+        [ T.Include   <$> (getIdentifier <$> arbitrary)+        , T.Namespace <$> elements scopes+                      <*> (getIdentifier <$> arbitrary)+        ]+      where+        scopes = ["py", "rb", "java", "hs", "cpp"]+++instance Arbitrary (T.Field ()) where+    arbitrary =+        T.Field+            <$> (fmap getPositive <$> arbitrary)+            <*> arbitrary+            <*> halfSize arbitrary+            <*> (getIdentifier <$> arbitrary)+            <*> halfSize arbitrary+            <*> arbitrary+            <*> (getDocstring <$> arbitrary)+            <*> pure ()+++instance Arbitrary (T.Function ()) where+    arbitrary =+        T.Function+            <$> elements [True, False]+            <*> arbitrary+            <*> (getIdentifier <$> arbitrary)+            <*> arbitrary+            <*> arbitrary+            <*> arbitrary+            <*> (getDocstring <$> arbitrary)+            <*> pure ()+++instance Arbitrary T.TypeAnnotation where+    arbitrary =+        T.TypeAnnotation+            <$> (getIdentifier <$> arbitrary)+            <*> (getIdentifier <$> arbitrary)+++instance Arbitrary (T.EnumDef ()) where+    arbitrary =+        T.EnumDef+            <$> (getIdentifier <$> arbitrary)+            <*> arbitrary+            <*> arbitrary+            <*> (getDocstring <$> arbitrary)+            <*> pure ()+++instance Arbitrary (T.Type ()) where+    arbitrary = oneof+        [ T.Typedef+            <$> arbitrary+            <*> (getIdentifier <$> arbitrary)+            <*> (getDocstring <$> arbitrary)+            <*> pure ()+        , T.Enum+            <$> (getIdentifier <$> arbitrary)+            <*> arbitrary+            <*> (getDocstring <$> arbitrary)+            <*> pure ()+        , T.Struct+            <$> (getIdentifier <$> arbitrary)+            <*> arbitrary+            <*> (getDocstring <$> arbitrary)+            <*> pure ()+        , T.Union+            <$> (getIdentifier <$> arbitrary)+            <*> arbitrary+            <*> (getDocstring <$> arbitrary)+            <*> pure ()+        , T.Exception+            <$> (getIdentifier <$> arbitrary)+            <*> arbitrary+            <*> (getDocstring <$> arbitrary)+            <*> pure ()+        , T.Senum+            <$> (getIdentifier <$> arbitrary)+            <*> (map getIdentifier <$> arbitrary)+            <*> (getDocstring <$> arbitrary)+            <*> pure ()+        ]+++instance Arbitrary (T.FieldRequiredness) where+    arbitrary = elements [T.Required, T.Optional]++instance Arbitrary T.FieldType where+    arbitrary = oneof+        [ T.DefinedType . getIdentifier <$> arbitrary++        , T.StringType <$> arbitrary+        , T.BinaryType <$> arbitrary+        , T.SListType  <$> arbitrary+        , T.BoolType   <$> arbitrary+        , T.ByteType   <$> arbitrary+        , T.I16Type    <$> arbitrary+        , T.I32Type    <$> arbitrary+        , T.I64Type    <$> arbitrary+        , T.DoubleType <$> arbitrary++        , halfSize $+            T.MapType <$> arbitrary <*> arbitrary <*> arbitrary+        , halfSize $+            T.SetType  <$> arbitrary <*> arbitrary+        , halfSize $+            T.ListType <$> arbitrary <*> arbitrary+        ]+++newtype BasicConstValue = BasicConstValue {+    getBasicConstValue :: T.ConstValue+  }+++instance Arbitrary BasicConstValue where+    arbitrary = BasicConstValue <$> oneof+        [ T.ConstFloat                      <$> choose (0.0, 10000.0)+        , T.ConstInt                        <$> arbitrary+        , T.ConstLiteral    . getIdentifier <$> arbitrary+        , T.ConstIdentifier . getIdentifier <$> arbitrary+        ]++-- | newtype wrapper around const values so that we're not generating lists+-- and maps that go on forever.+newtype FiniteConstValue =+    FiniteConstValue { getFiniteConstValue :: T.ConstValue }+++instance Arbitrary FiniteConstValue where+    arbitrary = FiniteConstValue <$> oneof+        [ basicConsts+        , T.ConstList <$> constList+        , T.ConstMap  <$> constMap+        ]+      where+        basicConsts = getBasicConstValue <$> arbitrary+        constList+            = listOf $ halfSize $ getFiniteConstValue <$> arbitrary+        constMap+            = listOf $+                (,) <$> basicConsts+                    <*> halfSize (getFiniteConstValue <$> arbitrary)+++instance Arbitrary T.ConstValue where+    arbitrary = getFiniteConstValue <$> arbitrary+++spec :: Spec+spec =+    describe "Can round trip" $ do++        prop "field types" $+            roundtrip PP.fieldType P.fieldType++        prop "constant values" $+            roundtrip PP.constantValue P.constantValue++        prop "functions" $+            roundtrip PP.function (Tri.whiteSpace *> P.function)++        prop "definitions" $+            roundtrip PP.definition (Tri.whiteSpace *> P.definition)++        prop "headers" $+            roundtrip (const PP.header) P.header++        prop "documents" $+            roundtrip PP.program P.program+++roundtrip+    :: (Show a, Eq a)+    => (PP.Config -> a -> Doc)+    -> P.ThriftParser Tri.Parser () a+    -> a+    -> IO ()+roundtrip printer parser value = do+  let pretty = show . printer (PP.Config 4)+      triParser = P.runThriftParser (return ()) parser+      result =+          parseString triParser (Directed "memory" 0 0 0 0) (pretty value)+  case result of+    Tri.Success parsed ->+      unless (parsed == value) $ expectationFailure $+        "expected: " ++ show value ++ "\n but got: " ++ show parsed +++        "\n\n expected (pretty): " ++ pretty value +++        "\n but got (pretty): " ++ pretty parsed+    Tri.Failure msg -> expectationFailure $+      "failed to parse "  ++ pretty value +++      "\n with " ++ show msg

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}