Håndter vigtigt hjørnetilfælde

athas · Jan 30, 2025 · f732213 · f732213
1 parent 02ad284
commit f732213
Showing 1 changed file with 29 additions and 14 deletions.
diff --git a/concieggs/compiled/generate-trie.cabal/Main.hs b/concieggs/compiled/generate-trie.cabal/Main.hs
@@ -24,27 +24,42 @@ separateFirstChar = \case
   c : cs -> Just (c, cs)
   [] -> Nothing
 
+partitionMaybe :: (a -> Maybe b) -> [a] -> ([a], [b])
+partitionMaybe f xs = (mapMaybe f' xs, mapMaybe f xs)
+  where f' x = case f x of
+                 Just _ -> Nothing
+                 Nothing -> Just x
+
 constructTrie :: [([Word8], [Word8])] -> Trie
 constructTrie = \case
   [] ->
     NoMatch
   [([], target)] ->
     Match target
   pairs ->
-    sort pairs
-    & mapMaybe (\(source, target) -> do
-                   source' <- separateFirstChar source
-                   pure (source', target))
-    & groupBy (\((c, _), _) ((d, _), _) -> c == d)
-    & map (\case
-              group@(((c, _), _) : _) ->
-                (c, map (\((_, source'), target) -> (source', target)) group)
-              [] ->
-                error "unexpected empty group")
-    & sortBy (compare `on` (length . snd))
-    & reverse
-    & foldr (\(c, pairs') failureTrie ->
-               Check c (constructTrie pairs') failureTrie) NoMatch
+    let (empties, nonEmpties) =
+          sort pairs
+          & partitionMaybe (\(source, target) -> do
+                               source' <- separateFirstChar source
+                               pure (source', target))
+    in nonEmpties
+       & groupBy (\((c, _), _) ((d, _), _) -> c == d)
+       & map (\case
+                 group@(((c, _), _) : _) ->
+                   (c, map (\((_, source'), target) -> (source', target)) group)
+                 [] ->
+                   error "unexpected empty group")
+       & sortBy (compare `on` (length . snd))
+       & reverse
+       & foldr (\(c, pairs') failureTrie ->
+                  Check c (constructTrie pairs') failureTrie) NoMatch
+       & (case empties of
+            [] ->
+              id
+            [([], target)] ->
+              Check 0 (Match target)
+            _ ->
+              error "unexpected duplicates")
 
 formatTrie :: Trie -> [String]
 formatTrie = \case