language-thrift 0.9.0.2 → 0.10.0.0

raw patch · 9 files changed

+188/−223 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.md +8/−1
• examples/generateHaskellTypes.hs +15/−28
• language-thrift.cabal +1/−3
• src/Language/Thrift/Internal/AST.hs +81/−75
• src/Language/Thrift/Parser.hs +29/−42
• src/Language/Thrift/Pretty.hs +48/−32
• src/Language/Thrift/Types.hs +0/−15
• test/Language/Thrift/ASTSpec.hs +0/−6
• test/Language/Thrift/Arbitrary.hs +6/−21

@@ -1,3 +1,11 @@+0.10.0.0 (2016-09-25)+=====================++-   Breaking: Consolidate struct, union, and exception AST types into a single+    data type: `Struct`. Whether the object is a struct, union, or exception is+    now determined by the `StructKind` attribute.+-   Breaking: Deprecated module `Language.Thrift.Types` has now been removed.+ 0.9.0.2 (2016-08-31) ==================== @@ -142,4 +150,3 @@ ====================  -   Initial release.-

@@ -109,6 +109,21 @@     renderDef T.EnumDef{..} = enumDefDocstring $$ typeName enumDefName  renderStruct :: Show a => T.Struct a -> Doc+renderStruct s@T.Struct{T.structKind = T.UnionKind, ..} =+    hang 4+      (structDocstring $$+          text "data" <+> typeName structName <$>+          encloseSep (text "= ") empty (text " | ")+                     (map renderField structFields))+    <$$> indent 4 derivingClause+  where+    renderField (T.Field _ _ ftype fname _ _ docstring _) =+        docstring $$ fieldName </> renderTypeReference ftype+      where+        fieldName = text . unpack $ Text.concat+          [ underscoresToCamelCase False structName+          , underscoresToCamelCase False fname+          ] renderStruct T.Struct{..} = structDocstring $$     text "data" <+> typeName structName </>     equals <+> typeName structName <$$>@@ -121,32 +136,6 @@         map (renderStructField $ underscoresToCamelCase True structName)              structFields -renderException :: Show a => T.Exception a -> Doc-renderException T.Exception{..} = renderStruct T.Struct-    { T.structName = exceptionName-    , T.structFields = exceptionFields-    , T.structAnnotations = exceptionAnnotations-    , T.structDocstring = exceptionDocstring-    , T.structSrcAnnot = exceptionSrcAnnot-    }--renderUnion :: Show a => T.Union a -> Doc-renderUnion T.Union{..} =-    hang 4-      (unionDocstring $$-          text "data" <+> typeName unionName <$>-          encloseSep (text "= ") empty (text " | ")-                     (map renderField unionFields))-    <$$> indent 4 derivingClause-  where-    renderField (T.Field _ _ ftype fname _ _ docstring _) =-        docstring $$ fieldName </> renderTypeReference ftype-      where-        fieldName = text . unpack $ Text.concat-          [ underscoresToCamelCase False unionName-          , underscoresToCamelCase False fname-          ]- derivingClause :: Doc derivingClause =     text "deriving" <+> tupled (map text ["Show", "Ord", "Eq"])@@ -154,9 +143,7 @@ renderType :: Show a => T.Type a -> Doc renderType (T.TypedefType   t) = renderTypedef t renderType (T.EnumType      t) = renderEnum t-renderType (T.ExceptionType t) = renderException t renderType (T.StructType    t) = renderStruct t-renderType (T.UnionType     t) = renderUnion t renderType                  t  = error $ "Unsupported type: " ++ show t  typeName :: Text -> Doc

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           language-thrift-version:        0.9.0.2+version:        0.10.0.0 bug-reports:    https://github.com/abhinav/language-thrift/issues cabal-version:  >= 1.10 build-type:     Simple@@ -46,7 +46,6 @@         Language.Thrift.AST         Language.Thrift.Parser         Language.Thrift.Pretty-        Language.Thrift.Types     other-modules:         Language.Thrift.Internal.AST         Language.Thrift.Internal.Lens@@ -81,7 +80,6 @@         Language.Thrift.Internal.Reserved         Language.Thrift.Parser         Language.Thrift.Pretty-        Language.Thrift.Types         Language.Thrift.Arbitrary         Language.Thrift.ASTSpec         Language.Thrift.ParserSpec

