{-# LANGUAGE TypeFamilies #-}

-- | The logic to render Python code is contained in this module
module GOOL.Drasil.LanguageRenderer.PythonRenderer (
  -- * Python Code Configuration -- defines syntax of all Python code
  PythonCode(..), pyName, pyVersion
) where

import Utils.Drasil (blank, indent)

import GOOL.Drasil.CodeType (CodeType(..))
import GOOL.Drasil.ClassInterface (Label, Library, VSType, SVariable, SValue, 
  VSFunction, MSStatement, MixedCtorCall, OOProg, ProgramSym(..), FileSym(..), 
  PermanenceSym(..), BodySym(..), BlockSym(..), TypeSym(..), TypeElim(..), 
  VariableSym(..), VariableElim(..), ValueSym(..), Argument(..), Literal(..), 
  MathConstant(..), VariableValue(..), CommandLineArgs(..), 
  NumericExpression(..), BooleanExpression(..), Comparison(..), 
  ValueExpression(..), funcApp, selfFuncApp, extFuncApp, extNewObj, 
  InternalValueExp(..), objMethodCall, FunctionSym(..), GetSet(..), List(..), 
  InternalList(..), StatementSym(..), AssignStatement(..), (&=), 
  DeclStatement(..), IOStatement(..), StringStatement(..), FuncAppStatement(..),
  CommentStatement(..), ControlStatement(..), switchAsIf, StatePattern(..), 
  ObserverPattern(..), StrategyPattern(..), ScopeSym(..), ParameterSym(..), 
  MethodSym(..), StateVarSym(..), ClassSym(..), ModuleSym(..))
import GOOL.Drasil.RendererClasses (RenderSym, RenderFile(..), ImportSym(..), 
  ImportElim, PermElim(binding), RenderBody(..), BodyElim, RenderBlock(..), 
  BlockElim, RenderType(..), InternalTypeElim, UnaryOpSym(..), BinaryOpSym(..), 
  OpElim(uOpPrec, bOpPrec), RenderVariable(..), InternalVarElim(variableBind), 
  RenderValue(..), ValueElim(valuePrec), InternalGetSet(..), 
  InternalListFunc(..), RenderFunction(..), 
  FunctionElim(functionType), InternalAssignStmt(..), InternalIOStmt(..), 
  InternalControlStmt(..), RenderStatement(..), StatementElim(statementTerm), 
  RenderScope(..), ScopeElim, MethodTypeSym(..), RenderParam(..), 
  ParamElim(parameterName, parameterType), RenderMethod(..), MethodElim, 
  StateVarElim, RenderClass(..), ClassElim, RenderMod(..), ModuleElim, 
  BlockCommentSym(..), BlockCommentElim)
import qualified GOOL.Drasil.RendererClasses as RC (import', perm, body, block, 
  type', uOp, bOp, variable, value, function, statement, scope, parameter,
  method, stateVar, class', module', blockComment')
import GOOL.Drasil.LanguageRenderer (classDec, dot, ifLabel, elseLabel, 
  forLabel, inLabel, whileLabel, tryLabel, importLabel, exceptionObj', listSep',
  argv, printLabel, listSep, piLabel, access, functionDox, variableList, 
  parameterList)
import qualified GOOL.Drasil.LanguageRenderer as R (sqrt, fabs, log10, 
  log, exp, sin, cos, tan, asin, acos, atan, floor, ceil, multiStmt, body, 
  classVar, listSetFunc, castObj, dynamic, break, continue, addComments, 
  commentedMod, commentedItem)
import GOOL.Drasil.LanguageRenderer.Constructors (mkStmtNoEnd, mkStateVal, 
  mkVal, mkStateVar, VSOp, unOpPrec, powerPrec, multPrec, andPrec, orPrec, 
  unExpr, unExpr', typeUnExpr, binExpr, typeBinExpr)
import qualified GOOL.Drasil.LanguageRenderer.LanguagePolymorphic as G (
  multiBody, block, multiBlock, listInnerType, obj, negateOp, csc, sec, 
  cot, equalOp, notEqualOp, greaterOp, greaterEqualOp, lessOp, lessEqualOp, 
  plusOp, minusOp, multOp, divideOp, moduloOp, var, staticVar, objVar, 
  arrayElem, litChar, litDouble, litInt, litString, valueOf, arg, argsList, 
  objAccess, objMethodCall, call, funcAppMixedArgs, selfFuncAppMixedArgs, 
  newObjMixedArgs, lambda, func, get, set, listAdd, listAppend, listAccess, 
  listSet, getFunc, setFunc, listAppendFunc, stmt, loopStmt, emptyStmt, assign, 
  subAssign, increment, objDecNew, print, closeFile, returnStmt, valStmt, 
  comment, throw, ifCond, tryCatch, construct, param, method, getMethod, 
  setMethod, function, buildClass, implementingClass, commentedClass, 
  modFromData, fileDoc, fileFromData)
import qualified GOOL.Drasil.LanguageRenderer.CommonPseudoOO as CP (int,
  constructor, doxFunc, doxClass, doxMod, extVar, classVar, objVarSelf,
  extFuncAppMixedArgs, indexOf, listAddFunc, discardFileLine, intClass, 
  funcType, buildModule, bindingError, notNull, listDecDef, destructorError, 
  stateVarDef, constVar, litArray, listSetFunc, extraClass, listAccessFunc, 
  multiAssign, multiReturn, listDec, funcDecDef, inOutCall, forLoopError, 
  mainBody, inOutFunc, docInOutFunc')
import qualified GOOL.Drasil.LanguageRenderer.Macros as M (ifExists, 
  decrement1, increment1, runStrategy, stringListVals, stringListLists, 
  notifyObservers', checkState)
import GOOL.Drasil.AST (Terminator(..), FileType(..), FileData(..), fileD, 
  FuncData(..), fd, ModData(..), md, updateMod, MethodData(..), mthd, 
  updateMthd, OpData(..), ParamData(..), pd, ProgData(..), progD, TypeData(..), 
  td, ValData(..), vd, VarData(..), vard)
import GOOL.Drasil.Helpers (vibcat, emptyIfEmpty, toCode, toState, onCodeValue,
  onStateValue, on2CodeValues, on2StateValues, onCodeList, onStateList, on2StateWrapped)
import GOOL.Drasil.State (MS, VS, lensGStoFS, lensMStoVS, lensVStoMS, 
  revFiles, addLangImportVS, getLangImports, addLibImportVS, 
  getLibImports, addModuleImport, addModuleImportVS, getModuleImports, 
  setFileType, getClassName, setCurrMain, getClassMap, getMainDoc)

import Prelude hiding (break,print,sin,cos,tan,floor,(<>))
import Data.Maybe (fromMaybe)
import Control.Lens.Zoom (zoom)
import Control.Monad (join)
import Control.Monad.State (modify)
import Data.List (intercalate, sort)
import qualified Data.Map as Map (lookup)
import Text.PrettyPrint.HughesPJ (Doc, text, (<>), (<+>), parens, empty, equals,
  vcat, colon, brackets, isEmpty, quotes)

pyExt :: String
pyExt :: String
pyExt = "py"

newtype PythonCode a = PC {PythonCode a -> a
unPC :: a}

instance Functor PythonCode where
  fmap :: (a -> b) -> PythonCode a -> PythonCode b
fmap f :: a -> b
f (PC x :: a
x) = b -> PythonCode b
forall a. a -> PythonCode a
PC (a -> b
f a
x)

instance Applicative PythonCode where
  pure :: a -> PythonCode a
pure = a -> PythonCode a
forall a. a -> PythonCode a
PC
  (PC f :: a -> b
f) <*> :: PythonCode (a -> b) -> PythonCode a -> PythonCode b
<*> (PC x :: a
x) = b -> PythonCode b
forall a. a -> PythonCode a
PC (a -> b
f a
x)

instance Monad PythonCode where
  return :: a -> PythonCode a
return = a -> PythonCode a
forall a. a -> PythonCode a
PC
  PC x :: a
x >>= :: PythonCode a -> (a -> PythonCode b) -> PythonCode b
>>= f :: a -> PythonCode b
f = a -> PythonCode b
f a
x

instance OOProg PythonCode

instance ProgramSym PythonCode where
  type Program PythonCode = ProgData 
  prog :: String -> [SFile PythonCode] -> GSProgram PythonCode
prog n :: String
n files :: [SFile PythonCode]
files = do
    [PythonCode FileData]
fs <- (StateT FileState Identity (PythonCode FileData)
 -> StateT GOOLState Identity (PythonCode FileData))
-> [StateT FileState Identity (PythonCode FileData)]
-> StateT GOOLState Identity [PythonCode FileData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (LensLike'
  (Zoomed (StateT FileState Identity) (PythonCode FileData))
  GOOLState
  FileState
-> StateT FileState Identity (PythonCode FileData)
-> StateT GOOLState Identity (PythonCode FileData)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT FileState Identity) (PythonCode FileData))
  GOOLState
  FileState
Lens' GOOLState FileState
lensGStoFS) [StateT FileState Identity (PythonCode FileData)]
[SFile PythonCode]
files
    (GOOLState -> GOOLState) -> StateT GOOLState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GOOLState -> GOOLState
revFiles
    PythonCode ProgData
-> StateT GOOLState Identity (PythonCode ProgData)
forall (m :: * -> *) a. Monad m => a -> m a
return (PythonCode ProgData
 -> StateT GOOLState Identity (PythonCode ProgData))
-> PythonCode ProgData
-> StateT GOOLState Identity (PythonCode ProgData)
forall a b. (a -> b) -> a -> b
$ ([FileData] -> ProgData)
-> [PythonCode FileData] -> PythonCode ProgData
forall (m :: * -> *) a b. Monad m => ([a] -> b) -> [m a] -> m b
onCodeList (String -> [FileData] -> ProgData
progD String
n) [PythonCode FileData]
fs

instance RenderSym PythonCode

instance FileSym PythonCode where
  type File PythonCode = FileData
  fileDoc :: FSModule PythonCode -> SFile PythonCode
fileDoc m :: FSModule PythonCode
m = do
    (FileState -> FileState) -> StateT FileState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FileType -> FileState -> FileState
setFileType FileType
Combined)
    String
-> (PythonCode (Module PythonCode)
    -> PythonCode (Block PythonCode))
-> PythonCode (Block PythonCode)
-> FSModule PythonCode
-> SFile PythonCode
forall (r :: * -> *).
RenderSym r =>
String
-> (r (Module r) -> r (Block r))
-> r (Block r)
-> FSModule r
-> SFile r
G.fileDoc String
pyExt PythonCode (Module PythonCode) -> PythonCode (Block PythonCode)
forall (r :: * -> *). RenderFile r => r (Module r) -> r (Block r)
top PythonCode (Block PythonCode)
forall (r :: * -> *). RenderFile r => r (Block r)
bottom FSModule PythonCode
m

  docMod :: String
-> [String] -> String -> SFile PythonCode -> SFile PythonCode
docMod = String
-> String
-> [String]
-> String
-> SFile PythonCode
-> SFile PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> String -> [String] -> String -> SFile r -> SFile r
CP.doxMod String
pyExt

instance RenderFile PythonCode where
  top :: PythonCode (Module PythonCode) -> PythonCode (Block PythonCode)
top _ = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  bottom :: PythonCode (Block PythonCode)
bottom = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  
  commentedMod :: SFile PythonCode
-> FS (PythonCode (BlockComment PythonCode)) -> SFile PythonCode
commentedMod = (PythonCode FileData -> PythonCode Doc -> PythonCode FileData)
-> StateT FileState Identity (PythonCode FileData)
-> State FileState (PythonCode Doc)
-> StateT FileState Identity (PythonCode FileData)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((FileData -> Doc -> FileData)
-> PythonCode FileData -> PythonCode Doc -> PythonCode FileData
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues FileData -> Doc -> FileData
R.commentedMod)

  fileFromData :: String -> FSModule PythonCode -> SFile PythonCode
fileFromData = (String
 -> PythonCode (Module PythonCode) -> PythonCode (File PythonCode))
-> String -> FSModule PythonCode -> SFile PythonCode
forall (r :: * -> *).
RenderSym r =>
(String -> r (Module r) -> r (File r))
-> String -> FSModule r -> SFile r
G.fileFromData ((ModData -> FileData) -> PythonCode ModData -> PythonCode FileData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ((ModData -> FileData)
 -> PythonCode ModData -> PythonCode FileData)
-> (String -> ModData -> FileData)
-> String
-> PythonCode ModData
-> PythonCode FileData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModData -> FileData
fileD)

instance ImportSym PythonCode where
  type Import PythonCode = Doc
  langImport :: String -> PythonCode (Import PythonCode)
langImport n :: String
n = Doc -> PythonCode (Import PythonCode)
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> PythonCode (Import PythonCode))
-> Doc -> PythonCode (Import PythonCode)
forall a b. (a -> b) -> a -> b
$ Doc
importLabel Doc -> Doc -> Doc
<+> String -> Doc
text String
n
  modImport :: String -> PythonCode (Import PythonCode)
modImport = String -> PythonCode (Import PythonCode)
forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport

instance ImportElim PythonCode where
  import' :: PythonCode (Import PythonCode) -> Doc
import' = PythonCode (Import PythonCode) -> Doc
forall a. PythonCode a -> a
unPC

instance PermanenceSym PythonCode where
  type Permanence PythonCode = Doc
  static :: PythonCode (Permanence PythonCode)
static = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  dynamic :: PythonCode (Permanence PythonCode)
dynamic = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
R.dynamic

instance PermElim PythonCode where
  perm :: PythonCode (Permanence PythonCode) -> Doc
perm = PythonCode (Permanence PythonCode) -> Doc
forall a. PythonCode a -> a
unPC
  binding :: PythonCode (Permanence PythonCode) -> Binding
binding = String -> PythonCode (Permanence PythonCode) -> Binding
forall a. HasCallStack => String -> a
error (String -> PythonCode (Permanence PythonCode) -> Binding)
-> String -> PythonCode (Permanence PythonCode) -> Binding
forall a b. (a -> b) -> a -> b
$ String -> String
CP.bindingError String
pyName

instance BodySym PythonCode where
  type Body PythonCode = Doc
  body :: [MSBlock PythonCode] -> MSBody PythonCode
body = ([PythonCode Doc] -> PythonCode Doc)
-> [State MethodState (PythonCode Doc)]
-> State MethodState (PythonCode Doc)
forall a b s. ([a] -> b) -> [State s a] -> State s b
onStateList (([Doc] -> Doc) -> [PythonCode Doc] -> PythonCode Doc
forall (m :: * -> *) a b. Monad m => ([a] -> b) -> [m a] -> m b
onCodeList [Doc] -> Doc
R.body)

  addComments :: String -> MSBody PythonCode -> MSBody PythonCode
addComments s :: String
s = (PythonCode Doc -> PythonCode Doc)
-> State MethodState (PythonCode Doc)
-> State MethodState (PythonCode Doc)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((Doc -> Doc) -> PythonCode Doc -> PythonCode Doc
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue (String -> Doc -> Doc -> Doc
R.addComments String
s Doc
pyCommentStart))

instance RenderBody PythonCode where
  multiBody :: [MSBody PythonCode] -> MSBody PythonCode
multiBody = [MSBody PythonCode] -> MSBody PythonCode
forall (r :: * -> *).
(RenderSym r, Monad r) =>
[MSBody r] -> MS (r Doc)
G.multiBody 

instance BodyElim PythonCode where
  body :: PythonCode (Body PythonCode) -> Doc
body = PythonCode (Body PythonCode) -> Doc
forall a. PythonCode a -> a
unPC

instance BlockSym PythonCode where
  type Block PythonCode = Doc
  block :: [MSStatement PythonCode] -> MSBlock PythonCode
block = [MSStatement PythonCode] -> MSBlock PythonCode
forall (r :: * -> *).
(RenderSym r, Monad r) =>
[MSStatement r] -> MS (r Doc)
G.block

instance RenderBlock PythonCode where
  multiBlock :: [MSBlock PythonCode] -> MSBlock PythonCode
multiBlock = [MSBlock PythonCode] -> MSBlock PythonCode
forall (r :: * -> *).
(RenderSym r, Monad r) =>
[MSBlock r] -> MS (r Doc)
G.multiBlock

instance BlockElim PythonCode where
  block :: PythonCode (Block PythonCode) -> Doc
block = PythonCode (Block PythonCode) -> Doc
forall a. PythonCode a -> a
unPC

instance TypeSym PythonCode where
  type Type PythonCode = TypeData
  bool :: VSType PythonCode
bool = CodeType -> String -> Doc -> VSType PythonCode
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Boolean "" Doc
empty
  int :: VSType PythonCode
int = VSType PythonCode
forall (r :: * -> *). RenderSym r => VSType r
CP.int
  float :: VSType PythonCode
float = String -> StateT ValueState Identity (PythonCode TypeData)
forall a. HasCallStack => String -> a
error String
pyFloatError
  double :: VSType PythonCode
double = CodeType -> String -> Doc -> VSType PythonCode
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Double String
pyDouble (String -> Doc
text String
pyDouble)
  char :: VSType PythonCode
char = CodeType -> String -> Doc -> VSType PythonCode
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Char "" Doc
empty
  string :: VSType PythonCode
string = VSType PythonCode
forall (r :: * -> *). RenderSym r => VSType r
pyStringType
  infile :: VSType PythonCode
infile = CodeType -> String -> Doc -> VSType PythonCode
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
InFile "" Doc
empty
  outfile :: VSType PythonCode
outfile = CodeType -> String -> Doc -> VSType PythonCode
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
OutFile "" Doc
empty
  listType :: VSType PythonCode -> VSType PythonCode
listType t' :: VSType PythonCode
t' = StateT ValueState Identity (PythonCode TypeData)
VSType PythonCode
t' StateT ValueState Identity (PythonCode TypeData)
-> (PythonCode TypeData
    -> StateT ValueState Identity (PythonCode TypeData))
-> StateT ValueState Identity (PythonCode TypeData)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=(\t :: PythonCode TypeData
t -> CodeType -> String -> Doc -> VSType PythonCode
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData (CodeType -> CodeType
List (PythonCode (Type PythonCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType PythonCode TypeData
PythonCode (Type PythonCode)
t)) "" Doc
empty)
  arrayType :: VSType PythonCode -> VSType PythonCode
arrayType = VSType PythonCode -> VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType
  listInnerType :: VSType PythonCode -> VSType PythonCode
listInnerType = VSType PythonCode -> VSType PythonCode
forall (r :: * -> *). RenderSym r => VSType r -> VSType r
G.listInnerType
  obj :: String -> VSType PythonCode
obj = String -> VSType PythonCode
forall (r :: * -> *). RenderSym r => String -> VSType r
G.obj
  funcType :: [VSType PythonCode] -> VSType PythonCode -> VSType PythonCode
funcType = [VSType PythonCode] -> VSType PythonCode -> VSType PythonCode
forall (r :: * -> *).
RenderSym r =>
[VSType r] -> VSType r -> VSType r
CP.funcType
  void :: VSType PythonCode
void = CodeType -> String -> Doc -> VSType PythonCode
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Void String
pyVoid (String -> Doc
text String
pyVoid)

instance TypeElim PythonCode where
  getType :: PythonCode (Type PythonCode) -> CodeType
getType = TypeData -> CodeType
cType (TypeData -> CodeType)
-> (PythonCode TypeData -> TypeData)
-> PythonCode TypeData
-> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode TypeData -> TypeData
forall a. PythonCode a -> a
unPC
  getTypeString :: PythonCode (Type PythonCode) -> String
getTypeString = TypeData -> String
typeString (TypeData -> String)
-> (PythonCode TypeData -> TypeData)
-> PythonCode TypeData
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode TypeData -> TypeData
forall a. PythonCode a -> a
unPC

instance RenderType PythonCode where
  multiType :: [VSType PythonCode] -> VSType PythonCode
multiType _ = CodeType -> String -> Doc -> VSType PythonCode
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Void "" Doc
empty
  typeFromData :: CodeType -> String -> Doc -> VSType PythonCode
typeFromData t :: CodeType
t s :: String
s d :: Doc
d = PythonCode TypeData -> VSType PythonCode
forall a s. a -> State s a
toState (PythonCode TypeData -> VSType PythonCode)
-> PythonCode TypeData -> VSType PythonCode
forall a b. (a -> b) -> a -> b
$ TypeData -> PythonCode TypeData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (TypeData -> PythonCode TypeData)
-> TypeData -> PythonCode TypeData
forall a b. (a -> b) -> a -> b
$ CodeType -> String -> Doc -> TypeData
td CodeType
t String
s Doc
d

instance InternalTypeElim PythonCode where
  type' :: PythonCode (Type PythonCode) -> Doc
type' = TypeData -> Doc
typeDoc (TypeData -> Doc)
-> (PythonCode TypeData -> TypeData) -> PythonCode TypeData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode TypeData -> TypeData
forall a. PythonCode a -> a
unPC

instance UnaryOpSym PythonCode where
  type UnaryOp PythonCode = OpData
  notOp :: VSUnOp PythonCode
notOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyNotOp
  negateOp :: VSUnOp PythonCode
negateOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.negateOp
  sqrtOp :: VSUnOp PythonCode
sqrtOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pySqrtOp
  absOp :: VSUnOp PythonCode
absOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyAbsOp
  logOp :: VSUnOp PythonCode
logOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyLogOp
  lnOp :: VSUnOp PythonCode
lnOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyLnOp
  expOp :: VSUnOp PythonCode
expOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyExpOp
  sinOp :: VSUnOp PythonCode
sinOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pySinOp
  cosOp :: VSUnOp PythonCode
cosOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyCosOp
  tanOp :: VSUnOp PythonCode
tanOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyTanOp
  asinOp :: VSUnOp PythonCode
asinOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyAsinOp
  acosOp :: VSUnOp PythonCode
acosOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyAcosOp
  atanOp :: VSUnOp PythonCode
atanOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyAtanOp
  floorOp :: VSUnOp PythonCode
floorOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyFloorOp 
  ceilOp :: VSUnOp PythonCode
ceilOp = VSUnOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
pyCeilOp

instance BinaryOpSym PythonCode where
  type BinaryOp PythonCode = OpData
  equalOp :: VSBinOp PythonCode
equalOp = VSBinOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.equalOp
  notEqualOp :: VSBinOp PythonCode
notEqualOp = VSBinOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.notEqualOp
  greaterOp :: VSBinOp PythonCode
greaterOp = VSBinOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.greaterOp
  greaterEqualOp :: VSBinOp PythonCode
greaterEqualOp = VSBinOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.greaterEqualOp
  lessOp :: VSBinOp PythonCode
lessOp = VSBinOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.lessOp
  lessEqualOp :: VSBinOp PythonCode
lessEqualOp = VSBinOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.lessEqualOp
  plusOp :: VSBinOp PythonCode
plusOp = VSBinOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.plusOp
  minusOp :: VSBinOp PythonCode
minusOp = VSBinOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.minusOp
  multOp :: VSBinOp PythonCode
multOp = VSBinOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.multOp
  divideOp :: VSBinOp PythonCode
divideOp = VSBinOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.divideOp
  powerOp :: VSBinOp PythonCode
powerOp = String -> VSOp PythonCode
forall (r :: * -> *). Monad r => String -> VSOp r
powerPrec String
pyPower
  moduloOp :: VSBinOp PythonCode
moduloOp = VSBinOp PythonCode
forall (r :: * -> *). Monad r => VSOp r
G.moduloOp
  andOp :: VSBinOp PythonCode
andOp = String -> VSOp PythonCode
forall (r :: * -> *). Monad r => String -> VSOp r
andPrec String
pyAnd
  orOp :: VSBinOp PythonCode
orOp = String -> VSOp PythonCode
forall (r :: * -> *). Monad r => String -> VSOp r
orPrec String
pyOr

instance OpElim PythonCode where
  uOp :: PythonCode (UnaryOp PythonCode) -> Doc
uOp = OpData -> Doc
opDoc (OpData -> Doc)
-> (PythonCode OpData -> OpData) -> PythonCode OpData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode OpData -> OpData
forall a. PythonCode a -> a
unPC
  bOp :: PythonCode (BinaryOp PythonCode) -> Doc
bOp = OpData -> Doc
opDoc (OpData -> Doc)
-> (PythonCode OpData -> OpData) -> PythonCode OpData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode OpData -> OpData
forall a. PythonCode a -> a
unPC
  uOpPrec :: PythonCode (UnaryOp PythonCode) -> Int
uOpPrec = OpData -> Int
opPrec (OpData -> Int)
-> (PythonCode OpData -> OpData) -> PythonCode OpData -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode OpData -> OpData
forall a. PythonCode a -> a
unPC
  bOpPrec :: PythonCode (BinaryOp PythonCode) -> Int
bOpPrec = OpData -> Int
opPrec (OpData -> Int)
-> (PythonCode OpData -> OpData) -> PythonCode OpData -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode OpData -> OpData
forall a. PythonCode a -> a
unPC

instance VariableSym PythonCode where
  type Variable PythonCode = VarData
  var :: String -> VSType PythonCode -> SVariable PythonCode
var = String -> VSType PythonCode -> SVariable PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> VSType r -> SVariable r
G.var
  staticVar :: String -> VSType PythonCode -> SVariable PythonCode
staticVar = String -> VSType PythonCode -> SVariable PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> VSType r -> SVariable r
G.staticVar
  const :: String -> VSType PythonCode -> SVariable PythonCode
const = String -> VSType PythonCode -> SVariable PythonCode
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var
  extVar :: String -> String -> VSType PythonCode -> SVariable PythonCode
extVar l :: String
l n :: String
n t :: VSType PythonCode
t = (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addModuleImportVS String
l) StateT ValueState Identity ()
-> StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> String -> VSType PythonCode -> SVariable PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> String -> VSType r -> SVariable r
CP.extVar String
l String
n VSType PythonCode
t
  self :: SVariable PythonCode
self = LensLike'
  (Zoomed (StateT MethodState Identity) String)
  ValueState
  MethodState
-> StateT MethodState Identity String
-> StateT ValueState Identity String
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT MethodState Identity) String)
  ValueState
  MethodState
Lens' ValueState MethodState
lensVStoMS StateT MethodState Identity String
getClassName StateT ValueState Identity String
-> (String -> StateT ValueState Identity (PythonCode VarData))
-> StateT ValueState Identity (PythonCode VarData)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\l :: String
l -> String -> VSType PythonCode -> Doc -> SVariable PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> VSType r -> Doc -> SVariable r
mkStateVar String
pySelf (String -> VSType PythonCode
forall (r :: * -> *). TypeSym r => String -> VSType r
obj String
l) (String -> Doc
text String
pySelf))
  classVar :: VSType PythonCode -> SVariable PythonCode -> SVariable PythonCode
