works?

Author: asivitz

small/hackory/Hackory.cabal

@@ -12,11 +12,6 @@ build-type:     Simple
 extra-source-files:
     Readme.md
 
-flag production
-  description: Enable production mode
-  manual: True
-  default: False
-
 library
   exposed-modules:
       Hickory.ImGUI
@@ -26,16 +21,13 @@ library
   default-extensions:
       NamedFieldPuns
       Rank2Types
-      BangPatterns
       OverloadedStrings
       ScopedTypeVariables
-      LambdaCase
       TupleSections
-      ViewPatterns
       BlockArguments
       RecordWildCards
       GHC2021
-  ghc-options: -Wall -Werror=incomplete-patterns -Wunused-packages -Werror=unused-packages
+  ghc-options: -Wall -Wunused-packages -Werror=unused-packages -O0
   build-depends:
       base
     , dear-imgui
@@ -44,8 +36,4 @@ library
     , lens
     , linear
     , unordered-containers
-  if os(osx)
-    cc-options: -F/System/Library/Frameworks
-  if flag(production)
-    cpp-options: -DPRODUCTION
   default-language: GHC2021

small/hackory/Hickory/Editor.hs

@@ -29,11 +29,9 @@ import Hickory.ImGUI ()
 import Data.Hashable (Hashable)
 import Data.Proxy (Proxy (..))
 
--- Types which have an 'attribute' representation in the editor
 class Attr a where
   mkAttr :: Attribute a
 
-  -- Sometimes the storage type differs (e.g. DearIMGui represents Vec3s as a float triple)
   type AttrRef a :: Type
   type AttrRef a = a
 
@@ -49,21 +47,17 @@ typeOfAttr = \case
   ColorAttribute  -> typeRep
 
 data AttrClasses a where
-  -- Provides proof of a type having certain instances
   AttrClasses :: (Eq a, Eq (AttrRef a)) => AttrClasses a
 
--- Prove that each attribute has some necessary instances
 proveAttrClasses :: Attribute a -> AttrClasses a
 proveAttrClasses = \case
   ColorAttribute  -> AttrClasses
 
--- Check if two attributes have the same type
 eqAttr :: Attribute a1 -> Attribute a2 -> Maybe (a1 :~~: a2)
 eqAttr a b = eqTypeRep (typeOfAttr a) (typeOfAttr b)
 
 data SomeAttribute contents = forall a. Attr a => SomeAttribute    { attr :: Attribute a, contents :: contents a }
 
--- Look up the value for an attribute
 withAttrVal :: forall a b k. (Attr a, Hashable k) => HashMap k (SomeAttribute Identity) -> k -> (a -> b) -> b
 withAttrVal attrs name f = case Map.lookup name attrs of
   Just (SomeAttribute attr (Identity v)) -> case eqAttr attr (mkAttr :: Attribute a) of
@@ -79,19 +73,14 @@ mkDefaultComponent :: [SomeAttribute (Const String)] -> HashMap String (SomeAttr
 mkDefaultComponent xs = Map.fromList $ xs <&> \case
   SomeAttribute attr (Const name) -> (name, SomeAttribute attr (Identity $ defaultAttrVal attr))
 
-{- Generics -}
-
 class GRecordAttributes (f :: Type -> Type) where
   gToAttributeList :: Proxy f -> [SomeAttribute (Const String)]
   gFromHashMap :: HashMap String (SomeAttribute Identity) -> f p
 
--- Empty constructor
 instance GRecordAttributes U1 where
   gToAttributeList _ = []
   gFromHashMap _ = U1
 
--- For metadata that doesn't affect structure (the D and C metadata),
--- we just pass through to the contained representation.
 instance GRecordAttributes f => GRecordAttributes (M1 D x f) where
   gToAttributeList _ = gToAttributeList (Proxy :: Proxy f)
   gFromHashMap hm = M1 (gFromHashMap hm)
@@ -100,27 +89,6 @@ instance GRecordAttributes f => GRecordAttributes (M1 C x f) where
   gToAttributeList _ = gToAttributeList (Proxy :: Proxy f)
   gFromHashMap hm = M1 (gFromHashMap hm)
 
-instance (GRecordAttributes f, GRecordAttributes g)
-      => GRecordAttributes (f :*: g) where
-  gToAttributeList _ =
-    gToAttributeList (Proxy :: Proxy f) ++ gToAttributeList (Proxy :: Proxy g)
-  gFromHashMap hm =
-    let left  = gFromHashMap hm
-        right = gFromHashMap hm
-    in left :*: right
-
--- A single field
-instance (Selector s, Attr a) => GRecordAttributes (M1 S s (K1 i a)) where
-  gToAttributeList _ =
-    let fieldName = selName (undefined :: M1 S s (K1 i a) p)
-     in [ SomeAttribute (mkAttr @a) (Const fieldName) ]
-  gFromHashMap hm =
-    let fieldName = selName (undefined :: M1 S s (K1 i a) p)
-        val = withAttrVal hm fieldName id
-    in M1 (K1 val)
-
-{- Generic GLSL struct definitions -}
-
 class GlslType a where
   glslTypeName :: Proxy a -> String
 
@@ -138,12 +106,6 @@ instance GHasGlslUniformDef f => GHasGlslUniformDef (M1 D x f) where
 instance GHasGlslUniformDef f => GHasGlslUniformDef (M1 C x f) where
   gGlslLines _ = gGlslLines (Proxy :: Proxy f)
 
-instance (GHasGlslUniformDef f, GHasGlslUniformDef g)
-      => GHasGlslUniformDef (f :*: g) where
-  gGlslLines _ =
-    gGlslLines (Proxy :: Proxy f) ++
-    gGlslLines (Proxy :: Proxy g)
-
 instance (Selector s, GlslType a)
       => GHasGlslUniformDef (M1 S s (K1 i a)) where
   gGlslLines _ =

small/hackory/package.yaml

@@ -2,22 +2,19 @@ name:                Hackory
 
 ghc-options:
     - -Wall
-    - -Werror=incomplete-patterns
     - -Wunused-packages
     - -Werror=unused-packages
+    - -O0
 
 extra-source-files:
     - Readme.md
 
 default-extensions:
     - NamedFieldPuns
     - Rank2Types
-    - BangPatterns
     - OverloadedStrings
     - ScopedTypeVariables
-    - LambdaCase
     - TupleSections
-    - ViewPatterns
     - BlockArguments
     - RecordWildCards
     - GHC2021
@@ -31,22 +28,9 @@ dependencies:
     - linear
     - unordered-containers
 
-flags:
-  production:
-    description: Enable production mode
-    manual: true
-    default: false
-
-when:
-    - condition: os(osx)
-      cc-options:         -F/System/Library/Frameworks
-
 library:
   verbatim:
     default-language: GHC2021
-  when:
-    - condition: "flag(production)"
-      cpp-options: -DPRODUCTION
 
   exposed-modules:
     - Hickory.ImGUI