SimulaVR · DavidEichmann · May 24, 2022 · May 25, 2022
diff --git a/classgen/app-classgen/Main.hs b/classgen/app-classgen/Main.hs
@@ -41,10 +41,10 @@ main = do
                                                      <|> (H.lookup  ("_" <> (cls ^. Classgen.Spec.name)) docTable)
                                                     ) classes) classes)
                         (ClassgenState mempty mempty mempty)
-  writeModule godotHaskellRootDir $ godotApiTypes (state ^. tyDecls)
+  writeModule godotHaskellRootDir $ godotApiTypes $ state ^. tyDecls
   mapM_ (writeModule godotHaskellRootDir) (HM.elems (state ^. modules))
   where
-    godotApiTypes decls   = Module Nothing (Just
+    godotApiTypes declsUnordered   = Module Nothing (Just
                                             $ ModuleHead Nothing (ModuleName Nothing "Godot.Api.Types") Nothing
                                             $ Just (classExports decls))
                             [LanguagePragma Nothing [Ident Nothing "DerivingStrategies"
@@ -53,6 +53,8 @@ main = do
                                                     ,Ident Nothing "TemplateHaskell"]]
                             classImports
                             (decls ++ mapMaybe fromNewtypeDerivingBase decls)
+      where
+        decls = concat $ topoSort declsUnordered
     classExports decls   = ExportSpecList Nothing $ tcHasBaseClass : mapMaybe fromNewtypeOnly decls
     tcHasBaseClass       = fmap (\_ -> Nothing) $ EThingWith () (EWildcard () 0) (UnQual () (Ident () "HasBaseClass")) []
     fromNewtypeOnly decl = case decl of
@@ -79,3 +81,24 @@ writeModule godotHaskellRootDir mdl@(Module _ (Just (ModuleHead _ (ModuleName No
   where
     replaceDot '.' = '/'
     replaceDot c = c
+
+-- | Topologically sort 
+topoSort :: forall v. HM.HashMap T.Text (T.Text, v) -> [v]
+topoSort xs = --error (unlines $ fmap show $ HM.toList childrenMap)
+   topo ""
+  where
+    childrenMap :: HM.HashMap T.Text [T.Text]
+    childrenMap = HM.fromListWith (++) [(parent, [child]) | (child, (parent, v)) <- HM.toList xs]
+
+    toV :: T.Text -> [v]
+    toV cls = case HM.lookup cls xs of
+      Nothing -> []
+      Just (_, v) -> [v]
+
+
+    topo :: T.Text -> [v]
+    topo parent = toV parent ++ concatMap topo children
+      where
+        children = case HM.lookup parent childrenMap of
+          Just cs -> cs
+          Nothing -> []
diff --git a/classgen/godot-haskell-classgen.cabal b/classgen/godot-haskell-classgen.cabal
@@ -1,10 +1,10 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.31.1.
+-- This file has been generated from package.yaml by hpack version 0.34.4.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 35a149339951f4c097aab1ae9ef0e3952109a1273b725ce775c4483b80c67fb6
+-- hash: 39c1a53600a03266968c43ac408d7e7fa662a399a936ee5fa12573f2b06d247a
 
 name:           godot-haskell-classgen
 version:        0.1.0.0
@@ -33,7 +33,24 @@ library
       Paths_godot_haskell_classgen
   hs-source-dirs:
       src-classgen
-  default-extensions: FlexibleContexts FlexibleInstances ScopedTypeVariables TypeApplications StandaloneDeriving DerivingStrategies DefaultSignatures MultiParamTypeClasses FunctionalDependencies TypeFamilies TemplateHaskell TypeOperators TypeInType QuasiQuotes OverloadedStrings PatternSynonyms GeneralizedNewtypeDeriving
+  default-extensions:
+      FlexibleContexts
+      FlexibleInstances
+      ScopedTypeVariables
+      TypeApplications
+      StandaloneDeriving
+      DerivingStrategies
+      DefaultSignatures
+      MultiParamTypeClasses
+      FunctionalDependencies
+      TypeFamilies
+      TemplateHaskell
+      TypeOperators
+      TypeInType
+      QuasiQuotes
+      OverloadedStrings
+      PatternSynonyms
+      GeneralizedNewtypeDeriving
   include-dirs:
       godot_headers
       cbits
@@ -62,7 +79,24 @@ executable godot-haskell-classgen
       Paths_godot_haskell_classgen
   hs-source-dirs:
       app-classgen
-  default-extensions: FlexibleContexts FlexibleInstances ScopedTypeVariables TypeApplications StandaloneDeriving DerivingStrategies DefaultSignatures MultiParamTypeClasses FunctionalDependencies TypeFamilies TemplateHaskell TypeOperators TypeInType QuasiQuotes OverloadedStrings PatternSynonyms GeneralizedNewtypeDeriving
+  default-extensions:
+      FlexibleContexts
+      FlexibleInstances
+      ScopedTypeVariables
+      TypeApplications
+      StandaloneDeriving
+      DerivingStrategies
+      DefaultSignatures
+      MultiParamTypeClasses
+      FunctionalDependencies
+      TypeFamilies
+      TemplateHaskell
+      TypeOperators
+      TypeInType
+      QuasiQuotes
+      OverloadedStrings
+      PatternSynonyms
+      GeneralizedNewtypeDeriving
   include-dirs:
       godot_headers
       cbits

diff --git a/classgen/src-classgen/Classgen/Docs.hs b/classgen/src-classgen/Classgen/Docs.hs
@@ -103,10 +103,6 @@ data GodotDoc = GodotDoc {
   _gdClass :: !GodotDocClass
   } deriving (Show, Eq)
 
-instance FromJSON GodotDoc where
-  parseJSON (Object x) = GodotDoc <$> x .: "class"
-  parseJSON _ = fail "Expected an Object"
-
 data OptionalArray a = OptionalArray { unOption :: Vector a }
   deriving (Show, Eq)
 
@@ -191,3 +187,7 @@ convertDoc = T.replace "]" "@" . T.replace "[" "@"
            . T.replace "[b]" "__" . T.replace "[/b]" "__"
            . T.replace "[constant " "@"
            . T.replace "[member " "@"
+
+instance FromJSON GodotDoc where
+  parseJSON (Object x) = GodotDoc <$> x .: "class"
+  parseJSON _ = fail "Expected an Object"
diff --git a/classgen/src-classgen/Classgen/Module.hs b/classgen/src-classgen/Classgen/Module.hs
@@ -25,8 +25,9 @@ import Data.List
 data ClassgenState = ClassgenState
   { _csModules :: !(HashMap Text (HS.Module (Maybe CodeComment)))
   , _csMethods :: !(HashMap Text (Set Text))
-  , _csTyDecls :: !([HS.Decl (Maybe CodeComment)])
-  } deriving (Show, Eq) 
+  , -- | Class to parent class and declarations
+    _csTyDecls :: !(HashMap Text (Text, [HS.Decl (Maybe CodeComment)]))
+  } deriving (Show, Eq)
 
 makeLensesWith abbreviatedFields ''ClassgenState
 
@@ -38,7 +39,9 @@ addClass cls mdoc allClasses = do
   properties <- mkProperties cls mdoc
   signals <- mkSignals cls mdoc
   let dataType = if isCoreType (cls ^. name) then [] else mkDataType cls mdoc
-  tyDecls <>= dataType
+  tyDecls %= HM.insert
+    (mangleClass $ cls ^. name)
+    (mangleClass $ cls ^. baseClass, dataType)
   let classDecls = nub $ (noComments <$> (mkConstants cls ++ mkEnums cls))
                  ++ signals ++ properties ++ methods
   modules %= HM.insert (mangleClass $ cls ^. name) (HS.Module Nothing

diff --git a/classgen/stack.yaml b/classgen/stack.yaml
@@ -16,7 +16,7 @@
 #  name: custom-snapshot
 #  location: "./custom-snapshot.yaml"
 # resolver: lts-11.2
-resolver: lts-15.4
+resolver: nightly-2022-05-20
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.

diff --git a/classgen/stack.yaml.lock b/classgen/stack.yaml.lock
@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    size: 491163
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/4.yaml
-    sha256: bc60043a06b58902b533baa80fb566c0ec495c41e428bc0f8c1e8c15b2a4c468
-  original: lts-15.4
+    size: 588043
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/5/20.yaml
+    sha256: 7800e52de866bab899c118558f3a48e455f9f57fb3b3595e0002018fbea5ee58
+  original: nightly-2022-05-20
diff --git a/godot-haskell.cabal b/godot-haskell.cabal
@@ -1,10 +1,10 @@
 cabal-version: 2.0
 
--- This file has been generated from package.yaml by hpack version 0.33.0.
+-- This file has been generated from package.yaml by hpack version 0.34.4.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 9eee1b834a7b311c2aaf343d7472f4478f3d5840413d415e779ebfd822966642
+-- hash: 3688f61b345cc5d0df9dbbe14018fa62870ae42512d34bdc8488b09b66348b3d
 
 name:           godot-haskell
 version:        3.1.0.0
@@ -695,7 +695,24 @@ library
       Paths_godot_haskell
   hs-source-dirs:
       src
-  default-extensions: FlexibleContexts FlexibleInstances ScopedTypeVariables TypeApplications StandaloneDeriving DerivingStrategies DefaultSignatures MultiParamTypeClasses FunctionalDependencies TypeFamilies TemplateHaskell TypeOperators TypeInType QuasiQuotes OverloadedStrings PatternSynonyms GeneralizedNewtypeDeriving
+  default-extensions:
+      FlexibleContexts
+      FlexibleInstances
+      ScopedTypeVariables
+      TypeApplications
+      StandaloneDeriving
+      DerivingStrategies
+      DefaultSignatures
+      MultiParamTypeClasses
+      FunctionalDependencies
+      TypeFamilies
+      TemplateHaskell
+      TypeOperators
+      TypeInType
+      QuasiQuotes
+      OverloadedStrings
+      PatternSynonyms
+      GeneralizedNewtypeDeriving
   ghc-options: -O0
   include-dirs:
       godot_headers
@@ -732,7 +749,24 @@ library generate
       Paths_godot_haskell
   hs-source-dirs:
       src-generate
-  default-extensions: FlexibleContexts FlexibleInstances ScopedTypeVariables TypeApplications StandaloneDeriving DerivingStrategies DefaultSignatures MultiParamTypeClasses FunctionalDependencies TypeFamilies TemplateHaskell TypeOperators TypeInType QuasiQuotes OverloadedStrings PatternSynonyms GeneralizedNewtypeDeriving
+  default-extensions:
+      FlexibleContexts
+      FlexibleInstances
+      ScopedTypeVariables
+      TypeApplications
+      StandaloneDeriving
+      DerivingStrategies
+      DefaultSignatures
+      MultiParamTypeClasses
+      FunctionalDependencies
+      TypeFamilies
+      TemplateHaskell
+      TypeOperators
+      TypeInType
+      QuasiQuotes
+      OverloadedStrings
+      PatternSynonyms
+      GeneralizedNewtypeDeriving
   ghc-options: -O0
   build-depends:
       aeson
@@ -760,7 +794,24 @@ executable godot-haskell-project-generator
       Paths_godot_haskell
   hs-source-dirs:
       project-generator
-  default-extensions: FlexibleContexts FlexibleInstances ScopedTypeVariables TypeApplications StandaloneDeriving DerivingStrategies DefaultSignatures MultiParamTypeClasses FunctionalDependencies TypeFamilies TemplateHaskell TypeOperators TypeInType QuasiQuotes OverloadedStrings PatternSynonyms GeneralizedNewtypeDeriving
+  default-extensions:
+      FlexibleContexts
+      FlexibleInstances
+      ScopedTypeVariables
+      TypeApplications
+      StandaloneDeriving
+      DerivingStrategies
+      DefaultSignatures
+      MultiParamTypeClasses
+      FunctionalDependencies
+      TypeFamilies
+      TemplateHaskell
+      TypeOperators
+      TypeInType
+      QuasiQuotes
+      OverloadedStrings
+      PatternSynonyms
+      GeneralizedNewtypeDeriving
   ghc-options: -O0
   build-depends:
       aeson

diff --git a/src-generate/Generate.hs b/src-generate/Generate.hs
@@ -394,7 +394,7 @@ constructFunction isCore tyname idx entry = do
 
   -- peekElemOff api idx
   let tyApiName = mkName . camel $ nameBase tyname
-  let apiE = LetE [ValD (ConP tyname [VarP nApi]) (NormalB $ VarE tyApiName) []] (VarE nApi)
+  let apiE = LetE [ValD (ConP tyname [] [VarP nApi]) (NormalB $ VarE tyApiName) []] (VarE nApi)
   let peekE = pure $ foldl AppE (VarE 'peekByteOff) [apiE, LitE (IntegerL $ fromIntegral $ sizeOf (undefined :: FunPtr a) * idx + structOffset)]
 
   let invokeE = appE (varE foreignName) (varE nPtr)