classVar = (Doc -> Doc -> Doc)
-> VSType PythonCode
-> SVariable PythonCode
-> SVariable PythonCode
forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc -> Doc) -> VSType r -> SVariable r -> SVariable r
CP.classVar Doc -> Doc -> Doc
R.classVar
  extClassVar :: VSType PythonCode -> SVariable PythonCode -> SVariable PythonCode
extClassVar c :: VSType PythonCode
c v :: SVariable PythonCode
v = StateT
  ValueState
  Identity
  (StateT ValueState Identity (PythonCode VarData))
-> SVariable PythonCode
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (StateT
   ValueState
   Identity
   (StateT ValueState Identity (PythonCode VarData))
 -> SVariable PythonCode)
-> StateT
     ValueState
     Identity
     (StateT ValueState Identity (PythonCode VarData))
-> SVariable PythonCode
forall a b. (a -> b) -> a -> b
$ (PythonCode TypeData
 -> Map String String
 -> StateT ValueState Identity (PythonCode VarData))
-> StateT ValueState Identity (PythonCode TypeData)
-> State ValueState (Map String String)
-> StateT
     ValueState
     Identity
     (StateT ValueState Identity (PythonCode VarData))
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\t :: PythonCode TypeData
t cm :: Map String String
cm -> (StateT ValueState Identity (PythonCode VarData)
 -> StateT ValueState Identity (PythonCode VarData))
-> (String
    -> StateT ValueState Identity (PythonCode VarData)
    -> StateT ValueState Identity (PythonCode VarData))
-> Maybe String
-> StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall a. a -> a
id (StateT ValueState Identity ()
-> StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (StateT ValueState Identity ()
 -> StateT ValueState Identity (PythonCode VarData)
 -> StateT ValueState Identity (PythonCode VarData))
-> (String -> StateT ValueState Identity ())
-> String
-> StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ValueState -> ValueState) -> StateT ValueState Identity ())
-> (String -> ValueState -> ValueState)
-> String
-> StateT ValueState Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
    String -> ValueState -> ValueState
addModuleImportVS) (String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PythonCode (Type PythonCode) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString PythonCode TypeData
PythonCode (Type PythonCode)
t) Map String String
cm) (StateT ValueState Identity (PythonCode VarData)
 -> StateT ValueState Identity (PythonCode VarData))
-> StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall a b. (a -> b) -> a -> b
$ 
    (Doc -> Doc -> Doc)
-> VSType PythonCode
-> SVariable PythonCode
-> SVariable PythonCode
forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc -> Doc) -> VSType r -> SVariable r -> SVariable r
CP.classVar Doc -> Doc -> Doc
pyClassVar (PythonCode TypeData
-> StateT ValueState Identity (PythonCode TypeData)
forall a s. a -> State s a
toState PythonCode TypeData
t) SVariable PythonCode
v) StateT ValueState Identity (PythonCode TypeData)
VSType PythonCode
c State ValueState (Map String String)
getClassMap
  objVar :: SVariable PythonCode
-> SVariable PythonCode -> SVariable PythonCode
objVar = SVariable PythonCode
-> SVariable PythonCode -> SVariable PythonCode
forall (r :: * -> *).
RenderSym r =>
SVariable r -> SVariable r -> SVariable r
G.objVar
  objVarSelf :: SVariable PythonCode -> SVariable PythonCode
objVarSelf = SVariable PythonCode -> SVariable PythonCode
forall (r :: * -> *). RenderSym r => SVariable r -> SVariable r
CP.objVarSelf
  arrayElem :: Integer -> SVariable PythonCode -> SVariable PythonCode
arrayElem i :: Integer
i = SValue PythonCode -> SVariable PythonCode -> SVariable PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> SVariable r -> SVariable r
G.arrayElem (Integer -> SValue PythonCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
i)

instance VariableElim PythonCode where
  variableName :: PythonCode (Variable PythonCode) -> String
