Add pattern functor and utilise recursion schemes/catamorphisms

intlc.cabal

@@ -25,6 +25,7 @@ common common
     , extra                ^>=1.7
     , mtl                  ^>=2.2
     , optics               ^>=0.4
+    , recursion-schemes    ^>=5.2
     , relude               ^>=1.1
     , text                 ^>=1.2
     , validation           ^>=1.1

lib/Intlc/Backend/ICU/Compiler.hs

@@ -8,46 +8,48 @@
 
 module Intlc.Backend.ICU.Compiler where
 
-import qualified Data.Text as T
+import           Data.Functor.Foldable (cata)
+import qualified Data.Text             as T
 import           Intlc.ICU
 import           Prelude
 
 compileMsg :: Message -> Text
 compileMsg = node . unMessage
 
 node :: Node -> Text
-node Fin = mempty
-node (Char c x)     = T.singleton c <> node x
-node x@(Bool {})    = "{" <> (unArg . name $ x) <> ", boolean, true {" <> node (trueCase x)  <> "} false {" <> node (falseCase x) <> "}}" <> node (next x)
-node (String n x)   = "{" <> unArg n <> "}" <> node x
-node (Number n x)   = "{" <> unArg n <> ", number}" <> node x
-node (Date n fmt x) = "{" <> unArg n <> ", date, " <> dateTimeFmt fmt  <> "}" <> node x
-node (Time n fmt x) = "{" <> unArg n <> ", time, " <> dateTimeFmt fmt  <> "}" <> node x
-node (CardinalExact n xs y)        = "{" <> unArg n <> ", plural, " <> cases <> "}" <> node y
-  where cases = unwords . toList . fmap exactPluralCase $ xs
-node (CardinalInexact n xs ys w z) = "{" <> unArg n <> ", plural, " <> cases <> "}" <> node z
-  where cases = unwords . mconcat $ [exactPluralCase <$> xs, rulePluralCase <$> ys, pure $ wildcard w]
-node (Ordinal n xs ys w z)         = "{" <> unArg n <> ", selectordinal, " <> cases <> "}" <> node z
-  where cases = unwords $ (exactPluralCase <$> xs) <> (rulePluralCase <$> ys) <> pure (wildcard w)
-node (PluralRef _ x)    = "#" <> node x
-node (SelectNamed n xs y)       = "{" <> unArg n <> ", select, " <> cases <> "}" <> node y
-  where cases = unwords . fmap selectCase . toList $ xs
-node (SelectWild n w x)         = "{" <> unArg n <> ", select, " <> wildcard w <> "}" <> node x
-node (SelectNamedWild n xs w y) = "{" <> unArg n <> ", select, " <> cases <> "}" <> node y
-  where cases = unwords . (<> pure (wildcard w)) . fmap selectCase . toList $ xs
-node (Callback n xs y) = "<" <> unArg n <> ">" <> node xs <> "</" <> unArg n <> ">" <> node y
+node = cata $ \case
+  FinF -> mempty
+  (CharF c x)     -> T.singleton c <> x
+  x@(BoolF {})    -> "{" <> (unArg . nameF $ x) <> ", boolean, true {" <> trueCaseF x <> "} false {" <> falseCaseF x <> "}}" <> nextF x
+  (StringF n x)   -> "{" <> unArg n <> "}" <> x
+  (NumberF n x)   -> "{" <> unArg n <> ", number}" <> x
+  (DateF n fmt x) -> "{" <> unArg n <> ", date, " <> dateTimeFmt fmt  <> "}" <> x
+  (TimeF n fmt x) -> "{" <> unArg n <> ", time, " <> dateTimeFmt fmt  <> "}" <> x
+  (CardinalExactF n xs y)        -> "{" <> unArg n <> ", plural, " <> cases <> "}" <> y
+    where cases = unwords . toList . fmap exactPluralCase $ xs
+  (CardinalInexactF n xs ys w z) -> "{" <> unArg n <> ", plural, " <> cases <> "}" <> z
+    where cases = unwords . mconcat $ [exactPluralCase <$> xs, rulePluralCase <$> ys, pure $ wildcard w]
+  (OrdinalF n xs ys w z)         -> "{" <> unArg n <> ", selectordinal, " <> cases <> "}" <> z
+    where cases = unwords $ (exactPluralCase <$> xs) <> (rulePluralCase <$> ys) <> pure (wildcard w)
+  (PluralRefF _ x)    -> "#" <> x
+  (SelectNamedF n xs y)       -> "{" <> unArg n <> ", select, " <> cases <> "}" <> y
+    where cases = unwords . fmap selectCase . toList $ xs
+  (SelectWildF n w x)         -> "{" <> unArg n <> ", select, " <> wildcard w <> "}" <> x
+  (SelectNamedWildF n xs w y) -> "{" <> unArg n <> ", select, " <> cases <> "}" <> y
+    where cases = unwords . (<> pure (wildcard w)) . fmap selectCase . toList $ xs
+  (CallbackF n xs y) -> "<" <> unArg n <> ">" <> xs <> "</" <> unArg n <> ">" <> y
 
 dateTimeFmt :: DateTimeFmt -> Text
 dateTimeFmt Short  = "short"
 dateTimeFmt Medium = "medium"
 dateTimeFmt Long   = "long"
 dateTimeFmt Full   = "full"
 
