{-# LANGUAGE LambdaCase #-} {-# LANGUAGE Strict #-} module Apigen.Language.PyDsl (generate) where import Apigen.Parser.SymbolTable (Name) import Apigen.Types (BitSize (..), BuiltinType (..), Constness (..), Decl (..), Generated (..), Model (..), Module (..)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Lazy as TL import Language.Cimple (Lexeme (..), LexemeClass) import Prelude hiding ((<$>)) import Prettyprinter import Prettyprinter.Render.Text as Term commaSpace :: Doc () commaSpace :: Doc () commaSpace = Doc () forall ann. Doc ann comma Doc () -> Doc () -> Doc () forall a. Semigroup a => a -> a -> a <> Doc () forall ann. Doc ann softline commaSep :: [Doc ()] -> [Doc ()] commaSep :: [Doc ()] -> [Doc ()] commaSep = Doc () -> [Doc ()] -> [Doc ()] forall ann. Doc ann -> [Doc ann] -> [Doc ann] punctuate Doc () commaSpace go :: ([Doc ()] -> Doc ()) -> String -> [Doc ()] -> Doc () go :: ([Doc ()] -> Doc ()) -> String -> [Doc ()] -> Doc () go [Doc ()] -> Doc () f String cls [Doc ()] mems = String -> Doc () ppCtor String cls Doc () -> Doc () -> Doc () forall a. Semigroup a => a -> a -> a <> Doc () forall ann. Doc ann lparen Doc () -> Doc () -> Doc () forall a. Semigroup a => a -> a -> a <> [Doc ()] -> Doc () f ([Doc ()] -> [Doc ()] commaSep [Doc ()] mems) Doc () -> Doc () -> Doc () forall a. Semigroup a => a -> a -> a <> Doc () forall ann. Doc ann rparen ppCtor :: String -> Doc () ppCtor :: String -> Doc () ppCtor = String -> Doc () forall a ann. Pretty a => a -> Doc ann pretty (String -> Doc ()) -> (String -> String) -> String -> Doc () forall b c a. (b -> c) -> (a -> b) -> a -> c . (String "apigen." String -> String -> String forall a. Semigroup a => a -> a -> a <>) hgo :: String -> [Doc ()] -> Doc () hgo :: String -> [Doc ()] -> Doc () hgo = ([Doc ()] -> Doc ()) -> String -> [Doc ()] -> Doc () go [Doc ()] -> Doc () forall ann. [Doc ann] -> Doc ann hcat vgo :: String -> [Doc ()] -> Doc () vgo :: String -> [Doc ()] -> Doc () vgo = ([Doc ()] -> Doc ()) -> String -> [Doc ()] -> Doc () go [Doc ()] -> Doc () forall ann. [Doc ann] -> Doc ann vcat linebreak :: Doc () linebreak :: Doc () linebreak = Doc () -> Doc () forall ann. Doc ann -> Doc ann group (Doc () -> Doc () -> Doc () forall ann. Doc ann -> Doc ann -> Doc ann flatAlt Doc () forall ann. Doc ann line Doc () forall a. Monoid a => a mempty) ppList :: (a -> Doc ()) -> [a] -> Doc () ppList :: (a -> Doc ()) -> [a] -> Doc () ppList a -> Doc () pp [a] l = Doc () forall ann. Doc ann lbracket Doc () -> Doc () -> Doc () forall a. Semigroup a => a -> a -> a <> Doc () linebreak Doc () -> Doc () -> Doc () forall a. Semigroup a => a -> a -> a <> [Doc ()] -> Doc () forall ann. [Doc ann] -> Doc ann hcat ([Doc ()] -> [Doc ()] commaSep ((a -> Doc ()) -> [a] -> [Doc ()] forall a b. (a -> b) -> [a] -> [b] map a -> Doc () pp [a] l)) Doc () -> Doc () -> Doc () forall a. Semigroup a => a -> a -> a <> Doc () forall ann. Doc ann rbracket ppModel :: Model (Lexeme Name) -> Doc () ppModel :: Model (Lexeme Name) -> Doc () ppModel (Model [Module (Lexeme Name)] mods) = String -> [Doc ()] -> Doc () vgo String "Model" [(Module (Lexeme Name) -> Doc ()) -> [Module (Lexeme Name)] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList Module (Lexeme Name) -> Doc () ppModule [Module (Lexeme Name)] mods] Doc () -> Doc () -> Doc () forall a. Semigroup a => a -> a -> a <> Doc () forall ann. Doc ann line ppModule :: Module (Lexeme Name) -> Doc () ppModule :: Module (Lexeme Name) -> Doc () ppModule (Module String file [Decl (Lexeme Name)] decls) = String -> [Doc ()] -> Doc () vgo String "Module" [String -> Doc () forall a ann. Pretty a => a -> Doc ann pretty String "\"" Doc () -> Doc () -> Doc () forall a. Semigroup a => a -> a -> a <> String -> Doc () forall a ann. Pretty a => a -> Doc ann pretty String file Doc () -> Doc () -> Doc () forall a. Semigroup a => a -> a -> a <> String -> Doc () forall a ann. Pretty a => a -> Doc ann pretty String "\"", (Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList Decl (Lexeme Name) -> Doc () ppDecl [Decl (Lexeme Name)] decls] ppDecl :: Decl (Lexeme Name) -> Doc () ppDecl :: Decl (Lexeme Name) -> Doc () ppDecl = \case Namespace [Text] name [Decl (Lexeme Name)] mems -> String -> [Doc ()] -> Doc () vgo String "Namespace" [(Text -> Doc ()) -> [Text] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList (String -> Doc () forall a ann. Pretty a => a -> Doc ann pretty (String -> Doc ()) -> (Text -> String) -> Text -> Doc () forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String forall a. Show a => a -> String show) [Text] name, (Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList Decl (Lexeme Name) -> Doc () ppDecl [Decl (Lexeme Name)] mems] ClassDecl Lexeme Name name [Decl (Lexeme Name)] mems -> String -> [Doc ()] -> Doc () vgo String "ClassDecl" [Lexeme Name -> Doc () ppLexeme Lexeme Name name, (Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList Decl (Lexeme Name) -> Doc () ppDecl [Decl (Lexeme Name)] mems] Enumeration [Generated] funs Lexeme Name name [Decl (Lexeme Name)] mems -> String -> [Doc ()] -> Doc () vgo String "Enumeration" [(Generated -> Doc ()) -> [Generated] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList Generated -> Doc () ppGenerated [Generated] funs, Lexeme Name -> Doc () ppLexeme Lexeme Name name, (Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList Decl (Lexeme Name) -> Doc () ppDecl [Decl (Lexeme Name)] mems] Property Lexeme Name name Decl (Lexeme Name) prop -> String -> [Doc ()] -> Doc () hgo String "Property" [Lexeme Name -> Doc () ppLexeme Lexeme Name name, Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) prop] ValueProp Decl (Lexeme Name) valType Maybe (Decl (Lexeme Name)) valGet Maybe (Decl (Lexeme Name)) valSet -> String -> [Doc ()] -> Doc () hgo String "ValueProp" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) valType, (Decl (Lexeme Name) -> Doc ()) -> Maybe (Decl (Lexeme Name)) -> Doc () forall a. (a -> Doc ()) -> Maybe a -> Doc () ppMaybe Decl (Lexeme Name) -> Doc () ppDecl Maybe (Decl (Lexeme Name)) valGet, (Decl (Lexeme Name) -> Doc ()) -> Maybe (Decl (Lexeme Name)) -> Doc () forall a. (a -> Doc ()) -> Maybe a -> Doc () ppMaybe Decl (Lexeme Name) -> Doc () ppDecl Maybe (Decl (Lexeme Name)) valSet] ArrayProp Decl (Lexeme Name) arrType Maybe (Decl (Lexeme Name)) arrGet Maybe (Decl (Lexeme Name)) arrSet Maybe (Decl (Lexeme Name)) arrSize -> String -> [Doc ()] -> Doc () hgo String "ArrayProp" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) arrType, (Decl (Lexeme Name) -> Doc ()) -> Maybe (Decl (Lexeme Name)) -> Doc () forall a. (a -> Doc ()) -> Maybe a -> Doc () ppMaybe Decl (Lexeme Name) -> Doc () ppDecl Maybe (Decl (Lexeme Name)) arrGet, (Decl (Lexeme Name) -> Doc ()) -> Maybe (Decl (Lexeme Name)) -> Doc () forall a. (a -> Doc ()) -> Maybe a -> Doc () ppMaybe Decl (Lexeme Name) -> Doc () ppDecl Maybe (Decl (Lexeme Name)) arrSet, (Decl (Lexeme Name) -> Doc ()) -> Maybe (Decl (Lexeme Name)) -> Doc () forall a. (a -> Doc ()) -> Maybe a -> Doc () ppMaybe Decl (Lexeme Name) -> Doc () ppDecl Maybe (Decl (Lexeme Name)) arrSize] Method Constness constness Decl (Lexeme Name) ret Lexeme Name name [Decl (Lexeme Name)] params -> String -> [Doc ()] -> Doc () hgo String "Method" [Constness -> Doc () ppConstness Constness constness, Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) ret, Lexeme Name -> Doc () ppLexeme Lexeme Name name, (Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList Decl (Lexeme Name) -> Doc () ppDecl [Decl (Lexeme Name)] params] Function Decl (Lexeme Name) ret Lexeme Name name [Decl (Lexeme Name)] params -> String -> [Doc ()] -> Doc () hgo String "Function" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) ret, Lexeme Name -> Doc () ppLexeme Lexeme Name name, (Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList Decl (Lexeme Name) -> Doc () ppDecl [Decl (Lexeme Name)] params] Constructor Lexeme Name name [Decl (Lexeme Name)] params -> String -> [Doc ()] -> Doc () hgo String "Constructor" [Lexeme Name -> Doc () ppLexeme Lexeme Name name, (Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList Decl (Lexeme Name) -> Doc () ppDecl [Decl (Lexeme Name)] params] Destructor Lexeme Name name [Decl (Lexeme Name)] params -> String -> [Doc ()] -> Doc () hgo String "Destructor" [Lexeme Name -> Doc () ppLexeme Lexeme Name name, (Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList Decl (Lexeme Name) -> Doc () ppDecl [Decl (Lexeme Name)] params] CallbackTypeDecl Lexeme Name name [Decl (Lexeme Name)] params -> String -> [Doc ()] -> Doc () hgo String "CallbackTypeDecl" [Lexeme Name -> Doc () ppLexeme Lexeme Name name, (Decl (Lexeme Name) -> Doc ()) -> [Decl (Lexeme Name)] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList Decl (Lexeme Name) -> Doc () ppDecl [Decl (Lexeme Name)] params] IdTypeDecl Lexeme Name name -> String -> [Doc ()] -> Doc () hgo String "IdTypeDecl" [Lexeme Name -> Doc () ppLexeme Lexeme Name name] TypeDecl Lexeme Name name -> String -> [Doc ()] -> Doc () hgo String "TypeDecl" [Lexeme Name -> Doc () ppLexeme Lexeme Name name] Var Decl (Lexeme Name) ty Lexeme Name name -> String -> [Doc ()] -> Doc () hgo String "Var" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) ty, Lexeme Name -> Doc () ppLexeme Lexeme Name name] Define Lexeme Name name -> String -> [Doc ()] -> Doc () hgo String "Define" [Lexeme Name -> Doc () ppLexeme Lexeme Name name] Typename Lexeme Name name -> String -> [Doc ()] -> Doc () hgo String "Typename" [Lexeme Name -> Doc () ppLexeme Lexeme Name name] EnumMember Lexeme Name name -> String -> [Doc ()] -> Doc () hgo String "EnumMember" [Lexeme Name -> Doc () ppLexeme Lexeme Name name] BuiltinType BuiltinType ty -> String -> [Doc ()] -> Doc () hgo String "BuiltinType" [BuiltinType -> Doc () ppBuiltinType BuiltinType ty] CallbackType Lexeme Name ty -> String -> [Doc ()] -> Doc () hgo String "CallbackType" [Lexeme Name -> Doc () ppLexeme Lexeme Name ty] PointerType Lexeme Name ty -> String -> [Doc ()] -> Doc () hgo String "PointerType" [Lexeme Name -> Doc () ppLexeme Lexeme Name ty] ConstPointerType Lexeme Name ty -> String -> [Doc ()] -> Doc () hgo String "ConstPointerType" [Lexeme Name -> Doc () ppLexeme Lexeme Name ty] SizedArrayType Decl (Lexeme Name) ty Decl (Lexeme Name) name -> String -> [Doc ()] -> Doc () hgo String "SizedArrayType" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) ty, Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) name] ArrayType BuiltinType ty -> String -> [Doc ()] -> Doc () hgo String "ArrayType" [BuiltinType -> Doc () ppBuiltinType BuiltinType ty] UserArrayType Lexeme Name ty -> String -> [Doc ()] -> Doc () hgo String "UserArrayType" [Lexeme Name -> Doc () ppLexeme Lexeme Name ty] ConstArrayType BuiltinType ty -> String -> [Doc ()] -> Doc () hgo String "ConstArrayType" [BuiltinType -> Doc () ppBuiltinType BuiltinType ty] ConstType Decl (Lexeme Name) ty -> String -> [Doc ()] -> Doc () hgo String "ConstType" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) ty] Paren Decl (Lexeme Name) expr -> String -> [Doc ()] -> Doc () hgo String "Paren" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) expr] Ref Lexeme Name name -> String -> [Doc ()] -> Doc () hgo String "Ref" [Lexeme Name -> Doc () ppLexeme Lexeme Name name] IntVal Lexeme Name val -> String -> [Doc ()] -> Doc () hgo String "IntVal" [Lexeme Name -> Doc () ppLexeme Lexeme Name val] Abs Decl (Lexeme Name) e -> String -> [Doc ()] -> Doc () hgo String "Abs" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) e] Max Decl (Lexeme Name) a Decl (Lexeme Name) b -> String -> [Doc ()] -> Doc () hgo String "Max" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) a, Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) b] Add Decl (Lexeme Name) l Decl (Lexeme Name) r -> String -> [Doc ()] -> Doc () hgo String "Add" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) l, Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) r] Sub Decl (Lexeme Name) l Decl (Lexeme Name) r -> String -> [Doc ()] -> Doc () hgo String "Sub" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) l, Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) r] Mul Decl (Lexeme Name) l Decl (Lexeme Name) r -> String -> [Doc ()] -> Doc () hgo String "Mul" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) l, Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) r] Div Decl (Lexeme Name) l Decl (Lexeme Name) r -> String -> [Doc ()] -> Doc () hgo String "Div" [Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) l, Decl (Lexeme Name) -> Doc () ppDecl Decl (Lexeme Name) r] ppConstness :: Constness -> Doc () ppConstness :: Constness -> Doc () ppConstness Constness ConstThis = String -> Doc () forall a ann. Pretty a => a -> Doc ann pretty String "True" ppConstness Constness MutableThis = String -> Doc () forall a ann. Pretty a => a -> Doc ann pretty String "False" ppGenerated :: Generated -> Doc () ppGenerated :: Generated -> Doc () ppGenerated = String -> Doc () ppCtor (String -> Doc ()) -> (Generated -> String) -> Generated -> Doc () forall b c a. (b -> c) -> (a -> b) -> a -> c . (String "Generated." String -> String -> String forall a. Semigroup a => a -> a -> a <>) (String -> String) -> (Generated -> String) -> Generated -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . Generated -> String forall a. Show a => a -> String show ppBuiltinType :: BuiltinType -> Doc () ppBuiltinType :: BuiltinType -> Doc () ppBuiltinType BuiltinType Void = String -> Doc () ppCtor String "Void" ppBuiltinType BuiltinType VoidPtr = String -> Doc () ppCtor String "VoidPtr" ppBuiltinType BuiltinType Bool = String -> Doc () ppCtor String "Bool" ppBuiltinType BuiltinType Char = String -> Doc () ppCtor String "Char" ppBuiltinType (SInt BitSize bs) = String -> [Doc ()] -> Doc () hgo String "SInt" [BitSize -> Doc () ppBitSize BitSize bs] ppBuiltinType (UInt BitSize bs) = String -> [Doc ()] -> Doc () hgo String "UInt" [BitSize -> Doc () ppBitSize BitSize bs] ppBuiltinType BuiltinType SizeT = String -> Doc () ppCtor String "SizeT" ppBuiltinType BuiltinType String = String -> Doc () ppCtor String "String" ppBitSize :: BitSize -> Doc () ppBitSize :: BitSize -> Doc () ppBitSize BitSize B8 = Int -> Doc () int Int 8 ppBitSize BitSize B16 = Int -> Doc () int Int 16 ppBitSize BitSize B32 = Int -> Doc () int Int 32 ppBitSize BitSize B64 = Int -> Doc () int Int 64 ppMaybe :: (a -> Doc ()) -> Maybe a -> Doc () ppMaybe :: (a -> Doc ()) -> Maybe a -> Doc () ppMaybe a -> Doc () _ Maybe a Nothing = String -> Doc () forall a ann. Pretty a => a -> Doc ann pretty String "None" ppMaybe a -> Doc () f (Just a x) = a -> Doc () f a x ppLexeme :: Lexeme Name -> Doc () ppLexeme :: Lexeme Name -> Doc () ppLexeme (L AlexPosn _ LexemeClass c Name s) = LexemeClass -> Name -> Doc () ppName LexemeClass c Name s ppName :: LexemeClass -> Name -> Doc () ppName :: LexemeClass -> Name -> Doc () ppName LexemeClass c ([Text] ns, [Text] name) = String -> [Doc ()] -> Doc () hgo String "Name" [ String -> Doc () ppCtor (String -> Doc ()) -> (LexemeClass -> String) -> LexemeClass -> Doc () forall b c a. (b -> c) -> (a -> b) -> a -> c . (String "LexemeClass." String -> String -> String forall a. Semigroup a => a -> a -> a <>) (String -> String) -> (LexemeClass -> String) -> LexemeClass -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . LexemeClass -> String forall a. Show a => a -> String show (LexemeClass -> Doc ()) -> LexemeClass -> Doc () forall a b. (a -> b) -> a -> b $ LexemeClass c , (Text -> Doc ()) -> [Text] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList (String -> Doc () forall a ann. Pretty a => a -> Doc ann pretty (String -> Doc ()) -> (Text -> String) -> Text -> Doc () forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String forall a. Show a => a -> String show) [Text] ns , (Text -> Doc ()) -> [Text] -> Doc () forall a. (a -> Doc ()) -> [a] -> Doc () ppList (String -> Doc () forall a ann. Pretty a => a -> Doc ann pretty (String -> Doc ()) -> (Text -> String) -> Text -> Doc () forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String forall a. Show a => a -> String show) [Text] name ] renderSmart :: Float -> Int -> Doc () -> SimpleDocStream () renderSmart :: Float -> Int -> Doc () -> SimpleDocStream () renderSmart Float ribbonFraction Int widthPerLine = LayoutOptions -> Doc () -> SimpleDocStream () forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann layoutSmart LayoutOptions :: PageWidth -> LayoutOptions LayoutOptions { layoutPageWidth :: PageWidth layoutPageWidth = Int -> Double -> PageWidth AvailablePerLine Int widthPerLine (Float -> Double forall a b. (Real a, Fractional b) => a -> b realToFrac Float ribbonFraction) } render :: Doc () -> Text render :: Doc () -> Text render = Text -> Text TL.toStrict (Text -> Text) -> (Doc () -> Text) -> Doc () -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . SimpleDocStream () -> Text forall ann. SimpleDocStream ann -> Text Term.renderLazy (SimpleDocStream () -> Text) -> (Doc () -> SimpleDocStream ()) -> Doc () -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Float -> Int -> Doc () -> SimpleDocStream () renderSmart Float 1 Int 120 generate :: Model (Lexeme Name) -> Text generate :: Model (Lexeme Name) -> Text generate = Doc () -> Text render (Doc () -> Text) -> (Model (Lexeme Name) -> Doc ()) -> Model (Lexeme Name) -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Model (Lexeme Name) -> Doc () ppModel int :: Int -> Doc () int :: Int -> Doc () int = Int -> Doc () forall a ann. Pretty a => a -> Doc ann pretty