variableName = VarData -> String
varName (VarData -> String)
-> (PythonCode VarData -> VarData) -> PythonCode VarData -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode VarData -> VarData
forall a. PythonCode a -> a
unPC
  variableType :: PythonCode (Variable PythonCode) -> PythonCode (Type PythonCode)
variableType = (VarData -> TypeData) -> PythonCode VarData -> PythonCode TypeData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue VarData -> TypeData
varType

instance InternalVarElim PythonCode where
  variableBind :: PythonCode (Variable PythonCode) -> Binding
variableBind = VarData -> Binding
varBind (VarData -> Binding)
-> (PythonCode VarData -> VarData) -> PythonCode VarData -> Binding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode VarData -> VarData
forall a. PythonCode a -> a
unPC
  variable :: PythonCode (Variable PythonCode) -> Doc
variable = VarData -> Doc
varDoc (VarData -> Doc)
-> (PythonCode VarData -> VarData) -> PythonCode VarData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode VarData -> VarData
forall a. PythonCode a -> a
unPC

instance RenderVariable PythonCode where
  varFromData :: Binding
-> String -> VSType PythonCode -> Doc -> SVariable PythonCode
varFromData b :: Binding
b n :: String
n t' :: VSType PythonCode
t' d :: Doc
d = do 
    PythonCode TypeData
t <- StateT ValueState Identity (PythonCode TypeData)
VSType PythonCode
t'
    PythonCode VarData
-> StateT ValueState Identity (PythonCode VarData)
forall a s. a -> State s a
toState (PythonCode VarData
 -> StateT ValueState Identity (PythonCode VarData))
-> PythonCode VarData
-> StateT ValueState Identity (PythonCode VarData)
forall a b. (a -> b) -> a -> b
$ (TypeData -> Doc -> VarData)
-> PythonCode TypeData -> PythonCode Doc -> PythonCode VarData
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues (Binding -> String -> TypeData -> Doc -> VarData
vard Binding
b String
n) PythonCode TypeData
t (Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
d)

instance ValueSym PythonCode where
  type Value PythonCode = ValData
  valueType :: PythonCode (Value PythonCode) -> PythonCode (Type PythonCode)
valueType = (ValData -> TypeData) -> PythonCode ValData -> PythonCode TypeData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ValData -> TypeData
valType

instance Argument PythonCode where
  pointerArg :: SValue PythonCode -> SValue PythonCode
pointerArg = SValue PythonCode -> SValue PythonCode
forall a. a -> a
id

instance Literal PythonCode where
  litTrue :: SValue PythonCode
litTrue = VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool Doc
pyTrue
  litFalse :: SValue PythonCode
litFalse = VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool Doc
pyFalse
  litChar :: Char -> SValue PythonCode
litChar = (Doc -> Doc) -> Char -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc) -> Char -> SValue r
G.litChar Doc -> Doc
quotes
  litDouble :: Double -> SValue PythonCode
litDouble = Double -> SValue PythonCode
forall (r :: * -> *). RenderSym r => Double -> SValue r
G.litDouble
  litFloat :: Float -> SValue PythonCode
litFloat = String -> Float -> VS (PythonCode ValData)
forall a. HasCallStack => String -> a
error String
pyFloatError
  litInt :: Integer -> SValue PythonCode
litInt = Integer -> SValue PythonCode
forall (r :: * -> *). RenderSym r => Integer -> SValue r
G.litInt
  litString :: String -> SValue PythonCode
litString = String -> SValue PythonCode
forall (r :: * -> *). RenderSym r => String -> SValue r
G.litString
  litArray :: VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode
litArray = (Doc -> Doc)
-> VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc) -> VSType r -> [SValue r] -> SValue r
CP.litArray Doc -> Doc
brackets
  litList :: VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode
litList = VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode
forall (r :: * -> *).
Literal r =>
VSType r -> [SValue r] -> SValue r
litArray

instance MathConstant PythonCode where
  pi :: SValue PythonCode
pi = VS (PythonCode ValData) -> SValue PythonCode
forall a. VS a -> VS a
addmathImport (VS (PythonCode ValData) -> SValue PythonCode)
-> VS (PythonCode ValData) -> SValue PythonCode
forall a b. (a -> b) -> a -> b
$ VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
double Doc
pyPi

instance VariableValue PythonCode where
  valueOf :: SVariable PythonCode -> SValue PythonCode
valueOf = SVariable PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SVariable r -> SValue r
G.valueOf

instance CommandLineArgs PythonCode where
  arg :: Integer -> SValue PythonCode
arg n :: Integer
n = SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r
G.arg (Integer -> SValue PythonCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt (Integer -> SValue PythonCode) -> Integer -> SValue PythonCode
forall a b. (a -> b) -> a -> b
$ Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1) SValue PythonCode
forall (r :: * -> *). CommandLineArgs r => SValue r
argsList
  argsList :: SValue PythonCode
argsList = do
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLangImportVS String
pySys)
    String -> VS (PythonCode ValData)
forall (r :: * -> *). RenderSym r => String -> SValue r
G.argsList (String -> VS (PythonCode ValData))
-> String -> VS (PythonCode ValData)
forall a b. (a -> b) -> a -> b
$ String
pySys String -> String -> String
`access` String
argv
  argExists :: Integer -> SValue PythonCode
argExists i :: Integer
i = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). List r => SValue r -> SValue r
listSize SValue PythonCode
forall (r :: * -> *). CommandLineArgs r => SValue r
argsList SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> Integer -> SValue PythonCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1)

instance NumericExpression PythonCode where
  #~ :: SValue PythonCode -> SValue PythonCode
(#~) = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr' VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
negateOp
  #/^ :: SValue PythonCode -> SValue PythonCode
(#/^) = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
sqrtOp
  #| :: SValue PythonCode -> SValue PythonCode
(#|) = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
absOp
  #+ :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#+) = VSBinOp PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
plusOp
  #- :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#-) = VSBinOp PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
minusOp
  #* :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#*) = VSBinOp PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
multOp
  #/ :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#/) v1' :: SValue PythonCode
v1' v2' :: SValue PythonCode
v2' = do
    PythonCode ValData
v1 <- VS (PythonCode ValData)
SValue PythonCode
v1'
    PythonCode ValData
v2 <- VS (PythonCode ValData)
SValue PythonCode
v2'
    let pyDivision :: CodeType
-> CodeType
-> VS (r (Value r))
-> VS (r (Value r))
-> VS (r (Value r))
pyDivision Integer Integer = VSBinOp r
-> VS (r (Value r)) -> VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr (String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
multPrec String
pyIntDiv)
        pyDivision _ _ = VSBinOp r
-> VS (r (Value r)) -> VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp r
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
divideOp
    CodeType
-> CodeType
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
forall (r :: * -> *).
(RenderSym r, Monad r, BinaryOp r ~ OpData) =>
CodeType
-> CodeType
-> VS (r (Value r))
-> VS (r (Value r))
-> VS (r (Value r))
pyDivision (PythonCode (Type PythonCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (PythonCode (Type PythonCode) -> CodeType)
-> PythonCode (Type PythonCode) -> CodeType
forall a b. (a -> b) -> a -> b
$ PythonCode (Value PythonCode) -> PythonCode (Type PythonCode)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType PythonCode ValData
PythonCode (Value PythonCode)
v1) (PythonCode (Type PythonCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (PythonCode (Type PythonCode) -> CodeType)
-> PythonCode (Type PythonCode) -> CodeType
forall a b. (a -> b) -> a -> b
$ PythonCode (Value PythonCode) -> PythonCode (Type PythonCode)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType PythonCode ValData
PythonCode (Value PythonCode)
v2) (PythonCode ValData -> VS (PythonCode ValData)
forall (m :: * -> *) a. Monad m => a -> m a
return PythonCode ValData
v1) 
      (PythonCode ValData -> VS (PythonCode ValData)
forall (m :: * -> *) a. Monad m => a -> m a
return PythonCode ValData
v2)
  #% :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#%) = VSBinOp PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
moduloOp
  #^ :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#^) = VSBinOp PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
powerOp

  log :: SValue PythonCode -> SValue PythonCode
log = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
logOp
  ln :: SValue PythonCode -> SValue PythonCode
ln = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
lnOp
  exp :: SValue PythonCode -> SValue PythonCode
exp = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
expOp
  sin :: SValue PythonCode -> SValue PythonCode
sin = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
sinOp
  cos :: SValue PythonCode -> SValue PythonCode
cos = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
cosOp
  tan :: SValue PythonCode -> SValue PythonCode
tan = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
tanOp
  csc :: SValue PythonCode -> SValue PythonCode
csc = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
G.csc
  sec :: SValue PythonCode -> SValue PythonCode
sec = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
G.sec
  cot :: SValue PythonCode -> SValue PythonCode
cot = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
G.cot
  arcsin :: SValue PythonCode -> SValue PythonCode
arcsin = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
asinOp
  arccos :: SValue PythonCode -> SValue PythonCode
arccos = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
acosOp
  arctan :: SValue PythonCode -> SValue PythonCode
arctan = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
atanOp
  floor :: SValue PythonCode -> SValue PythonCode
floor = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
floorOp
  ceil :: SValue PythonCode -> SValue PythonCode
ceil = VSUnOp PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
ceilOp

instance BooleanExpression PythonCode where
  ?! :: SValue PythonCode -> SValue PythonCode
(?!) = VSUnOp PythonCode
-> VSType PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> VSType r -> SValue r -> SValue r
typeUnExpr VSUnOp PythonCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
notOp VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool
  ?&& :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?&&) = VSBinOp PythonCode
-> VSType PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
andOp VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool
  ?|| :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?||) = VSBinOp PythonCode
-> VSType PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
orOp VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool

instance Comparison PythonCode where
  ?< :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?<) = VSBinOp PythonCode
-> VSType PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
lessOp VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool
  ?<= :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?<=) = VSBinOp PythonCode
-> VSType PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
lessEqualOp VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool
  ?> :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?>) = VSBinOp PythonCode
-> VSType PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
greaterOp VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool
  ?>= :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?>=) = VSBinOp PythonCode
-> VSType PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
greaterEqualOp VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool
  ?== :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?==) = VSBinOp PythonCode
-> VSType PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
equalOp VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool
  ?!= :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?!=) = VSBinOp PythonCode
-> VSType PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr VSBinOp PythonCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
notEqualOp VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool

instance ValueExpression PythonCode where
  inlineIf :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
inlineIf = SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
pyInlineIf

  funcAppMixedArgs :: MixedCall PythonCode
funcAppMixedArgs = MixedCall PythonCode
forall (r :: * -> *). RenderSym r => MixedCall r
G.funcAppMixedArgs
  selfFuncAppMixedArgs :: MixedCall PythonCode
selfFuncAppMixedArgs = Doc -> SVariable PythonCode -> MixedCall PythonCode
forall (r :: * -> *).
RenderSym r =>
Doc -> SVariable r -> MixedCall r
G.selfFuncAppMixedArgs Doc
dot SVariable PythonCode
forall (r :: * -> *). VariableSym r => SVariable r
self
  extFuncAppMixedArgs :: String -> MixedCall PythonCode
extFuncAppMixedArgs l :: String
l n :: String
n t :: VSType PythonCode
t ps :: [SValue PythonCode]
ps ns :: NamedArgs PythonCode
ns = do
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addModuleImportVS String
l)
    String -> MixedCall PythonCode
forall (r :: * -> *). RenderSym r => String -> MixedCall r
CP.extFuncAppMixedArgs String
l String
n VSType PythonCode
t [SValue PythonCode]
ps NamedArgs PythonCode
ns
  libFuncAppMixedArgs :: String -> MixedCall PythonCode
libFuncAppMixedArgs l :: String
l n :: String
n t :: VSType PythonCode
t ps :: [SValue PythonCode]
ps ns :: NamedArgs PythonCode
ns = do
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l)
    String -> MixedCall PythonCode
forall (r :: * -> *). RenderSym r => String -> MixedCall r
CP.extFuncAppMixedArgs String
l String
n VSType PythonCode
t [SValue PythonCode]
ps NamedArgs PythonCode
ns
  newObjMixedArgs :: MixedCtorCall PythonCode
newObjMixedArgs = MixedCall PythonCode
forall (r :: * -> *). RenderSym r => MixedCall r
G.newObjMixedArgs ""
  extNewObjMixedArgs :: MixedCall PythonCode
extNewObjMixedArgs l :: String
l tp :: VSType PythonCode
tp ps :: [SValue PythonCode]
ps ns :: NamedArgs PythonCode
ns = do
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addModuleImportVS String
l)
    MixedCall PythonCode
forall (r :: * -> *). RenderSym r => MixedCall r
pyExtNewObjMixedArgs String
l VSType PythonCode
tp [SValue PythonCode]
ps NamedArgs PythonCode
ns
  libNewObjMixedArgs :: MixedCall PythonCode
libNewObjMixedArgs l :: String
l tp :: VSType PythonCode
tp ps :: [SValue PythonCode]
ps ns :: NamedArgs PythonCode
ns = do
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l)
    MixedCall PythonCode
forall (r :: * -> *). RenderSym r => MixedCall r
pyExtNewObjMixedArgs String
l VSType PythonCode
tp [SValue PythonCode]
ps NamedArgs PythonCode
ns

  lambda :: [SVariable PythonCode] -> SValue PythonCode -> SValue PythonCode
lambda = ([PythonCode (Variable PythonCode)]
 -> PythonCode (Value PythonCode) -> Doc)
-> [SVariable PythonCode] -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
([r (Variable r)] -> r (Value r) -> Doc)
-> [SVariable r] -> SValue r -> SValue r
G.lambda [PythonCode (Variable PythonCode)]
-> PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *).
RenderSym r =>
[r (Variable r)] -> r (Value r) -> Doc
pyLambda

  notNull :: SValue PythonCode -> SValue PythonCode
notNull = String -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => String -> SValue r -> SValue r
CP.notNull String
pyNull

instance RenderValue PythonCode where
  inputFunc :: SValue PythonCode
inputFunc = VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
string Doc
pyInputFunc
  printFunc :: SValue PythonCode
printFunc = VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
pyPrintFunc
  printLnFunc :: SValue PythonCode
printLnFunc = VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty
  printFileFunc :: SValue PythonCode -> SValue PythonCode
printFileFunc _ = VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty
  printFileLnFunc :: SValue PythonCode -> SValue PythonCode
printFileLnFunc _ = VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty
  
  cast :: VSType PythonCode -> SValue PythonCode -> SValue PythonCode
cast = (PythonCode TypeData
 -> PythonCode ValData -> VS (PythonCode ValData))
