language-thrift 0.5.0.0 → 0.6.0.0
raw patch · 9 files changed
+468/−332 lines, 9 filesdep +ansi-wl-pprintPVP ok
version bump matches the API change (PVP)
Dependencies added: ansi-wl-pprint
API changes (from Hackage documentation)
- Language.Thrift.Pretty: instance GHC.Classes.Eq Language.Thrift.Pretty.Config
- Language.Thrift.Pretty: instance GHC.Classes.Ord Language.Thrift.Pretty.Config
- Language.Thrift.Pretty: instance GHC.Show.Show Language.Thrift.Pretty.Config
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Const a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.ConstValue a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Definition a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Enum a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.EnumDef a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Exception a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Field a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Function a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Header a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Include a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Namespace a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Program a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Senum a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Service a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Struct a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Type a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.TypeReference a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Typedef a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty (Language.Thrift.Types.Union a)
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty Language.Thrift.Types.FieldRequiredness
+ Language.Thrift.Pretty: instance Text.PrettyPrint.Leijen.Pretty Language.Thrift.Types.TypeAnnotation
+ Language.Thrift.Pretty.ANSI: Config :: Int -> Config
+ Language.Thrift.Pretty.ANSI: [indentWidth] :: Config -> Int
+ Language.Thrift.Pretty.ANSI: constant :: Config -> Const ann -> Doc
+ Language.Thrift.Pretty.ANSI: constantValue :: Config -> ConstValue ann -> Doc
+ Language.Thrift.Pretty.ANSI: data Config
+ Language.Thrift.Pretty.ANSI: defaultConfig :: Config
+ Language.Thrift.Pretty.ANSI: definition :: Config -> Definition ann -> Doc
+ Language.Thrift.Pretty.ANSI: enum :: Config -> Enum ann -> Doc
+ Language.Thrift.Pretty.ANSI: exception :: Config -> Exception ann -> Doc
+ Language.Thrift.Pretty.ANSI: header :: Header ann -> Doc
+ Language.Thrift.Pretty.ANSI: include :: Include ann -> Doc
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Const a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.ConstValue a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Definition a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Enum a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.EnumDef a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Exception a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Field a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Function a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Header a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Include a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Namespace a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Program a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Senum a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Service a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Struct a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Type a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.TypeReference a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Typedef a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty (Language.Thrift.Types.Union a)
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty Language.Thrift.Types.FieldRequiredness
+ Language.Thrift.Pretty.ANSI: instance Text.PrettyPrint.ANSI.Leijen.Pretty Language.Thrift.Types.TypeAnnotation
+ Language.Thrift.Pretty.ANSI: namespace :: Namespace ann -> Doc
+ Language.Thrift.Pretty.ANSI: prettyPrint :: Program ann -> Doc
+ Language.Thrift.Pretty.ANSI: program :: Config -> Program ann -> Doc
+ Language.Thrift.Pretty.ANSI: senum :: Config -> Senum ann -> Doc
+ Language.Thrift.Pretty.ANSI: service :: Config -> Service ann -> Doc
+ Language.Thrift.Pretty.ANSI: struct :: Config -> Struct ann -> Doc
+ Language.Thrift.Pretty.ANSI: typeDefinition :: Config -> Type ann -> Doc
+ Language.Thrift.Pretty.ANSI: typeReference :: Config -> TypeReference ann -> Doc
+ Language.Thrift.Pretty.ANSI: typedef :: Config -> Typedef ann -> Doc
+ Language.Thrift.Pretty.ANSI: union :: Config -> Union ann -> Doc
- Language.Thrift.Types: _BinaryType :: Prism' (TypeReference srcAnnot_adud) [TypeAnnotation]
+ Language.Thrift.Types: _BinaryType :: Prism' (TypeReference srcAnnot_agFq) [TypeAnnotation]
- Language.Thrift.Types: _BoolType :: Prism' (TypeReference srcAnnot_adud) [TypeAnnotation]
+ Language.Thrift.Types: _BoolType :: Prism' (TypeReference srcAnnot_agFq) [TypeAnnotation]
- Language.Thrift.Types: _ByteType :: Prism' (TypeReference srcAnnot_adud) [TypeAnnotation]
+ Language.Thrift.Types: _ByteType :: Prism' (TypeReference srcAnnot_agFq) [TypeAnnotation]
- Language.Thrift.Types: _ConstFloat :: Prism' (ConstValue srcAnnot_acUE) Double
+ Language.Thrift.Types: _ConstFloat :: Prism' (ConstValue srcAnnot_afYE) Double
- Language.Thrift.Types: _ConstIdentifier :: Prism' (ConstValue srcAnnot_acUE) (Text, srcAnnot_acUE)
+ Language.Thrift.Types: _ConstIdentifier :: Prism' (ConstValue srcAnnot_afYE) (Text, srcAnnot_afYE)
- Language.Thrift.Types: _ConstInt :: Prism' (ConstValue srcAnnot_acUE) Integer
+ Language.Thrift.Types: _ConstInt :: Prism' (ConstValue srcAnnot_afYE) Integer
- Language.Thrift.Types: _ConstList :: Prism' (ConstValue srcAnnot_acUE) [ConstValue srcAnnot_acUE]
+ Language.Thrift.Types: _ConstList :: Prism' (ConstValue srcAnnot_afYE) [ConstValue srcAnnot_afYE]
- Language.Thrift.Types: _ConstLiteral :: Prism' (ConstValue srcAnnot_acUE) Text
+ Language.Thrift.Types: _ConstLiteral :: Prism' (ConstValue srcAnnot_afYE) Text
- Language.Thrift.Types: _ConstMap :: Prism' (ConstValue srcAnnot_acUE) [(ConstValue srcAnnot_acUE, ConstValue srcAnnot_acUE)]
+ Language.Thrift.Types: _ConstMap :: Prism' (ConstValue srcAnnot_afYE) [(ConstValue srcAnnot_afYE, ConstValue srcAnnot_afYE)]
- Language.Thrift.Types: _DefinedType :: Prism' (TypeReference srcAnnot_adud) (Text, srcAnnot_adud)
+ Language.Thrift.Types: _DefinedType :: Prism' (TypeReference srcAnnot_agFq) (Text, srcAnnot_agFq)
- Language.Thrift.Types: _DoubleType :: Prism' (TypeReference srcAnnot_adud) [TypeAnnotation]
+ Language.Thrift.Types: _DoubleType :: Prism' (TypeReference srcAnnot_agFq) [TypeAnnotation]
- Language.Thrift.Types: _I16Type :: Prism' (TypeReference srcAnnot_adud) [TypeAnnotation]
+ Language.Thrift.Types: _I16Type :: Prism' (TypeReference srcAnnot_agFq) [TypeAnnotation]
- Language.Thrift.Types: _I32Type :: Prism' (TypeReference srcAnnot_adud) [TypeAnnotation]
+ Language.Thrift.Types: _I32Type :: Prism' (TypeReference srcAnnot_agFq) [TypeAnnotation]
- Language.Thrift.Types: _I64Type :: Prism' (TypeReference srcAnnot_adud) [TypeAnnotation]
+ Language.Thrift.Types: _I64Type :: Prism' (TypeReference srcAnnot_agFq) [TypeAnnotation]
- Language.Thrift.Types: _ListType :: Prism' (TypeReference srcAnnot_adud) (TypeReference srcAnnot_adud, [TypeAnnotation])
+ Language.Thrift.Types: _ListType :: Prism' (TypeReference srcAnnot_agFq) (TypeReference srcAnnot_agFq, [TypeAnnotation])
- Language.Thrift.Types: _MapType :: Prism' (TypeReference srcAnnot_adud) (TypeReference srcAnnot_adud, TypeReference srcAnnot_adud, [TypeAnnotation])
+ Language.Thrift.Types: _MapType :: Prism' (TypeReference srcAnnot_agFq) (TypeReference srcAnnot_agFq, TypeReference srcAnnot_agFq, [TypeAnnotation])
- Language.Thrift.Types: _SListType :: Prism' (TypeReference srcAnnot_adud) [TypeAnnotation]
+ Language.Thrift.Types: _SListType :: Prism' (TypeReference srcAnnot_agFq) [TypeAnnotation]
- Language.Thrift.Types: _SetType :: Prism' (TypeReference srcAnnot_adud) (TypeReference srcAnnot_adud, [TypeAnnotation])
+ Language.Thrift.Types: _SetType :: Prism' (TypeReference srcAnnot_agFq) (TypeReference srcAnnot_agFq, [TypeAnnotation])
- Language.Thrift.Types: _StringType :: Prism' (TypeReference srcAnnot_adud) [TypeAnnotation]
+ Language.Thrift.Types: _StringType :: Prism' (TypeReference srcAnnot_agFq) [TypeAnnotation]
Files
- CHANGES.md +7/−0
- Language/Thrift/Parser.hs +6/−6
- Language/Thrift/Pretty.hs +6/−266
- Language/Thrift/Pretty/ANSI.hs +57/−0
- Language/Thrift/Pretty/PrettyInc.hs +314/−0
- Language/Thrift/Pretty/Types.hs +15/−0
- README.md +2/−1
- examples/reformatIDL.hs +4/−6
- language-thrift.cabal +57/−53
CHANGES.md view
@@ -1,3 +1,10 @@+0.6.0.0+=======++- Added a pretty printer based on `ansi-wl-pprint`.+- Both pretty printing modules now export instances of `Pretty` for relevant+ elements of the AST. These instances use `defaultConfig` for printing.+ 0.5.0.0 =======
Language/Thrift/Parser.hs view
@@ -57,18 +57,18 @@ import Control.Applicative import Control.Monad-import Control.Monad.Trans.Reader (ReaderT)-import Control.Monad.Trans.State (StateT)-import Control.Monad.Trans.Class (lift)-import Data.Text (Text)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Reader (ReaderT)+import Control.Monad.Trans.State (StateT)+import Data.Text (Text) import Text.Parser.Char import Text.Parser.Combinators import Text.Parser.Token-import Text.Parser.Token.Style (emptyIdents)+import Text.Parser.Token.Style (emptyIdents) import qualified Control.Monad.Trans.Reader as Reader import qualified Control.Monad.Trans.State as State-import qualified Data.Text as Text+import qualified Data.Text as Text import qualified Language.Thrift.Types as T
Language/Thrift/Pretty.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Language.Thrift.Pretty -- Copyright : (c) Abhinav Gupta 2015@@ -11,10 +12,12 @@ -- Stability : experimental -- -- This module provides a pretty printer for Thrift IDLs. The pretty printer--- prserves docstrings specified for types.+-- preserves docstrings specified for types. -- -- The specifics of the printer can be configured using 'Config' objects. --+-- The module also exports instances of the 'Pretty' typeclass for elements of+-- the AST. module Language.Thrift.Pretty ( prettyPrint@@ -48,270 +51,7 @@ , 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 Text.PrettyPrint.Leijen hiding (encloseSep, indent, text) 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 ann -> Doc-header (T.HeaderInclude inc) = include inc-header (T.HeaderNamespace ns) = namespace ns---include :: T.Include ann -> Doc-include T.Include{..} = text "include" <+> literal includePath---namespace :: T.Namespace ann -> Doc-namespace 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 cd) = constant c cd-definition c (T.TypeDefinition def) = typeDefinition c def-definition c (T.ServiceDefinition s) = service c s---constant :: Config -> T.Const ann -> Doc-constant c T.Const{..} = constDocstring $$ hsep- [ text "const"- , typeReference c constValueType- , text constName- , text "="- , constantValue c constValue- ]---service :: Config -> T.Service ann -> Doc-service c@Config{indentWidth} T.Service{..} =- 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 -> typeReference c rt- oneway =- if functionOneWay- then text "oneway" <> space- else empty---typeDefinition :: Config -> T.Type ann -> Doc-typeDefinition c td = case td of- 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--typedef :: Config -> T.Typedef ann -> Doc-typedef c T.Typedef{..} = typedefDocstring $$- text "typedef" <+> typeReference c typedefTargetType <+> text typedefName- <> typeAnnots c typedefAnnotations--enum :: Config -> T.Enum ann -> Doc-enum c@Config{indentWidth} T.Enum{..} = enumDocstring $$- text "enum" <+> text enumName <+>- block indentWidth (comma <> line) (map (enumValue c) enumValues)- <> typeAnnots c enumAnnotations--struct :: Config -> T.Struct ann -> Doc-struct c@Config{indentWidth} T.Struct{..} = structDocstring $$- text "struct" <+> text structName <+>- block indentWidth line (map (\f -> field c f <> semi) structFields)- <> typeAnnots c structAnnotations--union :: Config -> T.Union ann -> Doc-union c@Config{indentWidth} T.Union{..} = unionDocstring $$- text "union" <+> text unionName <+>- block indentWidth line (map (\f -> field c f <> semi) unionFields)- <> typeAnnots c unionAnnotations--exception :: Config -> T.Exception ann -> Doc-exception c@Config{indentWidth} T.Exception{..} = exceptionDocstring $$- text "exception" <+> text exceptionName <+>- block indentWidth line (map (\f -> field c f <> semi) exceptionFields)- <> typeAnnots c exceptionAnnotations--senum :: Config -> T.Senum ann -> Doc-senum c@Config{indentWidth} T.Senum{..} = senumDocstring $$- text "senum" <+> text senumName <+>- encloseSep indentWidth lbrace rbrace comma (map literal senumValues)- <> typeAnnots c senumAnnotations---field :: Config -> T.Field ann -> Doc-field c T.Field{fieldValueType = typ, ..} = fieldDocstring $$- hcat [fid, req, typeReference 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 fieldDefaultValue 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.-typeReference :: Config -> T.TypeReference ann -> Doc-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.MapType k v anns ->- text "map" <> angles (typeReference c k <> comma <+> typeReference c v)- <> typeAnnots c anns- T.SetType v anns ->- text "set" <> angles (typeReference c v) <> typeAnnots c anns- T.ListType v anns ->- text "list" <> angles (typeReference c v) <> typeAnnots c anns----- | Pretty print a constant value.-constantValue :: Config -> T.ConstValue ann -> 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 <> value- where- value = case typeAnnotationValue of- Nothing -> empty- Just v -> space <> equals <+> literal v---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 [] = empty- go [x] = x- go (x:xs) = (x <> s) <$> go xs+#include "Pretty/PrettyInc.hs"
+ Language/Thrift/Pretty/ANSI.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Language.Thrift.Pretty.ANSI+-- Copyright : (c) Abhinav Gupta 2015+-- License : BSD3+--+-- 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.+--+-- The specifics of the printer can be configured using 'Config' objects.+--+-- As with "Language.Thrift.Pretty", this module exports instances of the+-- 'Pretty' typeclass for @ansi-wl-pprint@.+module Language.Thrift.Pretty.ANSI+ (+ prettyPrint++ -- * Components++ , program++ , header+ , include+ , namespace++ , definition+ , constant+ , typeDefinition+ , service++ , typedef+ , enum+ , struct+ , union+ , exception+ , senum++ , typeReference+ , constantValue++ -- * Configuration++ , Config(..)+ , defaultConfig+ ) where++import Text.PrettyPrint.ANSI.Leijen hiding (encloseSep, indent, text)+import qualified Text.PrettyPrint.ANSI.Leijen as PP++#include "PrettyInc.hs"
+ Language/Thrift/Pretty/PrettyInc.hs view
@@ -0,0 +1,314 @@+-- This file implements the prettty printer. It is included with wl-pprint and+-- ansi-wl-pprint in scope.++#if __GLASGOW_HASKELL__ >= 709+import Prelude hiding ((<$>))+#endif++import Data.Text (Text, unpack)++import qualified Data.Text as Text+import qualified Language.Thrift.Types as T++import Language.Thrift.Pretty.Types+++-- | 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)++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{..} = text "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]++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+ [ text "const"+ , typeReference c constValueType+ , text constName+ , text "="+ , 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 $$+ 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++instance Pretty (T.Service a) where+ pretty = service defaultConfig++-- | 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 -> typeReference c rt+ oneway =+ if functionOneWay+ then text "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+ 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+ pretty = typeDefinition defaultConfig++typedef :: Config -> T.Typedef ann -> Doc+typedef c T.Typedef{..} = typedefDocstring $$+ text "typedef" <+> typeReference c typedefTargetType <+> text 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 <+>+ 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 $$+ text "struct" <+> text structName <+>+ block indentWidth line (map (\f -> field c f <> semi) structFields)+ <> typeAnnots c structAnnotations++instance Pretty (T.Struct a) where+ pretty = struct defaultConfig++union :: Config -> T.Union ann -> Doc+union c@Config{indentWidth} T.Union{..} = unionDocstring $$+ text "union" <+> text 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 $$+ text "exception" <+> text exceptionName <+>+ block indentWidth line (map (\f -> field c f <> semi) exceptionFields)+ <> typeAnnots c exceptionAnnotations++instance Pretty (T.Exception a) where+ pretty = exception defaultConfig++senum :: Config -> T.Senum ann -> Doc+senum c@Config{indentWidth} T.Senum{..} = senumDocstring $$+ text "senum" <+> text senumName <+>+ 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 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++instance Pretty (T.Field a) where+ pretty = field defaultConfig++fieldRequiredness :: T.FieldRequiredness -> Doc+fieldRequiredness T.Optional = text "optional"+fieldRequiredness T.Required = text "required"++instance Pretty T.FieldRequiredness where+ pretty = fieldRequiredness++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++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+ 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 (typeReference c k <> comma <+> typeReference c v)+ <> typeAnnots c anns+ T.SetType v anns ->+ text "set" <> angles (typeReference c v) <> typeAnnots c anns+ T.ListType v anns ->+ text "list" <> angles (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+ 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++instance Pretty (T.ConstValue a) where+ pretty = constantValue defaultConfig++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 <> value+ where+ value = case typeAnnotationValue of+ Nothing -> empty+ Just v -> space <> equals <+> literal v++instance Pretty T.TypeAnnotation where+ pretty = typeAnnot++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 [] = empty+ go [x] = x+ go (x:xs) = (x <> s) <$> go xs
+ Language/Thrift/Pretty/Types.hs view
@@ -0,0 +1,15 @@+module Language.Thrift.Pretty.Types+ ( Config(..)+ , defaultConfig+ ) where++-- | 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
README.md view
@@ -9,7 +9,7 @@ The parser uses [`parsers`] to allow plugging in the underlying parser. A default [`trifecta`] based parser is provided. -The pretty printer uses [wl-pprint].+The pretty printer supports both, [wl-pprint] and [ansi-wl-pprint]. Haddock-generated docs are available on [Hackage] and [here]. @@ -18,5 +18,6 @@ [`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 [Hackage]: http://hackage.haskell.org/package/language-thrift [here]: http://abhinavg.net/language-thrift/
examples/reformatIDL.hs view
@@ -7,20 +7,18 @@ -- Docstrings in the IDL are preserved but COMMENTS WILL BE LOST. import System.IO (stderr)-import Text.PrettyPrint.Leijen (putDoc) import Text.Trifecta (Result (..), parseString) import Text.Trifecta.Delta (Delta (Directed)) -import qualified Text.PrettyPrint.ANSI.Leijen as AnsiPP+import qualified Text.PrettyPrint.ANSI.Leijen as PP import Language.Thrift.Parser.Trifecta (thriftIDL)-import Language.Thrift.Pretty (prettyPrint)+import Language.Thrift.Pretty.ANSI (prettyPrint) main :: IO () main = do result <- parseString thriftIDL (Directed "stdin" 0 0 0 0) `fmap` getContents case result of- Success p -> putDoc (prettyPrint p) >> putStrLn ""- Failure doc ->- AnsiPP.displayIO stderr $ AnsiPP.renderPretty 0.8 80 doc+ Success p -> PP.putDoc (prettyPrint p) >> putStrLn ""+ Failure doc -> PP.displayIO stderr $ PP.renderPretty 0.8 80 doc
language-thrift.cabal view
@@ -1,63 +1,67 @@-name : language-thrift-version : 0.5.0.0-synopsis : Parser and pretty printer for the Thrift IDL format.-homepage : https://github.com/abhinav/language-thrift-license : BSD3-license-file : LICENSE-author : Abhinav Gupta-maintainer : Abhinav Gupta <mail@abhinavg.net>-category : Language-build-type : Simple-cabal-version : >=1.10-description :+name: language-thrift+version: 0.6.0.0+cabal-version: >=1.10+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: Abhinav Gupta <mail@abhinavg.net>+homepage: https://github.com/abhinav/language-thrift+synopsis: Parser and pretty printer for the Thrift IDL format.+description: This package provides a parser and pretty printer for the <http://thrift.apache.org/docs/idl Thrift IDL format>.+category: Language+author: Abhinav Gupta extra-source-files:+ Language/Thrift/Pretty/PrettyInc.hs README.md CHANGES.md examples/*.hs -library- exposed-modules : Language.Thrift.Parser- , Language.Thrift.Parser.Trifecta- , Language.Thrift.Pretty- , Language.Thrift.Types- ghc-options : -Wall- build-depends : base >= 4.7 && < 4.9-- , lens >= 4.0 && < 5.0- , parsers >= 0.12 && < 0.13- , text >= 1.2- , transformers- , trifecta >= 1.5 && < 1.6- , wl-pprint >= 1.1- default-language : Haskell2010+source-repository head+ type: git+ location: git://github.com/abhinav/language-thrift.git +library+ exposed-modules:+ Language.Thrift.Parser+ Language.Thrift.Parser.Trifecta+ Language.Thrift.Pretty+ Language.Thrift.Pretty.ANSI+ Language.Thrift.Types+ build-depends:+ base >=4.7 && <4.9,+ ansi-wl-pprint >=0.6 && <0.7,+ lens >=4.0 && <5.0,+ parsers >=0.12 && <0.13,+ text >=1.2,+ transformers -any,+ trifecta >=1.5 && <1.6,+ wl-pprint >=1.1+ default-language: Haskell2010+ other-modules:+ Language.Thrift.Pretty.Types+ ghc-options: -Wall test-suite spec- type : exitcode-stdio-1.0- hs-source-dirs : test- main-is : Main.hs- ghc-options : -Wall- other-modules : Language.Thrift.Arbitrary- , Language.Thrift.ParserSpec- , Language.Thrift.TypesSpec- , Spec- , TestUtils- build-depends : base-- , hspec >= 2.0- , hspec-discover >= 2.1- , QuickCheck >= 2.5-- , parsers- , text- , trifecta- , wl-pprint-- , language-thrift- default-language : Haskell2010--source-repository head- type: git- location: git://github.com/abhinav/language-thrift.git+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-depends:+ base -any,+ hspec >=2.0,+ hspec-discover >=2.1,+ QuickCheck >=2.5,+ parsers -any,+ text -any,+ trifecta -any,+ wl-pprint -any,+ language-thrift -any+ default-language: Haskell2010+ hs-source-dirs: test+ other-modules:+ Language.Thrift.Arbitrary+ Language.Thrift.ParserSpec+ Language.Thrift.TypesSpec+ Spec+ TestUtils+ ghc-options: -Wall