implementation module iTasks.Gin.Types import StdBool import StdList import GenEq import Data.Maybe, Text.HTML, iTasks.Framework.UIDefinition from iTasks import class iTask import iTasks.Gin.Printer from iTasks.Gin.Parser import :: GPath(..), :: GTypeDefinition(..), :: GTypeExpression(..), :: GFormalParameter(..), :: GIdentifier(..), :: GTypeVariable(..), :: GTypeRhs(..), :: GRecordField(..), :: GDataConstructor(..) from iTasks.Gin.Types import generic gEq, generic JSONDecode, generic JSONEncode, generic gVerify, generic gUpdate, generic gDefault, generic gGridRows, generic gHeaders, generic gVisualizeText, generic gVisualizeEditor from iTasks.Gin.Types import :: JSONNode, :: InteractionMask, :: VerifyMask, :: VerifyOptions, :: ConsPos, :: StaticVisualizationMode, :: VSt, :: VisualizationResult from iTasks.Gin.Types import printGTypeDefinition, typeIsDefined, printGTypeExpression 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"