-> StateT ValueState Identity (PythonCode TypeData)
-> VS (PythonCode ValData)
-> VS (PythonCode ValData)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped (\t :: PythonCode TypeData
t v :: PythonCode ValData
v-> PythonCode (Type PythonCode) -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => r (Type r) -> Doc -> SValue r
mkVal PythonCode TypeData
PythonCode (Type PythonCode)
t (Doc -> VS (PythonCode ValData))
-> (Doc -> Doc) -> Doc -> VS (PythonCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc
R.castObj (PythonCode (Type PythonCode) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' PythonCode TypeData
PythonCode (Type PythonCode)
t) 
    (Doc -> VS (PythonCode ValData)) -> Doc -> VS (PythonCode ValData)
forall a b. (a -> b) -> a -> b
$ PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
PythonCode (Value PythonCode)
v)
  
  call :: Maybe String -> Maybe Doc -> MixedCall PythonCode
call = Doc -> Maybe String -> Maybe Doc -> MixedCall PythonCode
forall (r :: * -> *).
RenderSym r =>
Doc -> Maybe String -> Maybe Doc -> MixedCall r
G.call Doc
pyNamedArgSep

  valFromData :: Maybe Int -> VSType PythonCode -> Doc -> SValue PythonCode
valFromData p :: Maybe Int
p t' :: VSType PythonCode
t' d :: Doc
d = do 
    PythonCode TypeData
t <- StateT ValueState Identity (PythonCode TypeData)
VSType PythonCode
t'
    PythonCode ValData -> VS (PythonCode ValData)
forall a s. a -> State s a
toState (PythonCode ValData -> VS (PythonCode ValData))
-> PythonCode ValData -> VS (PythonCode ValData)
forall a b. (a -> b) -> a -> b
$ (TypeData -> Doc -> ValData)
-> PythonCode TypeData -> PythonCode Doc -> PythonCode ValData
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues (Maybe Int -> TypeData -> Doc -> ValData
vd Maybe Int
p) PythonCode TypeData
t (Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
d)

instance ValueElim PythonCode where
  valuePrec :: PythonCode (Value PythonCode) -> Maybe Int
valuePrec = ValData -> Maybe Int
valPrec (ValData -> Maybe Int)
-> (PythonCode ValData -> ValData)
-> PythonCode ValData
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode ValData -> ValData
forall a. PythonCode a -> a
unPC
  value :: PythonCode (Value PythonCode) -> Doc
value = ValData -> Doc
val (ValData -> Doc)
-> (PythonCode ValData -> ValData) -> PythonCode ValData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode ValData -> ValData
forall a. PythonCode a -> a
unPC

instance InternalValueExp PythonCode where
  objMethodCallMixedArgs' :: String
-> VSType PythonCode
-> SValue PythonCode
-> [SValue PythonCode]
-> NamedArgs PythonCode
-> SValue PythonCode
objMethodCallMixedArgs' = String
-> VSType PythonCode
-> SValue PythonCode
-> [SValue PythonCode]
-> NamedArgs PythonCode
-> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
String
-> VSType r -> SValue r -> [SValue r] -> NamedArgs r -> SValue r
G.objMethodCall

instance FunctionSym PythonCode where
  type Function PythonCode = FuncData
  func :: String
-> VSType PythonCode
-> [SValue PythonCode]
-> VSFunction PythonCode
func = String
-> VSType PythonCode
-> [SValue PythonCode]
-> VSFunction PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
G.func
  objAccess :: SValue PythonCode -> VSFunction PythonCode -> SValue PythonCode
objAccess = SValue PythonCode -> VSFunction PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> VSFunction r -> SValue r
G.objAccess

instance GetSet PythonCode where
  get :: SValue PythonCode -> SVariable PythonCode -> SValue PythonCode
get = SValue PythonCode -> SVariable PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> SVariable r -> SValue r
G.get
  set :: SValue PythonCode
-> SVariable PythonCode -> SValue PythonCode -> SValue PythonCode
set = SValue PythonCode
-> SVariable PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> SVariable r -> SValue r -> SValue r
G.set

instance List PythonCode where
  listSize :: SValue PythonCode -> SValue PythonCode
listSize = (PythonCode FuncData
 -> PythonCode ValData -> VS (PythonCode ValData))
-> StateT ValueState Identity (PythonCode FuncData)
-> VS (PythonCode ValData)
-> VS (PythonCode ValData)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped(\f :: PythonCode FuncData
f v :: PythonCode ValData
v-> PythonCode (Type PythonCode) -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => r (Type r) -> Doc -> SValue r
mkVal (PythonCode (Function PythonCode) -> PythonCode (Type PythonCode)
forall (r :: * -> *).
FunctionElim r =>
r (Function r) -> r (Type r)
functionType PythonCode FuncData
PythonCode (Function PythonCode)
f) 
    (Doc -> Doc -> Doc
pyListSize (PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
PythonCode (Value PythonCode)
v) (PythonCode (Function PythonCode) -> Doc
forall (r :: * -> *). FunctionElim r => r (Function r) -> Doc
RC.function PythonCode FuncData
PythonCode (Function PythonCode)
f))) StateT ValueState Identity (PythonCode FuncData)
forall (r :: * -> *). InternalListFunc r => VSFunction r
listSizeFunc
  listAdd :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listAdd = SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
G.listAdd
  listAppend :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listAppend = SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r
G.listAppend
  listAccess :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listAccess = SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r
G.listAccess
  listSet :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listSet = SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
G.listSet
  indexOf :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
indexOf = String
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.indexOf String
pyIndex

instance InternalList PythonCode where
  listSlice' :: Maybe (SValue PythonCode)
-> Maybe (SValue PythonCode)
-> Maybe (SValue PythonCode)
-> SVariable PythonCode
-> SValue PythonCode
-> MSBlock PythonCode
listSlice' b :: Maybe (SValue PythonCode)
b e :: Maybe (SValue PythonCode)
e s :: Maybe (SValue PythonCode)
s vn :: SVariable PythonCode
vn vo :: SValue PythonCode
vo = SVariable PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> State MethodState (PythonCode Doc)
forall (r :: * -> *).
(RenderSym r, Monad r) =>
SVariable r
-> SValue r -> SValue r -> SValue r -> SValue r -> MS (r Doc)
pyListSlice SVariable PythonCode
vn SValue PythonCode
vo (Maybe (SValue PythonCode) -> SValue PythonCode
getVal Maybe (SValue PythonCode)
b) (Maybe (SValue PythonCode) -> SValue PythonCode
getVal Maybe (SValue PythonCode)
e) (Maybe (SValue PythonCode) -> SValue PythonCode
getVal Maybe (SValue PythonCode)
s)
    where getVal :: Maybe (SValue PythonCode) -> SValue PythonCode
getVal = SValue PythonCode -> Maybe (SValue PythonCode) -> SValue PythonCode
forall a. a -> Maybe a -> a
fromMaybe (VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty)

instance InternalGetSet PythonCode where
  getFunc :: SVariable PythonCode -> VSFunction PythonCode
getFunc = SVariable PythonCode -> VSFunction PythonCode
forall (r :: * -> *). RenderSym r => SVariable r -> VSFunction r
G.getFunc
  setFunc :: VSType PythonCode
-> SVariable PythonCode
-> SValue PythonCode
-> VSFunction PythonCode
setFunc = VSType PythonCode
-> SVariable PythonCode
-> SValue PythonCode
-> VSFunction PythonCode
forall (r :: * -> *).
RenderSym r =>
VSType r -> SVariable r -> SValue r -> VSFunction r
G.setFunc

instance InternalListFunc PythonCode where
  listSizeFunc :: VSFunction PythonCode
listSizeFunc = Doc -> VSType PythonCode -> VSFunction PythonCode
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData Doc
pyListSizeFunc VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
int
  listAddFunc :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> VSFunction PythonCode
listAddFunc _ = String
-> SValue PythonCode -> SValue PythonCode -> VSFunction PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> SValue r -> SValue r -> VSFunction r
CP.listAddFunc String
pyInsert
  listAppendFunc :: SValue PythonCode -> VSFunction PythonCode
listAppendFunc = String -> SValue PythonCode -> VSFunction PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> SValue r -> VSFunction r
G.listAppendFunc String
pyAppendFunc
  listAccessFunc :: VSType PythonCode -> SValue PythonCode -> VSFunction PythonCode
listAccessFunc = VSType PythonCode -> SValue PythonCode -> VSFunction PythonCode
forall (r :: * -> *).
RenderSym r =>
VSType r -> SValue r -> VSFunction r
CP.listAccessFunc
  listSetFunc :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> VSFunction PythonCode
listSetFunc = (Doc -> Doc -> Doc)
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> VSFunction PythonCode
forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc -> Doc)
-> SValue r -> SValue r -> SValue r -> VSFunction r
CP.listSetFunc Doc -> Doc -> Doc
R.listSetFunc

instance RenderFunction PythonCode where
  funcFromData :: Doc -> VSType PythonCode -> VSFunction PythonCode
funcFromData d :: Doc
d = (PythonCode TypeData -> PythonCode FuncData)
-> StateT ValueState Identity (PythonCode TypeData)
-> StateT ValueState Identity (PythonCode FuncData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((TypeData -> FuncData)
-> PythonCode TypeData -> PythonCode FuncData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue (TypeData -> Doc -> FuncData
`fd` Doc
d))
  
instance FunctionElim PythonCode where
  functionType :: PythonCode (Function PythonCode) -> PythonCode (Type PythonCode)
functionType = (FuncData -> TypeData)
-> PythonCode FuncData -> PythonCode TypeData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue FuncData -> TypeData
fType
  function :: PythonCode (Function PythonCode) -> Doc
function = FuncData -> Doc
funcDoc (FuncData -> Doc)
-> (PythonCode FuncData -> FuncData) -> PythonCode FuncData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode FuncData -> FuncData
forall a. PythonCode a -> a
unPC

instance InternalAssignStmt PythonCode where
  multiAssign :: [SVariable PythonCode]
-> [SValue PythonCode] -> MSStatement PythonCode
multiAssign = (Doc -> Doc)
-> [SVariable PythonCode]
-> [SValue PythonCode]
-> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc) -> [SVariable r] -> [SValue r] -> MSStatement r
CP.multiAssign Doc -> Doc
forall a. a -> a
id

instance InternalIOStmt PythonCode where
  printSt :: Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
printSt = Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
pyPrint

instance InternalControlStmt PythonCode where
  multiReturn :: [SValue PythonCode] -> MSStatement PythonCode
multiReturn = (Doc -> Doc) -> [SValue PythonCode] -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc) -> [SValue r] -> MSStatement r
CP.multiReturn Doc -> Doc
forall a. a -> a
id

instance RenderStatement PythonCode where
  stmt :: MSStatement PythonCode -> MSStatement PythonCode
stmt = MSStatement PythonCode -> MSStatement PythonCode
forall (r :: * -> *). RenderSym r => MSStatement r -> MSStatement r
G.stmt
  loopStmt :: MSStatement PythonCode -> MSStatement PythonCode
loopStmt = MSStatement PythonCode -> MSStatement PythonCode
forall (r :: * -> *). RenderSym r => MSStatement r -> MSStatement r
G.loopStmt
  
  emptyStmt :: MSStatement PythonCode
emptyStmt = MSStatement PythonCode
forall (r :: * -> *). RenderSym r => MSStatement r
G.emptyStmt

  stmtFromData :: Doc -> Terminator -> MSStatement PythonCode
stmtFromData d :: Doc
d t :: Terminator
t = PythonCode (Doc, Terminator) -> MSStatement PythonCode
forall a s. a -> State s a
toState (PythonCode (Doc, Terminator) -> MSStatement PythonCode)
-> PythonCode (Doc, Terminator) -> MSStatement PythonCode
forall a b. (a -> b) -> a -> b
$ (Doc, Terminator) -> PythonCode (Doc, Terminator)
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc
d, Terminator
t)

instance StatementElim PythonCode where
  statement :: PythonCode (Statement PythonCode) -> Doc
statement = (Doc, Terminator) -> Doc
forall a b. (a, b) -> a
fst ((Doc, Terminator) -> Doc)
-> (PythonCode (Doc, Terminator) -> (Doc, Terminator))
-> PythonCode (Doc, Terminator)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode (Doc, Terminator) -> (Doc, Terminator)
forall a. PythonCode a -> a
unPC
  statementTerm :: PythonCode (Statement PythonCode) -> Terminator
statementTerm = (Doc, Terminator) -> Terminator
forall a b. (a, b) -> b
snd ((Doc, Terminator) -> Terminator)
-> (PythonCode (Doc, Terminator) -> (Doc, Terminator))
-> PythonCode (Doc, Terminator)
-> Terminator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode (Doc, Terminator) -> (Doc, Terminator)
forall a. PythonCode a -> a
unPC

instance StatementSym PythonCode where
  -- Terminator determines how statements end
  type Statement PythonCode = (Doc, Terminator)
  valStmt :: SValue PythonCode -> MSStatement PythonCode
valStmt = Terminator -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
Terminator -> SValue r -> MSStatement r
G.valStmt Terminator
Empty
  multi :: [MSStatement PythonCode] -> MSStatement PythonCode
multi = ([PythonCode (Doc, Terminator)] -> PythonCode (Doc, Terminator))
-> [State MethodState (PythonCode (Doc, Terminator))]
-> State MethodState (PythonCode (Doc, Terminator))
forall a b s. ([a] -> b) -> [State s a] -> State s b
onStateList (([(Doc, Terminator)] -> (Doc, Terminator))
-> [PythonCode (Doc, Terminator)] -> PythonCode (Doc, Terminator)
forall (m :: * -> *) a b. Monad m => ([a] -> b) -> [m a] -> m b
onCodeList [(Doc, Terminator)] -> (Doc, Terminator)
R.multiStmt)

instance AssignStatement PythonCode where
  assign :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
assign = Terminator
-> SVariable PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
Terminator -> SVariable r -> SValue r -> MSStatement r
G.assign Terminator
Empty
  &-= :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
(&-=) = Terminator
-> SVariable PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
Terminator -> SVariable r -> SValue r -> MSStatement r
G.subAssign Terminator
Empty
  &+= :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
(&+=) = SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
SVariable r -> SValue r -> MSStatement r
G.increment
  &++ :: SVariable PythonCode -> MSStatement PythonCode
(&++) = SVariable PythonCode -> MSStatement PythonCode
forall (r :: * -> *). RenderSym r => SVariable r -> MSStatement r
M.increment1
  &-- :: SVariable PythonCode -> MSStatement PythonCode
(&--) = SVariable PythonCode -> MSStatement PythonCode
forall (r :: * -> *). RenderSym r => SVariable r -> MSStatement r
M.decrement1

instance DeclStatement PythonCode where
  varDec :: SVariable PythonCode -> MSStatement PythonCode
varDec _ = Doc -> MSStatement PythonCode
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd Doc
empty
  varDecDef :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
varDecDef = SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign
  listDec :: Integer -> SVariable PythonCode -> MSStatement PythonCode
listDec _ = SVariable PythonCode -> MSStatement PythonCode
forall (r :: * -> *). RenderSym r => SVariable r -> MSStatement r
CP.listDec
  listDecDef :: SVariable PythonCode
-> [SValue PythonCode] -> MSStatement PythonCode
listDecDef = SVariable PythonCode
-> [SValue PythonCode] -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
SVariable r -> [SValue r] -> MSStatement r
CP.listDecDef
  arrayDec :: Integer -> SVariable PythonCode -> MSStatement PythonCode
arrayDec = Integer -> SVariable PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
Integer -> SVariable r -> MSStatement r
listDec
  arrayDecDef :: SVariable PythonCode
-> [SValue PythonCode] -> MSStatement PythonCode
arrayDecDef = SVariable PythonCode
-> [SValue PythonCode] -> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> [SValue r] -> MSStatement r
listDecDef
  objDecDef :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
objDecDef = SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef
  objDecNew :: SVariable PythonCode
-> [SValue PythonCode] -> MSStatement PythonCode
objDecNew = SVariable PythonCode
-> [SValue PythonCode] -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
SVariable r -> [SValue r] -> MSStatement r
G.objDecNew
  extObjDecNew :: String
-> SVariable PythonCode
-> [SValue PythonCode]
-> MSStatement PythonCode
extObjDecNew lib :: String
lib v :: SVariable PythonCode
v vs :: [SValue PythonCode]
vs = do
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> MethodState -> MethodState
addModuleImport String
lib)
    SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef SVariable PythonCode