@@ -34,9 +34,25 @@     , targetType      , Enum(..)++    , StructKind(..)     , Struct(..)-    , Union(..)-    , Exception(..)+    , kind++    , Union+    , unionName+    , unionFields+    , unionAnnotations+    , unionDocstring+    , unionSrcAnnot++    , Exception+    , exceptionName+    , exceptionFields+    , exceptionAnnotations+    , exceptionDocstring+    , exceptionSrcAnnot+     , Senum(..)      , FieldRequiredness(..)@@ -73,10 +89,10 @@     , HasValueType(..)     ) where -import Data.Data             (Data, Typeable)-import Data.Text             (Text)-import GHC.Generics          (Generic)-import Prelude               hiding (Enum)+import Data.Data    (Data, Typeable)+import Data.Text    (Text)+import GHC.Generics (Generic)+import Prelude      hiding (Enum)  import Language.Thrift.Internal.Lens @@ -501,13 +517,32 @@ instance HasAnnotations (Enum a) where     annotations = lens enumAnnotations (\s a -> s { enumAnnotations = a }) --- | A struct definition+-- | The kind of the struct.+data StructKind+    = StructKind       -- ^ @struct@+    | UnionKind        -- ^ @union@+    | ExceptionKind    -- ^ @exception@+  deriving (Show, Ord, Eq, Data, Typeable, Generic)++-- | A struct, union, or exception definition. -- -- > struct User { -- >     1: Role role = Role.User; -- > }+--+-- > union Value {+-- >     1: string stringValue;+-- >     2: i32 intValue;+-- > }+--+-- > exception UserDoesNotExist {+-- >     1: optional string message+-- >     2: required string username+-- > } data Struct srcAnnot = Struct-    { structName        :: Text+    { structKind        :: StructKind+    -- ^ Kind of the structure.+    , structName        :: Text     -- ^ Name of the struct.     , structFields      :: [Field srcAnnot]     -- ^ Fields defined in the struct.@@ -519,6 +554,9 @@     }   deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor) +kind :: Lens (Struct a) StructKind+kind = lens structKind (\s a -> s { structKind = a })+ instance HasName (Struct a) where     name = lens structName (\s a -> s { structName = a }) @@ -535,72 +573,52 @@     annotations = lens structAnnotations (\s a -> s { structAnnotations = a })  -- | A union of other types.------ > union Value {--- >     1: string stringValue;--- >     2: i32 intValue;--- > }-data Union srcAnnot = Union-    { unionName        :: Text-    -- ^ Name of the union.-    , unionFields      :: [Field srcAnnot]-    -- ^ Fields defined in the union.-    , unionAnnotations :: [TypeAnnotation]-    -- ^ Annotations added to the union.-    , unionDocstring   :: Docstring-    -- ^ Documentation.-    , unionSrcAnnot    :: srcAnnot-    }-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)+type Union = Struct+{-# DEPRECATED Union "The type has been consolidated into Struct." #-} -instance HasName (Union a) where-    name = lens unionName (\s a -> s { unionName = a })+unionName :: Union a -> Text+unionName = structName+{-# DEPRECATED unionName "Use structName." #-} -instance HasFields Union where-    fields = lens unionFields (\s a -> s { unionFields = a })+unionFields :: Union a -> [Field a]+unionFields = structFields+{-# DEPRECATED unionFields "Use structFields." #-} -instance HasSrcAnnot Union where-    srcAnnot = lens unionSrcAnnot (\s a -> s { unionSrcAnnot = a })+unionAnnotations :: Union a -> [TypeAnnotation]+unionAnnotations = structAnnotations+{-# DEPRECATED unionAnnotations "Use structAnnotations." #-} -instance HasDocstring (Union a) where-    docstring = lens unionDocstring (\s a -> s { unionDocstring = a })+unionDocstring :: Union a -> Docstring+unionDocstring = structDocstring+{-# DEPRECATED unionDocstring "Use structDocstring." #-} -instance HasAnnotations (Union a) where-    annotations = lens unionAnnotations (\s a -> s { unionAnnotations = a })+unionSrcAnnot :: Union a -> a+unionSrcAnnot = structSrcAnnot+{-# DEPRECATED unionSrcAnnot "Use structSrcAnnot." #-}  -- | Exception types.------ > exception UserDoesNotExist {--- >     1: optional string message--- >     2: required string username--- > }-data Exception srcAnnot = Exception-    { exceptionName        :: Text-    -- ^ Name of the exception.-    , exceptionFields      :: [Field srcAnnot]-    -- ^ Fields defined in the exception.-    , exceptionAnnotations :: [TypeAnnotation]-    -- ^ Annotations added to the exception.-    , exceptionDocstring   :: Docstring-    -- ^ Documentation.-    , exceptionSrcAnnot    :: srcAnnot-    }-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)+type Exception = Struct+{-# DEPRECATED Exception "The type has been consolidated into Struct." #-} -instance HasName (Exception a) where-    name = lens exceptionName (\s a -> s { exceptionName = a })+exceptionName :: Exception a -> Text+exceptionName = structName+{-# DEPRECATED exceptionName "Use structName." #-} -instance HasFields Exception where-    fields = lens exceptionFields (\s a -> s { exceptionFields = a })+exceptionFields :: Exception a -> [Field a]+exceptionFields = structFields+{-# DEPRECATED exceptionFields "Use structFields." #-} -instance HasSrcAnnot Exception where-    srcAnnot = lens exceptionSrcAnnot (\s a -> s { exceptionSrcAnnot = a })+exceptionAnnotations :: Exception a -> [TypeAnnotation]+exceptionAnnotations = structAnnotations+{-# DEPRECATED exceptionAnnotations "Use structAnnotations." #-} -instance HasDocstring (Exception a) where-    docstring = lens exceptionDocstring (\s a -> s { exceptionDocstring = a })+exceptionDocstring :: Exception a -> Docstring+exceptionDocstring = structDocstring+{-# DEPRECATED exceptionDocstring "Use structDocstring." #-} -instance HasAnnotations (Exception a) where-    annotations = lens exceptionAnnotations (\s a -> s { exceptionAnnotations = a })+exceptionSrcAnnot :: Exception a -> a+exceptionSrcAnnot = structSrcAnnot+{-# DEPRECATED exceptionSrcAnnot "Use structSrcAnnot." #-}  -- | An string-only enum. These are a deprecated feature of Thrift and -- shouldn't be used.@@ -636,12 +654,8 @@       TypedefType (Typedef srcAnnot)     | -- | @enum@       EnumType (Enum srcAnnot)-    | -- | @struct@+    | -- | @struct@/@union@/@exception@       StructType (Struct srcAnnot)-    | -- | @union@-      UnionType (Union srcAnnot)-    | -- | @exception@-      ExceptionType (Exception srcAnnot)     | -- | @senum@       SenumType (Senum srcAnnot)   deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)@@ -652,15 +666,11 @@         getter (TypedefType   t) = view name t         getter (EnumType      t) = view name t         getter (StructType    t) = view name t-        getter (UnionType     t) = view name t-        getter (ExceptionType t) = view name t         getter (SenumType     t) = view name t          setter (TypedefType   t) n = TypedefType   $ set name n t         setter (EnumType      t) n = EnumType      $ set name n t         setter (StructType    t) n = StructType    $ set name n t-        setter (UnionType     t) n = UnionType     $ set name n t-        setter (ExceptionType t) n = ExceptionType $ set name n t         setter (SenumType     t) n = SenumType     $ set name n t  instance HasSrcAnnot Type where@@ -669,15 +679,11 @@         getter (TypedefType   t) = view srcAnnot t         getter (EnumType      t) = view srcAnnot t         getter (StructType    t) = view srcAnnot t-        getter (UnionType     t) = view srcAnnot t-        getter (ExceptionType t) = view srcAnnot t         getter (SenumType     t) = view srcAnnot t          setter (TypedefType   t) a = TypedefType   $ set srcAnnot a t         setter (EnumType      t) a = EnumType      $ set srcAnnot a t         setter (StructType    t) a = StructType    $ set srcAnnot a t-        setter (UnionType     t) a = UnionType     $ set srcAnnot a t-        setter (ExceptionType t) a = ExceptionType $ set srcAnnot a t         setter (SenumType     t) a = SenumType     $ set srcAnnot a t  -- | A definition either consists of new constants, new types, or new

@@ -91,9 +91,7 @@  -- | Evaluates the underlying parser with a default state and get the Megaparsec -- parser.-runParser-    :: (P.Stream s, P.Token s ~ Char)-    => Parser s a -> P.Parsec P.Dec s a+runParser :: P.Stream s => Parser s a -> P.Parsec P.Dec s a runParser p = State.evalStateT p (State Nothing)  -- | Parses the Thrift file at the given path.@@ -170,8 +168,7 @@  -- | @p `skipUpTo` n@ skips @p@ @n@ times or until @p@ stops matching -- -- whichever comes first.-skipUpTo-    :: (P.Stream s, P.Token s ~ Char) => Parser s a -> Int -> Parser s ()+skipUpTo :: P.Stream s => Parser s a -> Int -> Parser s () skipUpTo p = loop   where     loop 0 = return ()@@ -362,9 +359,7 @@ -- | Convenience wrapper for parsers expecting a position. -- -- The position will be retrieved BEFORE the parser itself is executed.-withPosition-    :: (P.Stream s, P.Token s ~ Char)-    => Parser s (P.SourcePos -> a) -> Parser s a+withPosition :: P.Stream s => Parser s (P.SourcePos -> a) -> Parser s a withPosition p = P.getPosition >>= \pos -> p <*> pure pos  @@ -373,9 +368,7 @@ -- > data Foo = Foo { bar :: Bar, doc :: Docstring, pos :: Delta } -- > -- > parseFoo = withDocstring $ Foo <$> parseBar-withDocstring-    :: (P.Stream s, P.Token s ~ Char)-    => Parser s (T.Docstring -> P.SourcePos -> a) -> Parser s a+withDocstring :: P.Stream s => Parser s (T.Docstring -> P.SourcePos -> a) -> Parser s a withDocstring p = lastDocstring >>= \s -> do     pos <- P.getPosition     p <*> pure s <*> pure pos@@ -395,12 +388,10 @@ typeDefinition     :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Type P.SourcePos) typeDefinition = P.choice-    [ T.TypedefType   <$> typedef-    , T.EnumType      <$> enum-    , T.SenumType     <$> senum-    , T.StructType    <$> struct-    , T.UnionType     <$> union-    , T.ExceptionType <$> exception+    [ T.TypedefType <$> typedef+    , T.EnumType    <$> enum+    , T.SenumType   <$> senum+    , T.StructType  <$> struct     ]  @@ -426,50 +417,46 @@     )  --- | A @struct@.+-- | A @struct@, @union@, or @exception@. -- -- > struct User { -- >     1: string name -- >     2: Role role = Role.User; -- > }-struct :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Struct P.SourcePos)-struct = reserved "struct" >> withDocstring-    ( T.Struct-        <$> identifier-        <*> braces (many field)-        <*> typeAnnotations-    )----- | A @union@ of types. -- -- > union Value { -- >     1: string stringValue; -- >     2: i32 intValue; -- > }-union :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Union P.SourcePos)-union = reserved "union" >> withDocstring-    ( T.Union-        <$> identifier-        <*> braces (many field)-        <*> typeAnnotations-    )----- | An @exception@ that can be raised by service methods. -- -- > exception UserDoesNotExist { -- >     1: optional string message -- >     2: required string username -- > }-exception-    :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Exception P.SourcePos)-exception = reserved "exception" >> withDocstring-    ( T.Exception+struct :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Struct P.SourcePos)+struct = kind >>= \k -> withDocstring+    ( T.Struct k         <$> identifier         <*> braces (many field)         <*> typeAnnotations     )+  where+    kind = P.choice+        [ reserved "struct"    >> return T.StructKind+        , reserved "union"     >> return T.UnionKind+        , reserved "exception" >> return T.ExceptionKind+        ]+++-- | A @union@ of types.+union :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Struct P.SourcePos)+union = struct+{-# DEPRECATED union "Use struct." #-}++-- | An @exception@ that can be raised by service methods.+exception :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Struct P.SourcePos)+exception = struct+{-# DEPRECATED exception"Use struct." #-}   -- | Whether a field is @required@ or @optional@.

@@ -67,11 +67,34 @@ import           Data.Text (Text) import qualified Data.Text as Text -import Text.PrettyPrint.ANSI.Leijen (Doc, Pretty (..), align, bold, cyan,-                                     double, dquotes, dullblue, empty, enclose,-                                     group, hcat, hsep, integer, line,-                                     linebreak, magenta, nest, plain, space,-                                     vsep, yellow, (<$$>), (<$>), (<+>), (<>))+import Text.PrettyPrint.ANSI.Leijen+    ( Doc+    , Pretty (..)+    , align+    , bold+    , cyan+    , double+    , dquotes+    , dullblue+    , empty+    , enclose+    , group+    , hcat+    , hsep+    , integer+    , line+    , linebreak+    , magenta+    , nest+    , plain+    , space+    , vsep+    , yellow+    , (<$$>)+    , (<$>)+    , (<+>)+    , (<>)+    )  import qualified Language.Thrift.Internal.AST as T import qualified Text.PrettyPrint.ANSI.Leijen as P@@ -109,7 +132,7 @@  -- | Print the headers for a program. header :: T.Header ann -> Doc-header (T.HeaderInclude inc) = include inc+header (T.HeaderInclude inc)  = include inc header (T.HeaderNamespace ns) = namespace ns  instance Pretty (T.Header a) where@@ -130,8 +153,8 @@  -- | 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.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@@ -157,7 +180,7 @@     typeAnnots c serviceAnnotations   where     extends = case serviceExtends of-      Nothing -> empty+      Nothing   -> empty       Just name -> space <> reserved "extends" <+> text name  instance Pretty (T.Service a) where@@ -193,8 +216,6 @@   T.TypedefType   t -> c `typedef`   t   T.EnumType      t -> c `enum`      t   T.StructType    t -> c `struct`    t-  T.UnionType     t -> c `union`     t-  T.ExceptionType t -> c `exception` t   T.SenumType     t -> c `senum`     t  instance Pretty (T.Type a) where@@ -219,30 +240,25 @@  struct :: Config -> T.Struct ann -> Doc struct c@Config{indentWidth} T.Struct{..} = structDocstring $$-    reserved "struct" <+> declare structName <+>+    kind <+> declare structName <+>       block indentWidth line (map (\f -> field c f <> semi) structFields)     <> typeAnnots c structAnnotations+  where+    kind = case structKind of+        T.StructKind    -> reserved "struct"+        T.UnionKind     -> reserved "union"+        T.ExceptionKind -> reserved "exception"  instance Pretty (T.Struct a) where     pretty = struct defaultConfig -union :: Config -> T.Union ann -> Doc-union c@Config{indentWidth} T.Union{..} = unionDocstring $$-    reserved "union" <+> declare unionName <+>-      block indentWidth line (map (\f -> field c f <> semi) unionFields)-    <> typeAnnots c unionAnnotations--instance Pretty (T.Union a) where-    pretty = union defaultConfig--exception :: Config -> T.Exception ann -> Doc-exception c@Config{indentWidth} T.Exception{..} = exceptionDocstring $$-    reserved "exception" <+> declare exceptionName <+>-      block indentWidth line (map (\f -> field c f <> semi) exceptionFields)-    <> typeAnnots c exceptionAnnotations+union :: Config -> T.Struct ann -> Doc+union = struct+{-# DEPRECATED union "Use struct." #-} -instance Pretty (T.Exception a) where-    pretty = exception defaultConfig+exception :: Config -> T.Struct ann -> Doc+exception = struct+{-# DEPRECATED exception "Use struct." #-}  senum :: Config -> T.Senum ann -> Doc senum c@Config{indentWidth} T.Senum{..} = senumDocstring $$@@ -395,8 +411,8 @@     nest indent (linebreak <> (items `sepBy` s)) <> linebreak  sepBy :: [Doc] -> Doc -> Doc-sepBy [] _ = empty-sepBy [x] _ = x+sepBy [] _     = empty+sepBy [x] _    = x sepBy (x:xs) s = x <> s <> sepBy xs s  encloseSep :: Int -> Doc -> Doc -> Doc -> [Doc] -> Doc@@ -404,8 +420,8 @@ encloseSep _ left right _ [v] = left <> v <> right encloseSep indent left right s vs = group $     nest indent (left <$$> go vs) <$$> right-  where go [] = empty-        go [x] = x+  where go []     = empty+        go [x]    = x         go (x:xs) = (x <> s) <$> go xs  lbrace :: Doc

@@ -1,15 +0,0 @@--- |--- Module      :  Language.Thrift.Types--- Copyright   :  (c) Abhinav Gupta 2016--- License     :  BSD3------ Maintainer  :  Abhinav Gupta <mail@abhinavg.net>--- Stability   :  experimental------ This module is deprecated. Use "Language.Thrift.AST" instead.-module Language.Thrift.Types-    {-# DEPRECATED "This module will be removed in a future release." #-}-    ( module Language.Thrift.AST-    ) where--import Language.Thrift.AST

@@ -33,12 +33,6 @@         prop "can round-trip structs" $             roundtrip PP.struct (P.whiteSpace >> P.struct) -        prop "can round-trip unions" $-            roundtrip PP.union (P.whiteSpace >> P.union)--        prop "can round-trip exceptions" $-            roundtrip PP.exception (P.whiteSpace >> P.exception)-         prop "can round-trip senums" $             roundtrip PP.senum (P.whiteSpace >> P.senum) 

@@ -154,8 +154,6 @@         [ T.TypedefType   <$> arbitrary         , T.EnumType      <$> arbitrary         , T.StructType    <$> arbitrary-        , T.UnionType     <$> arbitrary-        , T.ExceptionType <$> arbitrary         , T.SenumType     <$> arbitrary         ] @@ -187,28 +185,15 @@             <*> (getDocstring <$> arbitrary)             <*> pure () +instance Arbitrary T.StructKind where+    shrink _ = []+    arbitrary = elements [T.StructKind, T.UnionKind, T.ExceptionKind]+ instance Arbitrary (T.Struct ()) where     shrink = genericShrink     arbitrary = T.Struct-        <$> (getIdentifier <$> arbitrary)-        <*> arbitrary-        <*> halfSize arbitrary-        <*> (getDocstring <$> arbitrary)-        <*> pure ()--instance Arbitrary (T.Union ()) where-    shrink = genericShrink-    arbitrary = T.Union-        <$> (getIdentifier <$> arbitrary)-        <*> arbitrary-        <*> halfSize arbitrary-        <*> (getDocstring <$> arbitrary)-        <*> pure ()--instance Arbitrary (T.Exception ()) where-    shrink = genericShrink-    arbitrary = T.Exception-        <$> (getIdentifier <$> arbitrary)+        <$> arbitrary+        <*> (getIdentifier <$> arbitrary)         <*> arbitrary         <*> halfSize arbitrary         <*> (getDocstring <$> arbitrary)