-exactPluralCase :: PluralCase PluralExact -> Text
-exactPluralCase (PluralExact n, x) = "=" <> n <> " {" <> node x <> "}"
+exactPluralCase :: PluralCaseF PluralExact Text -> Text
+exactPluralCase (PluralExact n, x) = "=" <> n <> " {" <> x <> "}"
 
-rulePluralCase :: PluralCase PluralRule -> Text
-rulePluralCase (r, x) = pluralRule r <> " {" <> node x <> "}"
+rulePluralCase :: PluralCaseF PluralRule Text -> Text
+rulePluralCase (r, x) = pluralRule r <> " {" <> x <> "}"
 
 pluralRule :: PluralRule -> Text
 pluralRule Zero = "zero"
@@ -56,8 +58,8 @@ pluralRule Two  = "two"
 pluralRule Few  = "few"
 pluralRule Many = "many"
 
-selectCase :: SelectCase -> Text
-selectCase (n, x) = n <> " {" <> node x <> "}"
+selectCase :: SelectCaseF Text -> Text
+selectCase (n, x) = n <> " {" <> x <> "}"
 
-wildcard :: Node -> Text
-wildcard x = "other {" <> node x <> "}"
+wildcard :: Text -> Text
+wildcard x = "other {" <> x <> "}"

lib/Intlc/Backend/JavaScript/Language.hs

@@ -1,10 +1,11 @@
 module Intlc.Backend.JavaScript.Language where
 
-import qualified Data.Text  as T
-import           Intlc.Core (Locale)
-import qualified Intlc.ICU  as ICU
+import           Data.Functor.Foldable (cataA)
+import qualified Data.Text             as T
+import           Intlc.Core            (Locale)
+import qualified Intlc.ICU             as ICU
 import           Prelude
-import           Utils      ((<>^))
+import           Utils                 ((<>^))
 
 type ASTCompiler = Reader Locale
 
@@ -49,46 +50,46 @@ fromKeyedMsg :: Text -> ICU.Message -> ASTCompiler Stmt
 fromKeyedMsg n (ICU.Message x) = Stmt n <$> fromNode x
 
 fromNode :: ICU.Node -> ASTCompiler [Expr]