v (String
-> VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode
forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
extNewObj String
lib ((PythonCode VarData -> PythonCode TypeData)
-> StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue PythonCode VarData -> PythonCode TypeData
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType StateT ValueState Identity (PythonCode VarData)
SVariable PythonCode
v) [SValue PythonCode]
vs)
  constDecDef :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
constDecDef = SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef
  funcDecDef :: SVariable PythonCode
-> [SVariable PythonCode]
-> MSBody PythonCode
-> MSStatement PythonCode
funcDecDef = SVariable PythonCode
-> [SVariable PythonCode]
-> MSBody PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
SVariable r -> [SVariable r] -> MSBody r -> MSStatement r
CP.funcDecDef

instance IOStatement PythonCode where
  print :: SValue PythonCode -> MSStatement PythonCode
print      = Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
False Maybe (SValue PythonCode)
forall a. Maybe a
Nothing SValue PythonCode
forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printLn :: SValue PythonCode -> MSStatement PythonCode
printLn    = Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
True  Maybe (SValue PythonCode)
forall a. Maybe a
Nothing SValue PythonCode
forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printStr :: String -> MSStatement PythonCode
printStr   = VS (PythonCode ValData)
-> State MethodState (PythonCode (Doc, Terminator))
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print   (VS (PythonCode ValData)
 -> State MethodState (PythonCode (Doc, Terminator)))
-> (String -> VS (PythonCode ValData))
-> String
-> State MethodState (PythonCode (Doc, Terminator))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VS (PythonCode ValData)
forall (r :: * -> *). Literal r => String -> SValue r
litString
  printStrLn :: String -> MSStatement PythonCode
printStrLn = VS (PythonCode ValData)
-> State MethodState (PythonCode (Doc, Terminator))
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
printLn (VS (PythonCode ValData)
 -> State MethodState (PythonCode (Doc, Terminator)))
-> (String -> VS (PythonCode ValData))
-> String
-> State MethodState (PythonCode (Doc, Terminator))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VS (PythonCode ValData)
forall (r :: * -> *). Literal r => String -> SValue r
litString

  printFile :: SValue PythonCode -> SValue PythonCode -> MSStatement PythonCode
printFile f :: SValue PythonCode
f      = Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
False (VS (PythonCode ValData) -> Maybe (VS (PythonCode ValData))
forall a. a -> Maybe a
Just VS (PythonCode ValData)
SValue PythonCode
f) SValue PythonCode
forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printFileLn :: SValue PythonCode -> SValue PythonCode -> MSStatement PythonCode
printFileLn f :: SValue PythonCode
f    = Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
True  (VS (PythonCode ValData) -> Maybe (VS (PythonCode ValData))
forall a. a -> Maybe a
Just VS (PythonCode ValData)
SValue PythonCode
f) SValue PythonCode
forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printFileStr :: SValue PythonCode -> String -> MSStatement PythonCode
printFileStr f :: SValue PythonCode
f   = SValue PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFile SValue PythonCode
f   (VS (PythonCode ValData)
 -> State MethodState (PythonCode (Doc, Terminator)))
-> (String -> VS (PythonCode ValData))
-> String
-> State MethodState (PythonCode (Doc, Terminator))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VS (PythonCode ValData)
forall (r :: * -> *). Literal r => String -> SValue r
litString
  printFileStrLn :: SValue PythonCode -> String -> MSStatement PythonCode
printFileStrLn f :: SValue PythonCode
f = SValue PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFileLn SValue PythonCode
f (VS (PythonCode ValData)
 -> State MethodState (PythonCode (Doc, Terminator)))
-> (String -> VS (PythonCode ValData))
-> String
-> State MethodState (PythonCode (Doc, Terminator))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VS (PythonCode ValData)
forall (r :: * -> *). Literal r => String -> SValue r
litString

  getInput :: SVariable PythonCode -> MSStatement PythonCode
getInput = SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
pyInput SValue PythonCode
forall (r :: * -> *). RenderValue r => SValue r
inputFunc
  discardInput :: MSStatement PythonCode
discardInput = SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt SValue PythonCode
forall (r :: * -> *). RenderValue r => SValue r
inputFunc
  getFileInput :: SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
getFileInput f :: SValue PythonCode
f = SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
pyInput (SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readline SValue PythonCode
f)
  discardFileInput :: SValue PythonCode -> MSStatement PythonCode
discardFileInput f :: SValue PythonCode
f = SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readline SValue PythonCode
f)

  openFileR :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
openFileR f :: SVariable PythonCode
f n :: SValue PythonCode
n = SVariable PythonCode
f SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
openRead SValue PythonCode
n
  openFileW :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
openFileW f :: SVariable PythonCode
f n :: SValue PythonCode
n = SVariable PythonCode
f SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
openWrite SValue PythonCode
n
  openFileA :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
openFileA f :: SVariable PythonCode
f n :: SValue PythonCode
n = SVariable PythonCode
f SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
openAppend SValue PythonCode
n
  closeFile :: SValue PythonCode -> MSStatement PythonCode
closeFile = String -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> SValue r -> MSStatement r
G.closeFile String
pyClose

  getFileInputLine :: SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
getFileInputLine = SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
IOStatement r =>
SValue r -> SVariable r -> MSStatement r
getFileInput
  discardFileLine :: SValue PythonCode -> MSStatement PythonCode
discardFileLine = String -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> SValue r -> MSStatement r
CP.discardFileLine String
pyReadline
  getFileInputAll :: SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
getFileInputAll f :: SValue PythonCode
f v :: SVariable PythonCode
v = SVariable PythonCode
v SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readlines SValue PythonCode
f
  
instance StringStatement PythonCode where
  stringSplit :: Char
-> SVariable PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
stringSplit d :: Char
d vnew :: SVariable PythonCode
vnew s :: SValue PythonCode
s = SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign SVariable PythonCode
vnew (SValue PythonCode -> VSFunction PythonCode -> SValue PythonCode
forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
objAccess SValue PythonCode
s (Char -> VSFunction PythonCode
forall (r :: * -> *). RenderSym r => Char -> VSFunction r
splitFunc Char
d))

  stringListVals :: [SVariable PythonCode]
-> SValue PythonCode -> MSStatement PythonCode
stringListVals = [SVariable PythonCode]
-> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
[SVariable r] -> SValue r -> MSStatement r
M.stringListVals
  stringListLists :: [SVariable PythonCode]
-> SValue PythonCode -> MSStatement PythonCode
stringListLists = [SVariable PythonCode]
-> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
[SVariable r] -> SValue r -> MSStatement r
M.stringListLists

instance FuncAppStatement PythonCode where
  inOutCall :: InOutCall PythonCode
inOutCall = (String
 -> VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode)
-> InOutCall PythonCode
forall (r :: * -> *).
RenderSym r =>
(String -> VSType r -> [SValue r] -> SValue r)
-> String
-> [SValue r]
-> [SVariable r]
-> [SVariable r]
-> MSStatement r
CP.inOutCall String
-> VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode
forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp
  selfInOutCall :: InOutCall PythonCode
selfInOutCall = (String
 -> VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode)
-> InOutCall PythonCode
forall (r :: * -> *).
RenderSym r =>
(String -> VSType r -> [SValue r] -> SValue r)
-> String
-> [SValue r]
-> [SVariable r]
-> [SVariable r]
-> MSStatement r
CP.inOutCall String
-> VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode
forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
selfFuncApp
  extInOutCall :: String -> InOutCall PythonCode
extInOutCall m :: String
m = (String
 -> VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode)
-> InOutCall PythonCode
forall (r :: * -> *).
RenderSym r =>
(String -> VSType r -> [SValue r] -> SValue r)
-> String
-> [SValue r]
-> [SVariable r]
-> [SVariable r]
-> MSStatement r
CP.inOutCall (String
-> String
-> VSType PythonCode
-> [SValue PythonCode]
-> SValue PythonCode
forall (r :: * -> *). ValueExpression r => String -> PosCall r
extFuncApp String
m)

instance CommentStatement PythonCode where
  comment :: String -> MSStatement PythonCode
comment = Doc -> String -> MSStatement PythonCode
forall (r :: * -> *). RenderSym r => Doc -> String -> MSStatement r
G.comment Doc
pyCommentStart

instance ControlStatement PythonCode where
  break :: MSStatement PythonCode
break = Doc -> MSStatement PythonCode
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd Doc
R.break
  continue :: MSStatement PythonCode
continue = Doc -> MSStatement PythonCode
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd Doc
R.continue

  returnStmt :: SValue PythonCode -> MSStatement PythonCode
returnStmt = Terminator -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
Terminator -> SValue r -> MSStatement r
G.returnStmt Terminator
Empty

  throw :: String -> MSStatement PythonCode
throw = (PythonCode (Value PythonCode) -> Doc)
-> Terminator -> String -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
(r (Value r) -> Doc) -> Terminator -> String -> MSStatement r
G.throw PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). RenderSym r => r (Value r) -> Doc
pyThrow Terminator
Empty

  ifCond :: [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode -> MSStatement PythonCode
ifCond = (Doc -> Doc)
-> Doc
-> Doc
-> Doc
-> [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc)
-> Doc
-> Doc
-> Doc
-> [(SValue r, MSBody r)]
-> MSBody r
-> MSStatement r
G.ifCond Doc -> Doc
parens Doc
pyBodyStart Doc
pyElseIf Doc
pyBodyEnd
  switch :: SValue PythonCode
-> [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode
-> MSStatement PythonCode
switch = SValue PythonCode
-> [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
(ControlStatement r, Comparison r) =>
SValue r -> [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
switchAsIf

  ifExists :: SValue PythonCode
-> MSBody PythonCode -> MSBody PythonCode -> MSStatement PythonCode
ifExists = SValue PythonCode
-> MSBody PythonCode -> MSBody PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> MSBody r -> MSBody r -> MSStatement r
M.ifExists

  for :: MSStatement PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
-> MSBody PythonCode
-> MSStatement PythonCode
for _ _ _ _ = String -> MSStatement PythonCode
forall a. HasCallStack => String -> a
error (String -> MSStatement PythonCode)
-> String -> MSStatement PythonCode
forall a b. (a -> b) -> a -> b
$ String -> String
CP.forLoopError String
pyName
  forRange :: SVariable PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> MSBody PythonCode
-> MSStatement PythonCode
forRange i :: SVariable PythonCode
i initv :: SValue PythonCode
initv finalv :: SValue PythonCode
finalv stepv :: SValue PythonCode
stepv = SVariable PythonCode
-> SValue PythonCode -> MSBody PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
ControlStatement r =>
SVariable r -> SValue r -> MSBody r -> MSStatement r
forEach SVariable PythonCode
i (SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
range SValue PythonCode
initv SValue PythonCode
finalv SValue PythonCode
stepv)
  forEach :: SVariable PythonCode
-> SValue PythonCode -> MSBody PythonCode -> MSStatement PythonCode
forEach i' :: SVariable PythonCode
i' v' :: SValue PythonCode
v' b' :: MSBody PythonCode
b' = do
    PythonCode VarData
i <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode VarData))
  MethodState
  ValueState
-> StateT ValueState Identity (PythonCode VarData)
-> StateT MethodState Identity (PythonCode VarData)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode VarData))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (PythonCode VarData)
SVariable PythonCode
i'
    PythonCode ValData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS VS (PythonCode ValData)
SValue PythonCode
v'
    PythonCode Doc
b <- State MethodState (PythonCode Doc)
MSBody PythonCode
b'
    Doc -> MSStatement PythonCode
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd (PythonCode (Variable PythonCode)
-> PythonCode (Value PythonCode)
-> PythonCode (Body PythonCode)
-> Doc
forall (r :: * -> *).
RenderSym r =>
r (Variable r) -> r (Value r) -> r (Body r) -> Doc
pyForEach PythonCode VarData
PythonCode (Variable PythonCode)
i PythonCode ValData
PythonCode (Value PythonCode)
v PythonCode Doc
PythonCode (Body PythonCode)
b)
  while :: SValue PythonCode -> MSBody PythonCode -> MSStatement PythonCode
while v' :: SValue PythonCode
v' b' :: MSBody PythonCode
b' = do 
    PythonCode ValData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS VS (PythonCode ValData)
SValue PythonCode
v'
    PythonCode Doc
b <- State MethodState (PythonCode Doc)
MSBody PythonCode
b'
    Doc -> MSStatement PythonCode
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd (PythonCode (Value PythonCode)
-> PythonCode (Body PythonCode) -> Doc
forall (r :: * -> *).
RenderSym r =>
r (Value r) -> r (Body r) -> Doc
pyWhile PythonCode ValData
PythonCode (Value PythonCode)
v PythonCode Doc
PythonCode (Body PythonCode)
b)

  tryCatch :: MSBody PythonCode -> MSBody PythonCode -> MSStatement PythonCode
tryCatch = (PythonCode (Body PythonCode)
 -> PythonCode (Body PythonCode) -> Doc)
-> MSBody PythonCode -> MSBody PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
(r (Body r) -> r (Body r) -> Doc)
-> MSBody r -> MSBody r -> MSStatement r
G.tryCatch PythonCode (Body PythonCode) -> PythonCode (Body PythonCode) -> Doc
forall (r :: * -> *).
RenderSym r =>
r (Body r) -> r (Body r) -> Doc
pyTryCatch

instance StatePattern PythonCode where 
  checkState :: String
-> [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode
-> MSStatement PythonCode
checkState = String
-> [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
M.checkState

instance ObserverPattern PythonCode where
  notifyObservers :: VSFunction PythonCode
-> VSType PythonCode -> MSStatement PythonCode
notifyObservers = VSFunction PythonCode
-> VSType PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
RenderSym r =>
VSFunction r -> VSType r -> MSStatement r
M.notifyObservers'

instance StrategyPattern PythonCode where
  runStrategy :: String
-> [(String, MSBody PythonCode)]
-> Maybe (SValue PythonCode)
-> Maybe (SVariable PythonCode)
-> MSBlock PythonCode
runStrategy = String
-> [(String, MSBody PythonCode)]
-> Maybe (SValue PythonCode)
-> Maybe (SVariable PythonCode)
-> MSBlock PythonCode
forall (r :: * -> *).
(RenderSym r, Monad r) =>
String
-> [(String, MSBody r)]
-> Maybe (SValue r)
-> Maybe (SVariable r)
-> MS (r Doc)
M.runStrategy

instance ScopeSym PythonCode where
  type Scope PythonCode = Doc
  private :: PythonCode (Scope PythonCode)
private = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  public :: PythonCode (Scope PythonCode)
public = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty

instance RenderScope PythonCode where
  scopeFromData :: ScopeTag -> Doc -> PythonCode (Scope PythonCode)
scopeFromData _ = Doc -> PythonCode (Scope PythonCode)
forall (r :: * -> *) a. Monad r => a -> r a
toCode

instance ScopeElim PythonCode where
  scope :: PythonCode (Scope PythonCode) -> Doc
scope = PythonCode (Scope PythonCode) -> Doc
forall a. PythonCode a -> a
unPC

instance MethodTypeSym PythonCode where
  type MethodType PythonCode = TypeData
  mType :: VSType PythonCode -> MSMthdType PythonCode
mType = LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode TypeData))
  MethodState
  ValueState
-> StateT ValueState Identity (PythonCode TypeData)
-> StateT MethodState Identity (PythonCode TypeData)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode TypeData))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS
  construct :: String -> MSMthdType PythonCode
