fixed the order

noinia · Dec 25, 2024 · dbb8c57 · dbb8c57
1 parent 26235e1
commit dbb8c57
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 8 deletions.
diff --git a/hgeometry-combinatorial/src/HGeometry/Trie.hs b/hgeometry-combinatorial/src/HGeometry/Trie.hs
@@ -19,7 +19,6 @@ import Data.Bitraversable
 import Data.Foldable1
 import Data.Functor.Apply ((<.*>))
 import Data.Functor.Classes
-import Data.Monoid (Endo(..))
 import Data.Semigroup.Traversable
 
 --------------------------------------------------------------------------------
@@ -35,9 +34,20 @@ deriving instance (Functor (f e))     => Functor (TrieF f e)
 deriving instance (Foldable (f e))    => Foldable (TrieF f e)
 deriving instance (Traversable (f e)) => Traversable (TrieF f e)
 
+-- instance Foldable (f e) => Foldable1 (TrieF f e) where
+--   foldMap1 f (Node v chs) = let Endo g = foldMap (\x -> Endo $ \x0 -> x0 <> foldMap1 f x) chs
+--                             in g (f v)
+-- somehow the order is wrong here...
+
 instance Foldable (f e) => Foldable1 (TrieF f e) where
-  foldMap1 f (Node v chs) = let Endo g = foldMap (\x -> Endo $ \x0 -> x0 <> foldMap1 f x) chs
-                            in g (f v)
+  foldMap1 f (Node v chs) = case foldMap (Just . foldMap1 f) chs of
+                              Nothing -> f v
+                              Just s  -> f v <> s
+  -- foldMap1 = foldMap1Default
+
+  -- f (Node v chs) = let Endo g = foldMap (\x -> Endo $ \x0 -> x0 <> foldMap1 f x) chs
+  --                           in g (f v)
+
 
 instance Traversable (f e) => Traversable1 (TrieF f e) where
   traverse1 f (Node v chs) =

diff --git a/hgeometry-combinatorial/test/TrieSpec.hs b/hgeometry-combinatorial/test/TrieSpec.hs
@@ -1,6 +1,6 @@
 module TrieSpec(spec) where
 
-import           Control.Lens
+-- import           Control.Lens
 import           Data.Foldable1
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Map as Map
@@ -13,14 +13,14 @@ import           Test.Hspec
 spec :: Spec
 spec = describe "Trie tests" $ do
          it "fold1 Map" $
-           fold1 myTrie `shouldBe` "rootbarfoograndchild"
+           fold1 myTrie `shouldBe` "rootfoograndchildbar"
          it "foldable1 to list Map" $
-           toNonEmpty myTrie `shouldBe` NonEmpty.fromList ["root","bar","foo","grandchild"]
+           toNonEmpty myTrie `shouldBe` NonEmpty.fromList ["root","foo","grandchild","bar"]
 
          it "fold1 KV" $
-           fold1 myTrie `shouldBe` "rootbarfoograndchild"
+           fold1 myTrie2 `shouldBe` "rootfoograndchildbar"
          it "foldable1 to list KV" $
-           toNonEmpty myTrie `shouldBe` NonEmpty.fromList ["root","bar","foo","grandchild"]
+           toNonEmpty myTrie2 `shouldBe` NonEmpty.fromList ["root","foo","grandchild","bar"]