-fromNode ICU.Fin        = pure mempty
-fromNode (ICU.Char c x) = pure (pure (TPrint (T.singleton c))) <>^ fromNode x
-fromNode x@ICU.Bool {}  = do
-      l <- fromBoolCase True (ICU.trueCase x)
-      r <- fromBoolCase False (ICU.falseCase x)
-      let start = TMatch . Match (ICU.name x) LitCond . LitMatchRet $ l :| [r]
-      pure (pure start) <>^ fromNode (ICU.next x)
-fromNode (ICU.String n x)      = pure (pure (TStr n)) <>^ fromNode x
-fromNode (ICU.Number n x)      = pure (pure (TNum n)) <>^ fromNode x
-fromNode (ICU.Date n x y)      = pure (pure (TDate n x)) <>^ fromNode y
-fromNode (ICU.Time n x y)      = pure (pure (TTime n x)) <>^ fromNode y
-fromNode (ICU.CardinalExact n lcs x)              = (pure . TMatch . Match n LitCond . LitMatchRet <$> (fromExactPluralCase `mapM` lcs)) <>^ fromNode x
-fromNode (ICU.CardinalInexact n lcs [] w x)       = (pure . TMatch . Match n LitCond <$> ret) <>^ fromNode x
-    where ret = NonLitMatchRet <$> (fromExactPluralCase `mapM` lcs) <*> fromPluralWildcard w
-fromNode (ICU.CardinalInexact n [] rcs w x)       = (pure . TMatch . Match n CardinalPluralRuleCond <$> ret) <>^ fromNode x
-    where ret = NonLitMatchRet <$> (fromRulePluralCase `mapM` rcs) <*> fromPluralWildcard w
-fromNode (ICU.CardinalInexact n (lc:lcs) rcs w x) = (pure . TMatch . Match n LitCond <$> litRet) <>^ fromNode x
-    where litRet = RecMatchRet <$> (fromExactPluralCase `mapM` lcs') <*> (Match n CardinalPluralRuleCond <$> ruleRet)
-          ruleRet = NonLitMatchRet <$> (fromRulePluralCase `mapM` rcs) <*> fromPluralWildcard w
-          lcs' = lc :| lcs
-fromNode (ICU.Ordinal n [] rcs w x)               = (pure . TMatch . Match n OrdinalPluralRuleCond <$> m) <>^ fromNode x
-    where m = NonLitMatchRet <$> (fromRulePluralCase `mapM` rcs) <*> fromPluralWildcard w
-fromNode (ICU.Ordinal n (lc:lcs) rcs w x)         = (pure . TMatch . Match n LitCond <$> m) <>^ fromNode x
-    where m = RecMatchRet <$> ((:|) <$> fromExactPluralCase lc <*> (fromExactPluralCase `mapM` lcs)) <*> im
-          im = Match n OrdinalPluralRuleCond <$> (NonLitMatchRet <$> (fromRulePluralCase `mapM` rcs) <*> fromPluralWildcard w)
-
-fromNode (ICU.PluralRef n x)   = pure (pure (TNum n)) <>^ fromNode x
-fromNode (ICU.SelectNamed n cs x)       = (pure . TMatch . Match n LitCond . LitMatchRet <$> ret) <>^ fromNode x
-  where ret = fromSelectCase `mapM` cs
-fromNode (ICU.SelectWild n w x)         = (pure . TMatch . Match n LitCond <$> ret) <>^ fromNode x
-  where ret = NonLitMatchRet mempty <$> fromSelectWildcard w
-fromNode (ICU.SelectNamedWild n cs w x) = (pure . TMatch . Match n LitCond <$> ret) <>^ fromNode x
-  where ret = NonLitMatchRet <$> (toList <$> fromSelectCase `mapM` cs) <*> fromSelectWildcard w
-fromNode (ICU.Callback n x y) = (pure . TApply n <$> fromNode x) <>^ fromNode y
-
-fromExactPluralCase :: ICU.PluralCase ICU.PluralExact -> ASTCompiler Branch
-fromExactPluralCase (ICU.PluralExact n, x) = Branch n <$> fromNode x
-
-fromRulePluralCase :: ICU.PluralCase ICU.PluralRule -> ASTCompiler Branch
-fromRulePluralCase (r, x) = Branch (qts matcher) <$> fromNode x
+fromNode = cataA $ \case
+  ICU.FinF        -> pure mempty
+  (ICU.CharF c x) -> pure (pure (TPrint (T.singleton c))) <>^ x
+  x@ICU.BoolF {}  -> do
+        l <- fromBoolCase True (ICU.trueCaseF x)
+        r <- fromBoolCase False (ICU.falseCaseF x)
+        let start = TMatch . Match (ICU.nameF x) LitCond . LitMatchRet $ l :| [r]
+        pure (pure start) <>^ ICU.nextF x
+  (ICU.StringF n x)      -> pure (pure (TStr n)) <>^ x
+  (ICU.NumberF n x)      -> pure (pure (TNum n)) <>^ x
+  (ICU.DateF n x y)      -> pure (pure (TDate n x)) <>^ y
+  (ICU.TimeF n x y)      -> pure (pure (TTime n x)) <>^ y
+  (ICU.CardinalExactF n lcs x)              -> (pure . TMatch . Match n LitCond . LitMatchRet <$> (fromExactPluralCase `mapM` lcs)) <>^ x
+  (ICU.CardinalInexactF n lcs [] w x)       -> (pure . TMatch . Match n LitCond <$> ret) <>^ x
+      where ret = NonLitMatchRet <$> (fromExactPluralCase `mapM` lcs) <*> (Wildcard <$> w)
+  (ICU.CardinalInexactF n [] rcs w x)       -> (pure . TMatch . Match n CardinalPluralRuleCond <$> ret) <>^ x
+      where ret = NonLitMatchRet <$> (fromRulePluralCase `mapM` rcs) <*> (Wildcard <$> w)
+  (ICU.CardinalInexactF n (lc:lcs) rcs w x) -> (pure . TMatch . Match n LitCond <$> litRet) <>^ x
+      where litRet = RecMatchRet <$> (fromExactPluralCase `mapM` lcs') <*> (Match n CardinalPluralRuleCond <$> ruleRet)
+            ruleRet = NonLitMatchRet <$> (fromRulePluralCase `mapM` rcs) <*> (Wildcard <$> w)
+            lcs' = lc :| lcs
+  (ICU.OrdinalF n [] rcs w x)               -> (pure . TMatch . Match n OrdinalPluralRuleCond <$> m) <>^ x
+      where m = NonLitMatchRet <$> (fromRulePluralCase `mapM` rcs) <*> (Wildcard <$> w)
+  (ICU.OrdinalF n (lc:lcs) rcs w x)         -> (pure . TMatch . Match n LitCond <$> m) <>^ x
+      where m = RecMatchRet <$> ((:|) <$> fromExactPluralCase lc <*> (fromExactPluralCase `mapM` lcs)) <*> im
+            im = Match n OrdinalPluralRuleCond <$> (NonLitMatchRet <$> (fromRulePluralCase `mapM` rcs) <*> (Wildcard <$> w))
+  (ICU.PluralRefF n x)   -> pure (pure (TNum n)) <>^ x
+  (ICU.SelectNamedF n cs x)       -> (pure . TMatch . Match n LitCond . LitMatchRet <$> ret) <>^ x
+    where ret = fromSelectCase `mapM` cs
+  (ICU.SelectWildF n w x)         -> (pure . TMatch . Match n LitCond <$> ret) <>^ x
+    where ret = NonLitMatchRet mempty <$> (Wildcard <$> w)
+  (ICU.SelectNamedWildF n cs w x) -> (pure . TMatch . Match n LitCond <$> ret) <>^ x
+    where ret = NonLitMatchRet <$> (toList <$> fromSelectCase `mapM` cs) <*> (Wildcard <$> w)
+  (ICU.CallbackF n x y) -> (pure . TApply n <$> x) <>^ y
+
+fromExactPluralCase :: ICU.PluralCaseF ICU.PluralExact (ASTCompiler [Expr]) -> ASTCompiler Branch
+fromExactPluralCase (ICU.PluralExact n, x) = Branch n <$> x
+
+fromRulePluralCase :: ICU.PluralCaseF ICU.PluralRule (ASTCompiler [Expr]) -> ASTCompiler Branch
+fromRulePluralCase (r, x) = Branch (qts matcher) <$> x
   where matcher = case r of
          ICU.Zero -> "zero"
          ICU.One  -> "one"
@@ -97,15 +98,9 @@ fromRulePluralCase (r, x) = Branch (qts matcher) <$> fromNode x
          ICU.Many -> "many"
         qts y = "'" <> y <> "'"
 
-fromPluralWildcard :: ICU.Node -> ASTCompiler Wildcard
-fromPluralWildcard x = Wildcard <$> fromNode x
-
-fromSelectCase :: ICU.SelectCase -> ASTCompiler Branch
-fromSelectCase (x, y) = Branch ("'" <> x <> "'") <$> fromNode y
-
-fromSelectWildcard :: ICU.Node -> ASTCompiler Wildcard
-fromSelectWildcard x = Wildcard <$> fromNode x
+fromSelectCase :: ICU.SelectCaseF (ASTCompiler [Expr]) -> ASTCompiler Branch
+fromSelectCase (x, y) = Branch ("'" <> x <> "'") <$> y
 
-fromBoolCase :: Bool -> ICU.Node -> ASTCompiler Branch
-fromBoolCase b x = Branch b' <$> fromNode x
+fromBoolCase :: Bool -> ASTCompiler [Expr] -> ASTCompiler Branch
+fromBoolCase b x = Branch b' <$> x
   where b' = if b then "true" else "false"

lib/Intlc/Backend/TypeScript/Language.hs

@@ -1,8 +1,9 @@
 module Intlc.Backend.TypeScript.Language where
 
-import           Data.List.NonEmpty (nub)
-import qualified Data.Map           as M
-import qualified Intlc.ICU          as ICU
+import           Data.Functor.Foldable (cata)
+import           Data.List.NonEmpty    (nub)
+import qualified Data.Map              as M
+import qualified Intlc.ICU             as ICU
 import           Prelude
 
 -- | A representation of the type-level output we will be compiling. It's a
@@ -44,33 +45,30 @@ fromMsg :: Out -> ICU.Message -> TypeOf
 fromMsg x (ICU.Message y) = Lambda (collateArgs . fromNode $ y) x
 
 fromNode :: ICU.Node -> UncollatedArgs
-fromNode ICU.Fin               = mempty
-fromNode (ICU.Char _ x)        = fromNode x
-fromNode (ICU.Bool n x y z)    = (n, TBool) : foldMap fromNode [x, y, z]
-fromNode (ICU.String n x)      = pure (n, TStr) <> fromNode x
-fromNode (ICU.Number n x)      = pure (n, TNum) <> fromNode x
-fromNode (ICU.Date n _ x)      = pure (n, TDate) <> fromNode x
-fromNode (ICU.Time n _ x)      = pure (n, TDate) <> fromNode x
--- We can compile exact cardinal plurals (i.e. those without a wildcard) to a
--- union of number literals.
-fromNode (ICU.CardinalExact n ls x)        = (n, t) : (fromExactPluralCase =<< toList ls) <> fromNode x
-  where t = TNumLitUnion $ caseLit <$> ls
+fromNode = cata $ \case
+  (ICU.BoolF n xs ys zs) -> (n, TBool) : xs <> ys <> zs
+  (ICU.StringF n xs)     -> pure (n, TStr) <> xs
+  (ICU.NumberF n xs)     -> pure (n, TNum) <> xs
+  (ICU.DateF n _ xs)     -> pure (n, TDate) <> xs
+  (ICU.TimeF n _ xs)     -> pure (n, TDate) <> xs
+  -- We can compile exact cardinal plurals (i.e. those without a wildcard) to a
+  -- union of number literals.
+  (ICU.CardinalExactF n ls xs)         ->
+    let t = TNumLitUnion $ caseLit <$> ls
         caseLit (ICU.PluralExact y, _) = y
-fromNode (ICU.CardinalInexact n ls rs w x) = (n, TNum) : (fromExactPluralCase =<< ls) <> (fromRulePluralCase =<< rs) <> foldMap fromNode [w, x]
-fromNode (ICU.Ordinal n ls rs w x)         = (n, TNum) : (fromExactPluralCase =<< ls) <> (fromRulePluralCase =<< rs) <> foldMap fromNode [w, x]
--- Plural references are treated as a no-op.
-fromNode (ICU.PluralRef _ x)               = fromNode x
-fromNode (ICU.SelectWild n w x)            = (n, TStr) : foldMap fromNode [w, x]
-fromNode (ICU.SelectNamedWild n cs w x)    = (n, TStr) : (fromSelectCase =<< toList cs) <> foldMap fromNode [w, x]
--- When there's no wildcard case we can compile to a union of string literals.
-fromNode (ICU.SelectNamed n cs x)          = (n, TStrLitUnion (fst <$> cs)) : (fromSelectCase =<< toList cs) <> fromNode x
-fromNode (ICU.Callback n x y)              = (n, TEndo) : foldMap fromNode [x, y]
+     in (n, t) : (fromPluralCase =<< toList ls) <> xs
+  (ICU.CardinalInexactF n ls rs ws xs) -> (n, TNum) : (fromPluralCase =<< ls) <> (fromPluralCase =<< rs) <> ws <> xs
+  (ICU.OrdinalF n ls rs ws xs)         -> (n, TNum) : (fromPluralCase =<< ls) <> (fromPluralCase =<< rs) <> ws <> xs
+  (ICU.SelectWildF n ws xs)            -> (n, TStr) : ws <> xs
+  (ICU.SelectNamedWildF n cs ws xs)    -> (n, TStr) : (fromSelectCase =<< toList cs) <> ws <> xs
+  -- When there's no wildcard case we can compile to a union of string literals.
+  (ICU.SelectNamedF n cs xs)           -> (n, TStrLitUnion (fst <$> cs)) : (fromSelectCase =<< toList cs) <> xs
+  (ICU.CallbackF n xs ys)              -> (n, TEndo) : xs <> ys
+  -- Plural references are treated as a no-op.
+  x -> fold x
 
-fromExactPluralCase :: ICU.PluralCase ICU.PluralExact -> UncollatedArgs
-fromExactPluralCase = fromNode . snd
+fromPluralCase :: ICU.PluralCaseF a b -> b
+fromPluralCase = snd
 
-fromRulePluralCase :: ICU.PluralCase ICU.PluralRule -> UncollatedArgs
-fromRulePluralCase = fromNode . snd
-
-fromSelectCase :: ICU.SelectCase -> UncollatedArgs
-fromSelectCase = fromNode . snd
+fromSelectCase :: ICU.SelectCaseF a -> a
+fromSelectCase = snd

lib/Intlc/Compiler.hs

@@ -1,6 +1,7 @@
 module Intlc.Compiler (compileDataset, compileFlattened, flatten, expandPlurals, expandRules) where
 
 import           Data.Foldable                     (elem)
+import           Data.Functor.Foldable             (cata, embed)
 import           Data.List.Extra                   (unionBy)
 import qualified Data.Map                          as M
 import qualified Data.Text                         as T
@@ -41,27 +42,6 @@ compileFlattened = JSON.compileDataset . mapMsgs flatten
 mapMsgs :: (ICU.Message -> ICU.Message) -> Dataset Translation -> Dataset Translation
 mapMsgs f = fmap $ \x -> x { message = f (message x) }
 
--- Map every `Node`, included those nested. Order is unspecified. The children
--- of a node, if any, will be traversed after the provided function is applied.
-mapNodes :: (ICU.Node -> ICU.Node) -> ICU.Node -> ICU.Node
-mapNodes f = f >>> \case
-  ICU.Fin -> ICU.Fin
-  ICU.Char c x -> ICU.Char c (rec x)
-  ICU.String n x -> ICU.String n (rec x)
-  ICU.Number n x -> ICU.Number n (rec x)
-  ICU.Date n x y -> ICU.Date n x (rec y)
-  ICU.Time n x y -> ICU.Time n x (rec y)
-  ICU.Bool n x y z -> ICU.Bool n (f x) (f y) (rec z)
-  ICU.CardinalExact n xs y        -> ICU.CardinalExact n (mapPluralCase f <$> xs) (rec y)
-  ICU.CardinalInexact n xs ys w z -> ICU.CardinalInexact n (mapPluralCase f <$> xs) (mapPluralCase f <$> ys) (f w) (rec z)
-  ICU.Ordinal n xs ys w z         -> ICU.Ordinal n (mapPluralCase f <$> xs) (mapPluralCase f <$> ys) (f w) (rec z)
-  ICU.PluralRef n x -> ICU.PluralRef n (rec x)
-  ICU.SelectNamed n xs y       -> ICU.SelectNamed n (mapSelectCase f <$> xs) (rec y)
-  ICU.SelectWild n w x         -> ICU.SelectWild n (f w) (rec x)
-  ICU.SelectNamedWild n xs w y -> ICU.SelectNamedWild n (mapSelectCase f <$> xs) (f w) (rec y)
-  ICU.Callback n x y -> ICU.Callback n (f x) (rec y)
-  where rec = mapNodes f
-
 flatten :: ICU.Message -> ICU.Message
 flatten = ICU.Message . go mempty . ICU.unMessage
   where go :: ICU.Node -> ICU.Node -> ICU.Node
@@ -88,13 +68,12 @@ flatten = ICU.Message . go mempty . ICU.unMessage
 -- Added plural rules inherit the content of the wildcard. Output order of
 -- rules is unspecified.
 expandPlurals :: ICU.Message -> ICU.Message
-expandPlurals (ICU.Message x) = ICU.Message . flip mapNodes x $ \case
-  p@(ICU.CardinalExact {})               -> p
-  ICU.CardinalInexact n exacts rules w y ->
-    ICU.CardinalInexact n exacts (toList $ expandRules rules w) w y
-  ICU.Ordinal n exacts rules w y         ->
-    ICU.Ordinal n exacts (toList $ expandRules rules w) w y
-  y -> y
+expandPlurals = ICU.Message . cata f . ICU.unMessage
+  where f (ICU.CardinalInexactF n exacts rules w y) =
+            ICU.CardinalInexact n exacts (toList $ expandRules rules w) w y
+        f (ICU.OrdinalF n exacts rules w y) =
+            ICU.Ordinal n exacts (toList $ expandRules rules w) w y
+        f y = embed y
 
 expandRules :: (Functor f, Foldable f) => f (ICU.PluralCase ICU.PluralRule) -> ICU.Node -> NonEmpty (ICU.PluralCase ICU.PluralRule)
 -- `fromList` is a cheap way to promise the compiler that we'll return a
@@ -108,8 +87,8 @@ expandRules ys w = fromList $ unionBy ((==) `on` caseRule) (toList ys) extraCase
         allRules = universe
         caseRule (x, _) = x
 
-mapSelectCase :: (ICU.Node -> ICU.Node) -> ICU.SelectCase -> ICU.SelectCase
+mapSelectCase :: (a -> a) -> ICU.SelectCaseF a -> ICU.SelectCaseF a
 mapSelectCase = second
 
-mapPluralCase :: (ICU.Node -> ICU.Node) -> ICU.PluralCase a -> ICU.PluralCase a
+mapPluralCase :: (b -> b) -> ICU.PluralCaseF a b -> ICU.PluralCaseF a b
 mapPluralCase = second