construct = String -> MSMthdType PythonCode
forall (r :: * -> *). RenderSym r => String -> MS (r (Type r))
G.construct

instance ParameterSym PythonCode where
  type Parameter PythonCode = ParamData
  param :: SVariable PythonCode -> MSParameter PythonCode
param = (PythonCode (Variable PythonCode) -> Doc)
-> SVariable PythonCode -> MSParameter PythonCode
forall (r :: * -> *).
RenderSym r =>
(r (Variable r) -> Doc) -> SVariable r -> MSParameter r
G.param PythonCode (Variable PythonCode) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable
  pointerParam :: SVariable PythonCode -> MSParameter PythonCode
pointerParam = SVariable PythonCode -> MSParameter PythonCode
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
param

instance RenderParam PythonCode where
  paramFromData :: SVariable PythonCode -> Doc -> MSParameter PythonCode
paramFromData v' :: SVariable PythonCode
v' d :: Doc
d = do 
    PythonCode VarData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode VarData))
  MethodState
  ValueState
-> StateT ValueState Identity (PythonCode VarData)
-> StateT MethodState Identity (PythonCode VarData)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode VarData))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (PythonCode VarData)
SVariable PythonCode
v'
    PythonCode ParamData -> State MethodState (PythonCode ParamData)
forall a s. a -> State s a
toState (PythonCode ParamData -> State MethodState (PythonCode ParamData))
-> PythonCode ParamData -> State MethodState (PythonCode ParamData)
forall a b. (a -> b) -> a -> b
$ (VarData -> Doc -> ParamData)
-> PythonCode VarData -> PythonCode Doc -> PythonCode ParamData
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues VarData -> Doc -> ParamData
pd PythonCode VarData
v (Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
d)
  
instance ParamElim PythonCode where
  parameterName :: PythonCode (Parameter PythonCode) -> String
parameterName = PythonCode VarData -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName (PythonCode VarData -> String)
-> (PythonCode ParamData -> PythonCode VarData)
-> PythonCode ParamData
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParamData -> VarData)
-> PythonCode ParamData -> PythonCode VarData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ParamData -> VarData
paramVar
  parameterType :: PythonCode (Parameter PythonCode) -> PythonCode (Type PythonCode)
parameterType = PythonCode VarData -> PythonCode TypeData
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType (PythonCode VarData -> PythonCode TypeData)
-> (PythonCode ParamData -> PythonCode VarData)
-> PythonCode ParamData
-> PythonCode TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParamData -> VarData)
-> PythonCode ParamData -> PythonCode VarData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ParamData -> VarData
paramVar
  parameter :: PythonCode (Parameter PythonCode) -> Doc
parameter = ParamData -> Doc
paramDoc (ParamData -> Doc)
-> (PythonCode ParamData -> ParamData)
-> PythonCode ParamData
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode ParamData -> ParamData
forall a. PythonCode a -> a
unPC

instance MethodSym PythonCode where
  type Method PythonCode = MethodData
  method :: String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
method = String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
RenderSym r =>
String
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
G.method
  getMethod :: SVariable PythonCode -> SMethod PythonCode
getMethod = SVariable PythonCode -> SMethod PythonCode
forall (r :: * -> *). RenderSym r => SVariable r -> SMethod r
G.getMethod
  setMethod :: SVariable PythonCode -> SMethod PythonCode
setMethod = SVariable PythonCode -> SMethod PythonCode
forall (r :: * -> *). RenderSym r => SVariable r -> SMethod r
G.setMethod
  constructor :: [MSParameter PythonCode]
-> NamedArgs PythonCode -> MSBody PythonCode -> SMethod PythonCode
constructor = String
-> [MSParameter PythonCode]
-> NamedArgs PythonCode
-> MSBody PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
RenderSym r =>
String
-> [MSParameter r] -> Initializers r -> MSBody r -> SMethod r
CP.constructor String
initName

  docMain :: MSBody PythonCode -> SMethod PythonCode
docMain = MSBody PythonCode -> SMethod PythonCode
forall (r :: * -> *). MethodSym r => MSBody r -> SMethod r
mainFunction

  function :: String
-> PythonCode (Scope PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
function = String
-> PythonCode (Scope PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
RenderSym r =>
String
-> r (Scope r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
G.function
  mainFunction :: MSBody PythonCode -> SMethod PythonCode
mainFunction = MSBody PythonCode -> SMethod PythonCode
forall (r :: * -> *). RenderSym r => MSBody r -> SMethod r
CP.mainBody

  docFunc :: String
-> [String]
-> Maybe String
-> SMethod PythonCode
-> SMethod PythonCode
docFunc = String
-> [String]
-> Maybe String
-> SMethod PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> [String] -> Maybe String -> SMethod r -> SMethod r
CP.doxFunc

  inOutMethod :: String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> InOutFunc PythonCode
inOutMethod n :: String
n s :: PythonCode (Scope PythonCode)
s p :: PythonCode (Permanence PythonCode)
p = (VSType PythonCode
 -> [MSParameter PythonCode]
 -> MSBody PythonCode
 -> SMethod PythonCode)
-> InOutFunc PythonCode
forall (r :: * -> *).
RenderSym r =>
(VSType r -> [MSParameter r] -> MSBody r -> SMethod r)
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MSBody r
-> SMethod r
CP.inOutFunc (String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
MethodSym r =>
String
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method String
n PythonCode (Scope PythonCode)
s PythonCode (Permanence PythonCode)
p)

  docInOutMethod :: String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> DocInOutFunc PythonCode
docInOutMethod n :: String
n s :: PythonCode (Scope PythonCode)
s p :: PythonCode (Permanence PythonCode)
p = FuncDocRenderer -> InOutFunc PythonCode -> DocInOutFunc PythonCode
forall (r :: * -> *).
RenderSym r =>
FuncDocRenderer
-> ([SVariable r]
    -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> String
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> MSBody r
-> SMethod r
CP.docInOutFunc' FuncDocRenderer
functionDox (String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> InOutFunc PythonCode
forall (r :: * -> *).
MethodSym r =>
String -> r (Scope r) -> r (Permanence r) -> InOutFunc r
inOutMethod String
n PythonCode (Scope PythonCode)
s PythonCode (Permanence PythonCode)
p)

  inOutFunc :: String -> PythonCode (Scope PythonCode) -> InOutFunc PythonCode
inOutFunc n :: String
n s :: PythonCode (Scope PythonCode)
s = (VSType PythonCode
 -> [MSParameter PythonCode]
 -> MSBody PythonCode
 -> SMethod PythonCode)
-> InOutFunc PythonCode
forall (r :: * -> *).
RenderSym r =>
(VSType r -> [MSParameter r] -> MSBody r -> SMethod r)
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MSBody r
-> SMethod r
CP.inOutFunc (String
-> PythonCode (Scope PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
MethodSym r =>
String
-> r (Scope r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
function String
n PythonCode (Scope PythonCode)
s)

  docInOutFunc :: String -> PythonCode (Scope PythonCode) -> DocInOutFunc PythonCode
docInOutFunc n :: String
n s :: PythonCode (Scope PythonCode)
s = FuncDocRenderer -> InOutFunc PythonCode -> DocInOutFunc PythonCode
forall (r :: * -> *).
RenderSym r =>
FuncDocRenderer
-> ([SVariable r]
    -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> String
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> MSBody r
-> SMethod r
CP.docInOutFunc' FuncDocRenderer
functionDox (String -> PythonCode (Scope PythonCode) -> InOutFunc PythonCode
forall (r :: * -> *).
MethodSym r =>
String -> r (Scope r) -> InOutFunc r
inOutFunc String
n PythonCode (Scope PythonCode)
s)

instance RenderMethod PythonCode where
  intMethod :: Bool
-> String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> MSMthdType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
intMethod m :: Bool
m n :: String
n _ _ _ ps :: [MSParameter PythonCode]
ps b :: MSBody PythonCode
b = do
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (if Bool
m then MethodState -> MethodState
setCurrMain else MethodState -> MethodState
forall a. a -> a
id)
    PythonCode VarData
sl <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode VarData))
  MethodState
  ValueState
-> StateT ValueState Identity (PythonCode VarData)
-> StateT MethodState Identity (PythonCode VarData)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode VarData))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (PythonCode VarData)
forall (r :: * -> *). VariableSym r => SVariable r
self
    [PythonCode ParamData]
pms <- [State MethodState (PythonCode ParamData)]
-> StateT MethodState Identity [PythonCode ParamData]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [State MethodState (PythonCode ParamData)]
[MSParameter PythonCode]
ps
    MethodData -> PythonCode MethodData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (MethodData -> PythonCode MethodData)
-> (PythonCode Doc -> MethodData)
-> PythonCode Doc
-> PythonCode MethodData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> MethodData
mthd (Doc -> MethodData)
-> (PythonCode Doc -> Doc) -> PythonCode Doc -> MethodData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> PythonCode (Variable PythonCode)
-> [PythonCode (Parameter PythonCode)]
-> PythonCode (Body PythonCode)
-> Doc
forall (r :: * -> *).
RenderSym r =>
String -> r (Variable r) -> [r (Parameter r)] -> r (Body r) -> Doc
pyMethod String
n PythonCode VarData
PythonCode (Variable PythonCode)
sl [PythonCode ParamData]
[PythonCode (Parameter PythonCode)]
pms (PythonCode Doc -> PythonCode MethodData)
-> State MethodState (PythonCode Doc)
-> StateT MethodState Identity (PythonCode MethodData)
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
<$> State MethodState (PythonCode Doc)
MSBody PythonCode
b
  intFunc :: Bool
-> String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> MSMthdType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
intFunc m :: Bool
m n :: String
n _ _ _ ps :: [MSParameter PythonCode]
ps b :: MSBody PythonCode
b = do
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (if Bool
m then MethodState -> MethodState
setCurrMain else MethodState -> MethodState
forall a. a -> a
id)
    PythonCode Doc
bd <- State MethodState (PythonCode Doc)
MSBody PythonCode
b
    [PythonCode ParamData]
pms <- [State MethodState (PythonCode ParamData)]
-> StateT MethodState Identity [PythonCode ParamData]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [State MethodState (PythonCode ParamData)]
[MSParameter PythonCode]
ps
    PythonCode MethodData
-> StateT MethodState Identity (PythonCode MethodData)
forall (m :: * -> *) a. Monad m => a -> m a
return (PythonCode MethodData
 -> StateT MethodState Identity (PythonCode MethodData))
-> PythonCode MethodData
-> StateT MethodState Identity (PythonCode MethodData)
forall a b. (a -> b) -> a -> b
$ MethodData -> PythonCode MethodData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (MethodData -> PythonCode MethodData)
-> MethodData -> PythonCode MethodData
forall a b. (a -> b) -> a -> b
$ Doc -> MethodData
mthd (Doc -> MethodData) -> Doc -> MethodData
forall a b. (a -> b) -> a -> b
$ String
-> [PythonCode (Parameter PythonCode)]
-> PythonCode (Body PythonCode)
-> Doc
forall (r :: * -> *).
RenderSym r =>
String -> [r (Parameter r)] -> r (Body r) -> Doc
pyFunction String
n [PythonCode ParamData]
[PythonCode (Parameter PythonCode)]
pms PythonCode Doc
PythonCode (Body PythonCode)
bd
  commentedFunc :: MS (PythonCode (BlockComment PythonCode))
-> SMethod PythonCode -> SMethod PythonCode
commentedFunc cmt :: MS (PythonCode (BlockComment PythonCode))
cmt m :: SMethod PythonCode
m = (PythonCode MethodData
 -> PythonCode (Doc -> Doc) -> PythonCode MethodData)
-> StateT MethodState Identity (PythonCode MethodData)
-> State MethodState (PythonCode (Doc -> Doc))
-> StateT MethodState Identity (PythonCode MethodData)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((MethodData -> (Doc -> Doc) -> MethodData)
-> PythonCode MethodData
-> PythonCode (Doc -> Doc)
-> PythonCode MethodData
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues MethodData -> (Doc -> Doc) -> MethodData
updateMthd) StateT MethodState Identity (PythonCode MethodData)
SMethod PythonCode
m 
    ((PythonCode Doc -> PythonCode (Doc -> Doc))
-> State MethodState (PythonCode Doc)
-> State MethodState (PythonCode (Doc -> Doc))
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((Doc -> Doc -> Doc) -> PythonCode Doc -> PythonCode (Doc -> Doc)
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue Doc -> Doc -> Doc
R.commentedItem) State MethodState (PythonCode Doc)
MS (PythonCode (BlockComment PythonCode))
cmt)
    
  destructor :: [CSStateVar PythonCode] -> SMethod PythonCode
destructor _ = String -> SMethod PythonCode
forall a. HasCallStack => String -> a
error (String -> SMethod PythonCode) -> String -> SMethod PythonCode
forall a b. (a -> b) -> a -> b
$ String -> String
CP.destructorError String
pyName
  
  mthdFromData :: ScopeTag -> Doc -> SMethod PythonCode
mthdFromData _ d :: Doc
d = PythonCode MethodData -> SMethod PythonCode
forall a s. a -> State s a
toState (PythonCode MethodData -> SMethod PythonCode)
-> PythonCode MethodData -> SMethod PythonCode
forall a b. (a -> b) -> a -> b
$ MethodData -> PythonCode MethodData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (MethodData -> PythonCode MethodData)
-> MethodData -> PythonCode MethodData
forall a b. (a -> b) -> a -> b
$ Doc -> MethodData
mthd Doc
d
  
instance MethodElim PythonCode where
  method :: PythonCode (Method PythonCode) -> Doc
method = MethodData -> Doc
mthdDoc (MethodData -> Doc)
-> (PythonCode MethodData -> MethodData)
-> PythonCode MethodData
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode MethodData -> MethodData
forall a. PythonCode a -> a
unPC

instance StateVarSym PythonCode where
  type StateVar PythonCode = Doc
  stateVar :: PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> SVariable PythonCode
-> CSStateVar PythonCode
stateVar _ _ _ = PythonCode Doc -> State ClassState (PythonCode Doc)
forall a s. a -> State s a
toState (Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty)
  stateVarDef :: PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> SVariable PythonCode
-> SValue PythonCode
-> CSStateVar PythonCode
stateVarDef = PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> SVariable PythonCode
-> SValue PythonCode
-> CSStateVar PythonCode
forall (r :: * -> *).
(RenderSym r, Monad r) =>
r (Scope r)
-> r (Permanence r) -> SVariable r -> SValue r -> CS (r Doc)
CP.stateVarDef
  constVar :: PythonCode (Scope PythonCode)
-> SVariable PythonCode
-> SValue PythonCode
-> CSStateVar PythonCode
constVar = Doc
-> PythonCode (Scope PythonCode)
-> SVariable PythonCode
-> SValue PythonCode
-> State ClassState (PythonCode Doc)
forall (r :: * -> *).
(RenderSym r, Monad r) =>
Doc -> r (Scope r) -> SVariable r -> SValue r -> CS (r Doc)
CP.constVar (PythonCode (Permanence PythonCode) -> Doc
forall (r :: * -> *). PermElim r => r (Permanence r) -> Doc
RC.perm 
    (PythonCode (Permanence PythonCode)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
static :: PythonCode (Permanence PythonCode)))
  
instance StateVarElim PythonCode where
  stateVar :: PythonCode (StateVar PythonCode) -> Doc
stateVar = PythonCode (StateVar PythonCode) -> Doc
forall a. PythonCode a -> a
unPC

instance ClassSym PythonCode where
  type Class PythonCode = Doc
  buildClass :: Maybe String
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
buildClass = Maybe String
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
forall (r :: * -> *).
RenderSym r =>
Maybe String -> [CSStateVar r] -> [SMethod r] -> SClass r
G.buildClass
  extraClass :: String
-> Maybe String
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
extraClass = String
-> Maybe String
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> Maybe String -> [CSStateVar r] -> [SMethod r] -> SClass r
CP.extraClass  
  implementingClass :: String
-> [String]
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
implementingClass = String
-> [String]
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
forall (r :: * -> *).
RenderSym r =>
String -> [String] -> [CSStateVar r] -> [SMethod r] -> SClass r
G.implementingClass

  docClass :: String -> SClass PythonCode -> SClass PythonCode
docClass = String -> SClass PythonCode -> SClass PythonCode
forall (r :: * -> *). RenderSym r => String -> SClass r -> SClass r
CP.doxClass

instance RenderClass PythonCode where
  intClass :: String
-> PythonCode (Scope PythonCode)
-> PythonCode Doc
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
intClass = (String -> Doc -> Doc -> Doc -> Doc -> Doc)
-> String
-> PythonCode (Scope PythonCode)
-> PythonCode Doc
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> State ClassState (PythonCode Doc)
forall (r :: * -> *).
(RenderSym r, Monad r) =>
(String -> Doc -> Doc -> Doc -> Doc -> Doc)
-> String
-> r (Scope r)
-> r Doc
-> [CSStateVar r]
-> [SMethod r]
-> CS (r Doc)
CP.intClass String -> Doc -> Doc -> Doc -> Doc -> Doc
pyClass

  inherit :: Maybe String -> PythonCode Doc
inherit n :: Maybe String
n = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> PythonCode Doc) -> Doc -> PythonCode Doc
forall a b. (a -> b) -> a -> b
$ Doc -> (String -> Doc) -> Maybe String -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
parens (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text) Maybe String
n
  implements :: [String] -> PythonCode Doc
implements is :: [String]
is = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> PythonCode Doc) -> Doc -> PythonCode Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
parens (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
listSep [String]
is)

  commentedClass :: CS (PythonCode (BlockComment PythonCode))
-> SClass PythonCode -> SClass PythonCode
commentedClass = CS (PythonCode (BlockComment PythonCode))
-> SClass PythonCode -> SClass PythonCode
forall (r :: * -> *).
(RenderSym r, Monad r) =>
CS (r (BlockComment r)) -> SClass r -> CS (r Doc)
G.commentedClass
  
instance ClassElim PythonCode where
  class' :: PythonCode (Class PythonCode) -> Doc
class' = PythonCode (Class PythonCode) -> Doc
forall a. PythonCode a -> a
unPC

instance ModuleSym PythonCode where
  type Module PythonCode = ModData
  buildModule :: String
-> [String]
-> [SMethod PythonCode]
-> [SClass PythonCode]
-> FSModule PythonCode
buildModule n :: String
n is :: [String]
is = String
-> FS Doc
-> FS Doc
-> FS Doc
-> [SMethod PythonCode]
-> [SClass PythonCode]
-> FSModule PythonCode
forall (r :: * -> *).
RenderSym r =>
String
-> FS Doc
-> FS Doc
-> FS Doc
-> [SMethod r]
-> [SClass r]
-> FSModule r
CP.buildModule String
n (do
    [String]
lis <- FS [String]
getLangImports
    [String]
libis <- FS [String]
getLibImports
    [String]
mis <- FS [String]
getModuleImports
    Doc -> FS Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> FS Doc) -> Doc -> FS Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vibcat [
      [Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PythonCode Doc -> Doc
forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' (PythonCode Doc -> Doc)
-> (String -> PythonCode Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
        (String -> PythonCode (Import PythonCode)
forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport :: Label -> PythonCode (Import PythonCode))) [String]
lis),
      [Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PythonCode Doc -> Doc
forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' (PythonCode Doc -> Doc)
-> (String -> PythonCode Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
        (String -> PythonCode (Import PythonCode)
forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport :: Label -> PythonCode (Import PythonCode))) ([String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
is [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ 
        [String]
libis)),
      [Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PythonCode Doc -> Doc
forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' (PythonCode Doc -> Doc)
-> (String -> PythonCode Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
        (String -> PythonCode (Import PythonCode)
forall (r :: * -> *). ImportSym r => String -> r (Import r)
modImport :: Label -> PythonCode (Import PythonCode))) [String]
mis)]) 
    (Doc -> FS Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
empty) FS Doc
getMainDoc

instance RenderMod PythonCode where
  modFromData :: String -> FS Doc -> FSModule PythonCode
modFromData n :: String
n = String
-> (Doc -> PythonCode (Module PythonCode))
-> FS Doc
-> FSModule PythonCode
forall (r :: * -> *).
String -> (Doc -> r (Module r)) -> FS Doc -> FSModule r
G.modFromData String
n (ModData -> PythonCode ModData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (ModData -> PythonCode ModData)
-> (Doc -> ModData) -> Doc -> PythonCode ModData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc -> ModData
md String
n)
  updateModuleDoc :: (Doc -> Doc)
-> PythonCode (Module PythonCode) -> PythonCode (Module PythonCode)
updateModuleDoc f :: Doc -> Doc
f = (ModData -> ModData) -> PythonCode ModData -> PythonCode ModData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ((Doc -> Doc) -> ModData -> ModData
updateMod Doc -> Doc
f)
  
instance ModuleElim PythonCode where
  module' :: PythonCode (Module PythonCode) -> Doc
module' = ModData -> Doc
modDoc (ModData -> Doc)
-> (PythonCode ModData -> ModData) -> PythonCode ModData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode ModData -> ModData
forall a. PythonCode a -> a
unPC

instance BlockCommentSym PythonCode where
  type BlockComment PythonCode = Doc
  blockComment :: [String] -> PythonCode (BlockComment PythonCode)
blockComment lns :: [String]
lns = Doc -> PythonCode (BlockComment PythonCode)
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> PythonCode (BlockComment PythonCode))
-> Doc -> PythonCode (BlockComment PythonCode)
forall a b. (a -> b) -> a -> b
$ [String] -> Doc -> Doc
pyBlockComment [String]
lns Doc
pyCommentStart
  docComment :: State a [String] -> State a (PythonCode (BlockComment PythonCode))
docComment = ([String] -> PythonCode Doc)
-> State a [String] -> State a (PythonCode Doc)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue (\lns :: [String]
lns -> Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> PythonCode Doc) -> Doc -> PythonCode Doc
forall a b. (a -> b) -> a -> b
$ [String] -> Doc -> Doc -> Doc
pyDocComment [String]
lns Doc
pyDocCommentStart
    Doc
pyCommentStart)

