packages feed

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 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