implementation module GinTypes import StdBool import StdList import GenEq import Maybe, HTML, TUIDefinition from iTasks import ::JSONNode, ::VerSt, ::UpdateMask, ::USt, ::UpdateMode, ::VSt, :: StaticVisualizationMode from iTasks import class iTask, generic gVisualizeText, generic gVisualizeHtml, generic gVisualizeEditor, generic gUpdate, generic gDefaultMask, generic gVerify, generic JSONEncode, generic JSONDecode, generic gEq import GinPrinter derive bimap (,) derive bimap Maybe derive class iTask GTypeExpression, GTypeDefinition, GTypeRhs, GDataConstructor, GRecordField, GFormalParameter typeIsDefined :: GTypeExpression -> Bool typeIsDefined (GConstructor t) = True typeIsDefined (GList e) = typeIsDefined e typeIsDefined (GTuple es) = all typeIsDefined es typeIsDefined (GTypeApplication es) = all typeIsDefined es typeIsDefined (GTypeVariable v) = True typeIsDefined (GFunction a b) = typeIsDefined a && typeIsDefined b typeIsDefined GUndefinedTypeExpression = False printGTypeExpression :: Bool GTypeExpression -> a | Printer a printGTypeExpression withParens (GConstructor t) = text t printGTypeExpression withParens (GList e) = brackets (printGTypeExpression False e) printGTypeExpression withParens (GTuple es) = tupled (map (printGTypeExpression False) es) printGTypeExpression withParens (GTypeApplication es) = addParens withParens (fillSep (map (printGTypeExpression True) es)) printGTypeExpression withParens (GTypeVariable v) = text v printGTypeExpression withParens (GFunction e1 e2) = addParens withParens (printGTypeExpression False e1 text "->" printGTypeExpression False e2) printGTypeExpression withParens GUndefinedTypeExpression = text "<>" addParens :: Bool a -> a | Printer a addParens withParens a = if withParens (parens a) a printGTypeDefinition :: GTypeDefinition -> a | Printer a printGTypeDefinition gt = def ( text "::" text gt.GTypeDefinition.name printGTypeRhs gt.GTypeDefinition.rhs ) printGTypeRhs :: GTypeRhs -> a | Printer a printGTypeRhs (GAlgebraicTypeRhs conss) = text "=" fillSep (punctuate (text "|") (map printGDataConstructor conss)) printGTypeRhs (GRecordTypeRhs fields) = text "=" braces (fillSep ((punctuate comma (map printGRecordField fields)))) printGTypeRhs (GSynonymTypeRhs exp) = text ":==" printGTypeExpression False exp printGTypeRhs GAbstractTypeRhs = empty printGDataConstructor :: GDataConstructor -> a | Printer a printGDataConstructor cons = text cons.GDataConstructor.name fillSep (map (printGTypeExpression True) cons.GDataConstructor.arguments) printGRecordField :: GRecordField -> a | Printer a printGRecordField field = text field.GRecordField.name text "::" printGTypeExpression False field.GRecordField.type instance toString GTypeExpression where toString typeExp = prettyPrint (printGTypeExpression False typeExp) isTask :: !GTypeExpression -> Bool isTask (GTypeApplication [GConstructor "Task", _]) = True isTask _ = False gTask :: GTypeExpression -> GTypeExpression gTask e = GTypeApplication [GConstructor "Task", e] gVoid :: GTypeExpression gVoid = GConstructor "Void"