instance BlockCommentElim PythonCode where
  blockComment' :: PythonCode (BlockComment PythonCode) -> Doc
blockComment' = PythonCode (BlockComment PythonCode) -> Doc
forall a. PythonCode a -> a
unPC

-- convenience
initName :: Label
initName :: String
initName = "__init__"

pyName, pyVersion :: String
pyName :: String
pyName = "Python"
pyVersion :: String
pyVersion = "3.5.1"

pyInt, pyDouble, pyString, pyVoid :: String
pyInt :: String
pyInt = "int"
pyDouble :: String
pyDouble = "float"
pyString :: String
pyString = "str"
pyVoid :: String
pyVoid = "NoneType"

pyFloatError :: String
pyFloatError :: String
pyFloatError = "Floats unavailable in Python, use Doubles instead"

pyPower, pyAnd, pyOr, pyIntDiv :: String
pyPower :: String
pyPower = "**"
pyAnd :: String
pyAnd = "and"
pyOr :: String
pyOr = "or"
pyIntDiv :: String
pyIntDiv = "//"

pySelf, pyNull :: String
pySelf :: String
pySelf = "self"
pyNull :: String
pyNull = "None"

pyNull' :: Doc
pyNull' :: Doc
pyNull' = String -> Doc
text String
pyNull

pyTrue, pyFalse :: Doc
pyTrue :: Doc
pyTrue = String -> Doc
text "True"
pyFalse :: Doc
pyFalse = String -> Doc
text "False"

pyPi :: Doc
pyPi :: Doc
pyPi = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
pyMath String -> String -> String
`access` String
piLabel

pySys :: String
pySys :: String
pySys = "sys"

pyInputFunc, pyPrintFunc, pyListSizeFunc :: Doc
pyInputFunc :: Doc
pyInputFunc = String -> Doc
text "input()" -- raw_input() for < Python 3.0
pyPrintFunc :: Doc
pyPrintFunc = String -> Doc
text String
printLabel
pyListSizeFunc :: Doc
pyListSizeFunc = String -> Doc
text "len"

pyIndex, pyInsert, pyAppendFunc, pyReadline, pyReadlines, pyOpen, pyClose, 
  pyRead, pyWrite, pyAppend, pySplit, pyRange, pyRstrip, pyMath :: String
pyIndex :: String
pyIndex = "index"
pyInsert :: String
pyInsert = "insert"
pyAppendFunc :: String
pyAppendFunc = "append"
pyReadline :: String
pyReadline = "readline"
pyReadlines :: String
pyReadlines = "readlines"
pyOpen :: String
pyOpen = "open"
pyClose :: String
pyClose = "close"
pyRead :: String
pyRead = "r"
pyWrite :: String
pyWrite = "w"
pyAppend :: String
pyAppend = "a"
pySplit :: String
pySplit = "split"
pyRange :: String
pyRange = "range"
pyRstrip :: String
pyRstrip = "rstrip"
pyMath :: String
pyMath = "math"

pyDef, pyLambdaDec, pyElseIf, pyRaise, pyExcept :: Doc
pyDef :: Doc
pyDef = String -> Doc
text "def"
pyLambdaDec :: Doc
pyLambdaDec = String -> Doc
text "lambda"
pyElseIf :: Doc
pyElseIf = String -> Doc
text "elif"
pyRaise :: Doc
pyRaise = String -> Doc
text "raise"
pyExcept :: Doc
pyExcept = String -> Doc
text "except"

pyBodyStart, pyBodyEnd, pyCommentStart, pyDocCommentStart, pyNamedArgSep :: Doc
pyBodyStart :: Doc
pyBodyStart = Doc
colon
pyBodyEnd :: Doc
pyBodyEnd = Doc
empty
pyCommentStart :: Doc
pyCommentStart = String -> Doc
text "#"
pyDocCommentStart :: Doc
pyDocCommentStart = Doc
pyCommentStart Doc -> Doc -> Doc
<> Doc
pyCommentStart
pyNamedArgSep :: Doc
pyNamedArgSep = Doc
equals

pyNotOp :: (Monad r) => VSOp r
pyNotOp :: VSOp r
pyNotOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec "not"

pySqrtOp :: (Monad r) => VSOp r
pySqrtOp :: VSOp r
pySqrtOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.sqrt

pyAbsOp :: (Monad r) => VSOp r
pyAbsOp :: VSOp r
pyAbsOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.fabs

pyLogOp :: (Monad r) => VSOp r
pyLogOp :: VSOp r
pyLogOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.log10

pyLnOp :: (Monad r) => VSOp r
pyLnOp :: VSOp r
pyLnOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.log

pyExpOp :: (Monad r) => VSOp r
pyExpOp :: VSOp r
pyExpOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.exp

pySinOp :: (Monad r) => VSOp r
pySinOp :: VSOp r
pySinOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.sin

pyCosOp :: (Monad r) => VSOp r
pyCosOp :: VSOp r
pyCosOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.cos

pyTanOp :: (Monad r) => VSOp r
pyTanOp :: VSOp r
pyTanOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.tan

pyAsinOp :: (Monad r) => VSOp r
pyAsinOp :: VSOp r
pyAsinOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.asin

pyAcosOp :: (Monad r) => VSOp r
pyAcosOp :: VSOp r
pyAcosOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.acos

pyAtanOp :: (Monad r) => VSOp r
pyAtanOp :: VSOp r
pyAtanOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.atan

pyFloorOp :: (Monad r) => VSOp r
pyFloorOp :: VSOp r
pyFloorOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.floor

pyCeilOp :: (Monad r) => VSOp r
pyCeilOp :: VSOp r
pyCeilOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.ceil

addmathImport :: VS a -> VS a
addmathImport :: VS a -> VS a
addmathImport = StateT ValueState Identity () -> VS a -> VS a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (StateT ValueState Identity () -> VS a -> VS a)
-> StateT ValueState Identity () -> VS a -> VS a
forall a b. (a -> b) -> a -> b
$ (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLangImportVS String
pyMath)

mathFunc :: (Monad r) => String -> VSOp r
mathFunc :: String -> VSOp r
mathFunc = VSOp r -> VSOp r
forall a. VS a -> VS a
addmathImport (VSOp r -> VSOp r) -> (String -> VSOp r) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec (String -> VSOp r) -> (String -> String) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
access String
pyMath 

splitFunc :: (RenderSym r) => Char -> VSFunction r
splitFunc :: Char -> VSFunction r
splitFunc d :: Char
d = String -> VSType r -> [SValue r] -> VSFunction r
forall (r :: * -> *).
FunctionSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
func String
pySplit (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType r
forall (r :: * -> *). TypeSym r => VSType r
string) [String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString [Char
d]]

openRead, openWrite, openAppend :: (RenderSym r) => SValue r -> SValue r
openRead :: SValue r -> SValue r
openRead n :: SValue r
n = PosCall r
forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyOpen VSType r
forall (r :: * -> *). TypeSym r => VSType r
infile [SValue r
n, String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString String
pyRead]
openWrite :: SValue r -> SValue r
openWrite n :: SValue r
n = PosCall r
forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyOpen VSType r
forall (r :: * -> *). TypeSym r => VSType r
outfile [SValue r
n, String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString String
pyWrite]
openAppend :: SValue r -> SValue r
openAppend n :: SValue r
n = PosCall r
forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyOpen VSType r
forall (r :: * -> *). TypeSym r => VSType r
outfile [SValue r
n, String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString String
pyAppend]

readline, readlines :: (RenderSym r) => SValue r -> SValue r
readline :: SValue r -> SValue r
readline f :: SValue r
f = VSType r -> SValue r -> String -> [SValue r] -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> [SValue r] -> SValue r
objMethodCall VSType r
forall (r :: * -> *). TypeSym r => VSType r
string SValue r
f String
pyReadline []
readlines :: SValue r -> SValue r
readlines f :: SValue r
f = VSType r -> SValue r -> String -> [SValue r] -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> [SValue r] -> SValue r
objMethodCall (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType r
forall (r :: * -> *). TypeSym r => VSType r
string) SValue r
f String
pyReadlines []

readInt, readDouble, readString :: (RenderSym r) => SValue r -> SValue r
readInt :: SValue r -> SValue r
readInt inSrc :: SValue r
inSrc = PosCall r
forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyInt VSType r
forall (r :: * -> *). TypeSym r => VSType r
int [SValue r
inSrc]
readDouble :: SValue r -> SValue r
readDouble inSrc :: SValue r
inSrc = PosCall r
forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyDouble VSType r
forall (r :: * -> *). TypeSym r => VSType r
double [SValue r
inSrc]
readString :: SValue r -> SValue r
readString inSrc :: SValue r
inSrc = VSType r -> SValue r -> String -> [SValue r] -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> [SValue r] -> SValue r
objMethodCall VSType r
forall (r :: * -> *). TypeSym r => VSType r
string SValue r
inSrc String
pyRstrip []

