Update functional dependencies so multiple operations can be supported on the same underlying record

README.md

@@ -193,6 +193,30 @@ showRecord { a: "foo" , b: 42 , c: false }
 "{ a: \"foo\", b: 42, c: false }"
 ```
 
+## Helping type inference along
+
+The compiler will not always be able to infer all types for the maps and folds
+we write for heterogeneous types. That's because it will attempt to determine
+an output from any combination of folding function, accumulator, and input (for
+folds) or mapping function and input (for maps). This ensures that multiple
+mapping and folding operations can be supported for the same underlying input,
+but has the downside that the compiler will not infer these types.
+
+You will need to provide annotations for any folding, mapping, accumulator, and
+input types that are not determined in some other way.
+
+For example, this sample `showWithIndex` function for showing a heterogeneous
+list requires an annotation for the accumulator type:
+
+```purescript
+showWithIndex :: forall hlist.
+  HFoldlWithIndex ShowWithIndex (Array (Tuple Int String)) hlist (Array (Tuple Int String)) =>
+  hlist ->
+  Array (Tuple Int String)
+showWithIndex =
+  hfoldlWithIndex ShowWithIndex ([] :: Array (Tuple Int String))
+```
+
 ## Documentation
 
 - Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-heterogeneous).

src/Heterogeneous/Folding.purs

@@ -25,16 +25,16 @@ class Folding f x y z | f x y -> z where
 instance functionFolding :: Folding (x -> y -> x) x y x where
   folding f = f
 
-class FoldingWithIndex f i x y z | f x y -> z, f -> i where
+class FoldingWithIndex f i x y z | f i x y -> z where
   foldingWithIndex :: f -> i -> x -> y -> z
 
 instance functionFoldingWithIndex :: FoldingWithIndex (i -> x -> y -> x) i x y x where
   foldingWithIndex f = f
 
-class HFoldl f x a b | a -> f x b where
+class HFoldl f x a b | f x a -> b where
   hfoldl :: f -> x -> a -> b
 
-class HFoldlWithIndex f x a b | a -> f x b where
+class HFoldlWithIndex f x a b | f x a -> b where
   hfoldlWithIndex :: f -> x -> a -> b
 
 newtype ConstFolding f = ConstFolding f
@@ -106,7 +106,7 @@ instance hfoldlRecordWithIndex ::
   hfoldlWithIndex f x =
     foldlRecordRowList f x (RLProxy :: RLProxy rl)
 
-class FoldlRecord f x (rl :: RowList) (r :: # Type) b | rl -> f x r b where
+class FoldlRecord f x (rl :: RowList) (r :: # Type) b | f x rl -> b, rl -> r where
   foldlRecordRowList :: f -> x -> RLProxy rl -> { | r } -> b
 
 instance foldlRecordCons ::
@@ -166,7 +166,7 @@ instance hfoldlVariantWithIndex ::
   hfoldlWithIndex =
     foldlVariantRowList (RLProxy :: RLProxy rl)
 
-class FoldlVariant f x (rl :: RowList) (r :: # Type) b | rl -> f x r b where
+class FoldlVariant f x (rl :: RowList) (r :: # Type) b | f x rl -> b, rl -> r where
   foldlVariantRowList :: RLProxy rl -> f -> x -> Variant r -> b
 
 instance foldlVariantCons ::
@@ -204,7 +204,7 @@ instance hfoldlVariantFWithIndex ::
   hfoldlWithIndex =
     foldlVariantFRowList (RLProxy :: RLProxy rl)
 
-class FoldlVariantF f x (rl :: RowList) (r :: # Type) z y | rl -> f x r z y where
+class FoldlVariantF f x (rl :: RowList) (r :: # Type) z y | f x rl z -> r y where
   foldlVariantFRowList :: RLProxy rl -> f -> x -> VariantF r z -> y
 
 instance foldlVariantFCons ::

src/Heterogeneous/Mapping.purs

@@ -21,7 +21,7 @@ import Type.Row (RLProxy(..))
 class Mapping f a b | f a -> b where
   mapping :: f -> a -> b
 
-class MappingWithIndex f i a b | f a -> b, f -> i where
+class MappingWithIndex f i a b | f i a -> b where
   mappingWithIndex :: f -> i -> a -> b
 
 instance mappingFunction :: Mapping (a -> b) a b where
@@ -35,10 +35,10 @@ instance constMapping ::
   where
   mappingWithIndex (ConstMapping f) _ = mapping f
 
-class HMap f a b | a -> f b where
+class HMap f a b | f a -> b where
   hmap :: f -> a -> b
 
-class HMapWithIndex f a b | a -> f b where
+class HMapWithIndex f a b | f a -> b where
   hmapWithIndex :: f -> a -> b
 
 instance hmapApp ::
@@ -80,7 +80,7 @@ instance hmapWithIndexRecord ::
     Builder.build
       <<< mapRecordWithIndexBuilder (RLProxy :: RLProxy rl)
 
-class MapRecordWithIndex (xs :: RowList) f (as :: # Type) (bs :: # Type) | xs -> f as bs where
+class MapRecordWithIndex (xs :: RowList) f (as :: # Type) (bs :: # Type) | xs f -> bs, xs -> as where
   mapRecordWithIndexBuilder :: RLProxy xs -> f -> Builder { | as } { | bs }
 
 instance mapRecordWithIndexCons ::
@@ -138,7 +138,7 @@ instance hmapWithIndexVariant ::
   hmapWithIndex =
     mapVariantWithIndex (RLProxy :: RLProxy rl)
 
-class MapVariantWithIndex (xs :: RowList) f (as :: # Type) (bs :: # Type) | xs -> f as bs where
+class MapVariantWithIndex (xs :: RowList) f (as :: # Type) (bs :: # Type) | xs f -> bs, xs -> as where
   mapVariantWithIndex :: RLProxy xs -> f -> Variant as -> Variant bs
 
 instance mapVariantWithIndexCons ::
@@ -177,7 +177,7 @@ instance hmapWithIndexVariantF ::
   hmapWithIndex =
     mapVariantFWithIndex (RLProxy :: RLProxy rl)
 
-class MapVariantFWithIndex (xs :: RowList) f (as :: # Type) (bs :: # Type) x y | xs -> f as bs x y where
+class MapVariantFWithIndex (xs :: RowList) f (as :: # Type) (bs :: # Type) x y | xs f x -> as bs y where
   mapVariantFWithIndex :: RLProxy xs -> f -> VariantF as x -> VariantF bs y
 
 instance mapVariantFWithIndexCons ::

test/HList.purs

@@ -89,7 +89,7 @@ showWithIndex :: forall hlist.
   hlist ->
   Array (Tuple Int String)
 showWithIndex =
-  hfoldlWithIndex ShowWithIndex []
+  hfoldlWithIndex ShowWithIndex ([] :: Array (Tuple Int String))
 
 testShow :: _
 testShow =

test/Record.purs

@@ -2,10 +2,12 @@ module Test.Record where
 
 import Prelude
 
+import Data.Bifunctor (lmap)
+import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
 import Data.Symbol (class IsSymbol, SProxy, reflectSymbol)
 import Data.Tuple (Tuple(..))
-import Heterogeneous.Folding (class FoldingWithIndex, class HFoldlWithIndex, hfoldlWithIndex)
+import Heterogeneous.Folding (class Folding, class FoldingWithIndex, class HFoldl, class HFoldlWithIndex, hfoldl, hfoldlWithIndex)
 import Heterogeneous.Mapping (class HMapWithIndex, class Mapping, class MappingWithIndex, hmap, hmapWithIndex, mapping)
 import Prim.Row as Row
 import Record as Record
@@ -129,13 +131,13 @@ instance traverseProp ::
 
 traverseRecord :: forall f k rin rout.
   Applicative f =>
-  HFoldlWithIndex (TraverseProp f k) (f (Builder {} {})) { | rin } (f (Builder {} { | rout})) =>
+  HFoldlWithIndex (TraverseProp f k) (f (Builder {} {})) { | rin } (f (Builder {} { | rout })) =>
   k ->
   { | rin } ->
   f { | rout }
 traverseRecord k =
-  map (flip Builder.build {}) <<<
-    hfoldlWithIndex (TraverseProp k) (pure identity)
+  map (flip Builder.build {})
+    <<< hfoldlWithIndex (TraverseProp k :: TraverseProp f k) (pure identity :: f (Builder {} {}))
 
 test1 :: _
 test1 =
@@ -185,7 +187,8 @@ sequencePropsOf :: forall f rin rout.
   { | rin } ->
   f { | rout }
 sequencePropsOf =
-  map (flip Builder.build {}) <<< hfoldlWithIndex SequencePropOf (pure identity)
+  map (flip Builder.build {})
+    <<< hfoldlWithIndex (SequencePropOf :: SequencePropOf f) (pure identity :: f (Builder {} {}))
 
 test :: Maybe _
 test =
@@ -194,3 +197,117 @@ test =
     , b: Nothing
     , c: 42
     }
+
+-----
+-- Verify that multiple maps can be used in constraints
+
+newtype ReplaceLeft r = ReplaceLeft { | r }
+
+instance replaceLeftH ::
+  (IsSymbol sym, Row.Cons sym a x vals) =>
+  MappingWithIndex (ReplaceLeft vals) (SProxy sym) (Either a b) (Either a b) where
+  mappingWithIndex (ReplaceLeft vals) prop = lmap (const $ Record.get prop vals)
+
+replaceLeft :: forall rvals rin rout.
+  HMapWithIndex (ReplaceLeft rvals) { | rin } { | rout } =>
+  { | rvals } ->
+  { | rin } ->
+  { | rout }
+replaceLeft =
+  hmapWithIndex <<< ReplaceLeft
+
+testReplaceLeft :: _
+testReplaceLeft =
+  { a: "goodbye"
+  , b: 100
+  }
+  `replaceLeft`
+  { a: Left "hello"
+  , b: Right 1
+  }
+
+newtype ReplaceRight r = ReplaceRight { | r }
+
+instance replaceRightH ::
+  (IsSymbol sym, Row.Cons sym b x vals) =>
+  MappingWithIndex (ReplaceRight vals) (SProxy sym) (Either a b) (Either a b) where
+  mappingWithIndex (ReplaceRight vals) prop = map (const $ Record.get prop vals)
+
+replaceRight :: forall rvals rin rout.
+  HMapWithIndex (ReplaceRight rvals) { | rin } { | rout } =>
+  { | rvals } ->
+  { | rin } ->
+  { | rout }
+replaceRight =
+  hmapWithIndex <<< ReplaceRight
+
+testReplaceRight :: _
+testReplaceRight =
+  { a: "goodbye"
+  , b: 100
+  }
+  `replaceRight`
+  { a: Left "hello"
+  , b: Right 1
+  }
+
+testReplaceBoth :: forall rvals r.
+  HMapWithIndex (ReplaceLeft rvals) { | r } { | r } =>
+  HMapWithIndex (ReplaceRight rvals) { | r } { | r } =>
+  { | rvals } ->
+  { | r } ->
+  { | r }
+testReplaceBoth vals =
+  replaceLeft vals >>> replaceRight vals
+
+-----
+-- Verify that multiple folds can be used in constraints.
+
+data CountLeft = CountLeft
+
+instance countLeft :: Folding CountLeft Int (Either a b) Int where
+  folding CountLeft acc (Left _) = acc + 1
+  folding CountLeft acc _ = acc
+
+countLefts :: forall r. HFoldl CountLeft Int { | r } Int => { | r } -> Int
+countLefts = hfoldl CountLeft 0
+
+data CountRight = CountRight
+
+instance countRight :: Folding CountRight Int (Either a b) Int where
+  folding CountRight acc (Right _) = acc + 1
+  folding CountRight acc _ = acc
+
+countRights :: forall r. HFoldl CountRight Int { | r } Int => { | r } -> Int
+countRights = hfoldl CountRight 0
+
+countBoth :: forall r.
+  HFoldl CountLeft Int { | r } Int =>
+  HFoldl CountRight Int { | r } Int =>
+  { | r } ->
+  Int
+countBoth r = countRights r + countLefts r
+
+-----
+-- Verify that multiple folds can be used in constraints.
+
+data ShowValues = ShowValues
+
+instance showValues ::
+  (Show a, IsSymbol sym) =>
+  FoldingWithIndex ShowValues (SProxy sym) String a String
+  where
+  foldingWithIndex _ prop str a = pre <> show a
+    where
+    pre | str == "" = ""
+        | otherwise = str <> ", "
+
+showTwice :: forall r.
+  HFoldlWithIndex ShowProps String { | r } String =>
+  HFoldlWithIndex ShowValues String { | r } String =>
+  { | r } ->
+  String
+showTwice r = do
+  let a = "{ " <> hfoldlWithIndex ShowProps "" r <> " }"
+      b = "[ " <> hfoldlWithIndex ShowValues "" r <> " ]"
+  a <> b