range :: (RenderSym r) => SValue r -> SValue r -> SValue r -> SValue r
range :: SValue r -> SValue r -> SValue r -> SValue r
range initv :: SValue r
initv finalv :: SValue r
finalv stepv :: SValue r
stepv = PosCall r
forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyRange (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType r
forall (r :: * -> *). TypeSym r => VSType r
int) [SValue r
initv, SValue r
finalv, SValue r
stepv]

pyClassVar :: Doc -> Doc -> Doc
pyClassVar :: Doc -> Doc -> Doc
pyClassVar c :: Doc
c v :: Doc
v = Doc
c Doc -> Doc -> Doc
<> Doc
dot Doc -> Doc -> Doc
<> Doc
c Doc -> Doc -> Doc
<> Doc
dot Doc -> Doc -> Doc
<> Doc
v

pyInlineIf :: (RenderSym r) => SValue r -> SValue r -> SValue r -> SValue r
pyInlineIf :: SValue r -> SValue r -> SValue r -> SValue r
pyInlineIf c' :: SValue r
c' v1' :: SValue r
v1' v2' :: SValue r
v2' = do 
  r (Value r)
c <- SValue r
c'
  r (Value r)
v1 <- SValue r
v1'
  r (Value r)
v2 <- SValue r
v2'
  Maybe Int -> VSType r -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> VSType r -> Doc -> SValue r
valFromData (r (Value r) -> Maybe Int
forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Int
valuePrec r (Value r)
c) (r (Type r) -> VSType r
forall a s. a -> State s a
toState (r (Type r) -> VSType r) -> r (Type r) -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v1) 
    (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v1 Doc -> Doc -> Doc
<+> Doc
ifLabel Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
c Doc -> Doc -> Doc
<+> Doc
elseLabel Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v2)

pyLambda :: (RenderSym r) => [r (Variable r)] -> r (Value r) -> Doc
pyLambda :: [r (Variable r)] -> r (Value r) -> Doc
pyLambda ps :: [r (Variable r)]
ps ex :: r (Value r)
ex = Doc
pyLambdaDec Doc -> Doc -> Doc
<+> [r (Variable r)] -> Doc
forall (r :: * -> *). RenderSym r => [r (Variable r)] -> Doc
variableList [r (Variable r)]
ps Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
ex

pyListSize :: Doc -> Doc -> Doc
pyListSize :: Doc -> Doc -> Doc
pyListSize v :: Doc
v f :: Doc
f = Doc
f Doc -> Doc -> Doc
<> Doc -> Doc
parens Doc
v

pyStringType :: (RenderSym r) => VSType r
pyStringType :: VSType r
pyStringType = CodeType -> String -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
String String
pyString (String -> Doc
text String
pyString)

pyExtNewObjMixedArgs :: (RenderSym r) => Library -> MixedCtorCall r
pyExtNewObjMixedArgs :: String -> MixedCtorCall r
pyExtNewObjMixedArgs l :: String
l tp :: VSType r
tp vs :: [SValue r]
vs ns :: NamedArgs r
ns = VSType r
tp VSType r -> (r (Type r) -> SValue r) -> SValue r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\t :: r (Type r)
t -> Maybe String -> Maybe Doc -> String -> MixedCtorCall r
forall (r :: * -> *).
RenderValue r =>
Maybe String -> Maybe Doc -> MixedCall r
call (String -> Maybe String
forall a. a -> Maybe a
Just String
l) Maybe Doc
forall a. Maybe a
Nothing 
  (r (Type r) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString r (Type r)
t) (r (Type r) -> VSType r
forall (m :: * -> *) a. Monad m => a -> m a
return r (Type r)
t) [SValue r]
vs NamedArgs r
ns)

pyPrint :: Bool -> Maybe (SValue PythonCode) -> SValue PythonCode -> 
  SValue PythonCode -> MSStatement PythonCode
pyPrint :: Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
pyPrint newLn :: Bool
newLn f' :: Maybe (SValue PythonCode)
f' p' :: SValue PythonCode
p' v' :: SValue PythonCode
v' = do
    PythonCode ValData
f <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS (VS (PythonCode ValData)
 -> StateT MethodState Identity (PythonCode ValData))
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall a b. (a -> b) -> a -> b
$ VS (PythonCode ValData)
-> Maybe (VS (PythonCode ValData)) -> VS (PythonCode ValData)
forall a. a -> Maybe a -> a
fromMaybe (VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty) Maybe (VS (PythonCode ValData))
Maybe (SValue PythonCode)
f'
    PythonCode ValData
prf <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS VS (PythonCode ValData)
SValue PythonCode
p'
    PythonCode ValData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS VS (PythonCode ValData)
SValue PythonCode
v'
    PythonCode ValData
s <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS (String -> SValue PythonCode
forall (r :: * -> *). Literal r => String -> SValue r
litString "" :: SValue PythonCode)
    let nl :: Doc
nl = if Bool
newLn then Doc
empty else Doc
listSep' Doc -> Doc -> Doc
<> String -> Doc
text "end" Doc -> Doc -> Doc
<> Doc
equals Doc -> Doc -> Doc
<> 
               PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
PythonCode (Value PythonCode)
s
        fl :: Doc
fl = Doc -> Doc -> Doc
emptyIfEmpty (PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
PythonCode (Value PythonCode)
f) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
listSep' Doc -> Doc -> Doc
<> String -> Doc
text "file" Doc -> Doc -> Doc
<> Doc
equals 
               Doc -> Doc -> Doc
<> PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
PythonCode (Value PythonCode)
f
    Doc -> State MethodState (PythonCode (Doc, Terminator))
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd (Doc -> State MethodState (PythonCode (Doc, Terminator)))
-> Doc -> State MethodState (PythonCode (Doc, Terminator))
forall a b. (a -> b) -> a -> b
$ PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
PythonCode (Value PythonCode)
prf Doc -> Doc -> Doc
<> Doc -> Doc
parens (PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
PythonCode (Value PythonCode)
v Doc -> Doc -> Doc
<> Doc
nl Doc -> Doc -> Doc
<> Doc
fl)

pyOut :: (RenderSym r) => Bool -> Maybe (SValue r) -> SValue r -> SValue r -> 
  MSStatement r
pyOut :: Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut newLn :: Bool
newLn f :: Maybe (SValue r)
f printFn :: SValue r
printFn v :: SValue r
v = LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SValue r
v StateT MethodState Identity (r (Value r))
-> (r (Value r) -> MSStatement r) -> MSStatement r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeType -> MSStatement r
pyOut' (CodeType -> MSStatement r)
-> (r (Value r) -> CodeType) -> r (Value r) -> MSStatement r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Type r) -> CodeType)
-> (r (Value r) -> r (Type r)) -> r (Value r) -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType
  where pyOut' :: CodeType -> MSStatement r
pyOut' (List _) = Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
forall (r :: * -> *).
InternalIOStmt r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
printSt Bool
newLn Maybe (SValue r)
f SValue r
printFn SValue r
v
        pyOut' _ = Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
forall (r :: * -> *).
RenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
G.print Bool
newLn Maybe (SValue r)
f SValue r
printFn SValue r
v

pyInput :: SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
pyInput :: SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
pyInput inSrc :: SValue PythonCode
inSrc v :: SVariable PythonCode
v = SVariable PythonCode
v SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= (StateT ValueState Identity (PythonCode VarData)
SVariable PythonCode
v StateT ValueState Identity (PythonCode VarData)
-> (PythonCode VarData -> VS (PythonCode ValData))
-> VS (PythonCode ValData)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeType -> VS (PythonCode ValData)
pyInput' (CodeType -> VS (PythonCode ValData))
-> (PythonCode VarData -> CodeType)
-> PythonCode VarData
-> VS (PythonCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode TypeData -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (PythonCode TypeData -> CodeType)
-> (PythonCode VarData -> PythonCode TypeData)
-> PythonCode VarData
-> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode VarData -> PythonCode TypeData
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType)
  where pyInput' :: CodeType -> VS (PythonCode ValData)
pyInput' Integer = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readInt SValue PythonCode
inSrc
        pyInput' Float = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readDouble SValue PythonCode
inSrc
        pyInput' Double = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readDouble SValue PythonCode
inSrc
        pyInput' Boolean = SValue PythonCode
inSrc SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?!= String -> SValue PythonCode
forall (r :: * -> *). Literal r => String -> SValue r
litString "0"
        pyInput' String = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readString SValue PythonCode
inSrc
        pyInput' Char = VS (PythonCode ValData)
SValue PythonCode
inSrc
        pyInput' _ = String -> VS (PythonCode ValData)
forall a. HasCallStack => String -> a
error "Attempt to read a value of unreadable type"

pyThrow :: (RenderSym r) => r (Value r) -> Doc
pyThrow :: r (Value r) -> Doc
pyThrow errMsg :: r (Value r)
errMsg = Doc
pyRaise Doc -> Doc -> Doc
<+> Doc
exceptionObj' Doc -> Doc -> Doc
<> Doc -> Doc
parens (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
errMsg)

pyForEach :: (RenderSym r) => r (Variable r) -> r (Value r) -> r (Body r) -> Doc
pyForEach :: r (Variable r) -> r (Value r) -> r (Body r) -> Doc
pyForEach i :: r (Variable r)
i lstVar :: r (Value r)
lstVar b :: r (Body r)
b = [Doc] -> Doc
vcat [
  Doc
forLabel Doc -> Doc -> Doc
<+> r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
i Doc -> Doc -> Doc
<+> Doc
inLabel Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
lstVar Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b]

pyWhile :: (RenderSym r) => r (Value r) -> r (Body r) -> Doc
pyWhile :: r (Value r) -> r (Body r) -> Doc
pyWhile v :: r (Value r)
v b :: r (Body r)
b = [Doc] -> Doc
vcat [
  Doc
whileLabel Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b]

pyTryCatch :: (RenderSym r) => r (Body r) -> r (Body r) -> Doc
pyTryCatch :: r (Body r) -> r (Body r) -> Doc
pyTryCatch tryB :: r (Body r)
tryB catchB :: r (Body r)
catchB = [Doc] -> Doc
vcat [
  Doc
tryLabel Doc -> Doc -> Doc
<+> Doc
colon,
  Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
tryB,
  Doc
pyExcept Doc -> Doc -> Doc
<+> Doc
exceptionObj' Doc -> Doc -> Doc
<+> Doc
colon,
  Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
catchB]

pyListSlice :: (RenderSym r, Monad r) => SVariable r -> SValue r -> SValue r -> 
  SValue r -> SValue r -> MS (r Doc)
pyListSlice :: SVariable r
-> SValue r -> SValue r -> SValue r -> SValue r -> MS (r Doc)
pyListSlice vn :: SVariable r
vn vo :: SValue r
vo beg :: SValue r
beg end :: SValue r
end step :: SValue r
step = LensLike'
  (Zoomed (StateT ValueState Identity) (r Doc))
  MethodState
  ValueState
-> StateT ValueState Identity (r Doc) -> MS (r Doc)
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (r Doc))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (r Doc) -> MS (r Doc))
-> StateT ValueState Identity (r Doc) -> MS (r Doc)
forall a b. (a -> b) -> a -> b
$ do
  r (Variable r)
vnew <- SVariable r
vn
  r (Value r)
vold <- SValue r
vo
  r (Value r)
b <- SValue r
beg
  r (Value r)
e <- SValue r
end
  r (Value r)
s <- SValue r
step
  r Doc -> StateT ValueState Identity (r Doc)
forall (m :: * -> *) a. Monad m => a -> m a
return (r Doc -> StateT ValueState Identity (r Doc))
-> r Doc -> StateT ValueState Identity (r Doc)
forall a b. (a -> b) -> a -> b
$ Doc -> r Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> r Doc) -> Doc -> r Doc
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
vnew Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
vold Doc -> Doc -> Doc
<> 
    Doc -> Doc
brackets (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
b Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
e Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
s)

pyMethod :: (RenderSym r) => Label -> r (Variable r) -> [r (Parameter r)] ->
  r (Body r) -> Doc
pyMethod :: String -> r (Variable r) -> [r (Parameter r)] -> r (Body r) -> Doc
pyMethod n :: String
n slf :: r (Variable r)
slf ps :: [r (Parameter r)]
ps b :: r (Body r)
b = [Doc] -> Doc
vcat [
  Doc
pyDef Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<> Doc -> Doc
parens (r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
slf Doc -> Doc -> Doc
<> Doc
oneParam Doc -> Doc -> Doc
<> Doc
pms) Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent Doc
bodyD]
      where pms :: Doc
pms = [r (Parameter r)] -> Doc
forall (r :: * -> *). RenderSym r => [r (Parameter r)] -> Doc
parameterList [r (Parameter r)]
ps
            oneParam :: Doc
oneParam = Doc -> Doc -> Doc
emptyIfEmpty Doc
pms Doc
listSep'
            bodyD :: Doc
bodyD | Doc -> Bool
isEmpty (r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b) = Doc
pyNull'
                  | Bool
otherwise = r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b

pyFunction :: (RenderSym r) => Label -> [r (Parameter r)] -> r (Body r) -> Doc
pyFunction :: String -> [r (Parameter r)] -> r (Body r) -> Doc
pyFunction n :: String
n ps :: [r (Parameter r)]
ps b :: r (Body r)
b = [Doc] -> Doc
vcat [
  Doc
pyDef Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<> Doc -> Doc
parens ([r (Parameter r)] -> Doc
forall (r :: * -> *). RenderSym r => [r (Parameter r)] -> Doc
parameterList [r (Parameter r)]
ps) Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent Doc
bodyD]
  where bodyD :: Doc
bodyD | Doc -> Bool
isEmpty (r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b) = Doc
pyNull'
              | Bool
otherwise = r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b

pyClass :: Label -> Doc -> Doc -> Doc -> Doc -> Doc
pyClass :: String -> Doc -> Doc -> Doc -> Doc -> Doc
pyClass n :: String
n pn :: Doc
pn s :: Doc
s vs :: Doc
vs fs :: Doc
fs = [Doc] -> Doc
vcat [
  Doc
s Doc -> Doc -> Doc
<+> Doc
classDec Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<> Doc
pn Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent Doc
funcSec]
  where funcSec :: Doc
funcSec | Doc -> Bool
isEmpty (Doc
vs Doc -> Doc -> Doc
<> Doc
fs) = Doc
pyNull'
                | Doc -> Bool
isEmpty Doc
vs = Doc
fs
                | Doc -> Bool
isEmpty Doc
fs = Doc
vs
                | Bool
otherwise = [Doc] -> Doc
vcat [Doc
vs, Doc
blank, Doc
fs]

pyBlockComment :: [String] -> Doc -> Doc
pyBlockComment :: [String] -> Doc -> Doc
pyBlockComment lns :: [String]
lns cmt :: Doc
cmt = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc -> Doc
(<+>) Doc
cmt (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text) [String]
lns

pyDocComment :: [String] -> Doc -> Doc -> Doc
pyDocComment :: [String] -> Doc -> Doc -> Doc
pyDocComment [] _ _ = Doc
empty
pyDocComment (l :: String
l:lns :: [String]
lns) start :: Doc
start mid :: Doc
mid = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
start Doc -> Doc -> Doc
<+> String -> Doc
text String
l Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc -> Doc
(<+>) Doc
mid (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
  String -> Doc
text) [String]
lns