+ Free.hoist

Author: gusty

src/FSharpPlus/Data/Free.fs

@@ -84,9 +84,21 @@ module Free =
             | Roll (x: ^``Functor<Free<'Functor<'T>,'T>>``) -> f (loop f <!> x)
         loop f x
 
-    /// Lift any Functor into a Free structure
+    /// Lift any Functor into a Free structure.
     let inline liftF (x: '``Functor<'T>``) : Free<'``Functor<'T>``,'T> = Roll (Map.Invoke (Pure: 'T -> Free<'``Functor<'T>``,'T>) x : '``Functor<Free<'Functor<'T>,'T>>``)
 
+    /// Lift a natural transformation from functor F to functor G into a natural transformation from Free of F to Free of G.
+    let inline hoist (f: ^``F<Free<'F<'T>, 'T>>`` -> ^``G<Free<'F<'T>, 'T>>``) (x: Free<'``F<'T>``, 'T>) : Free<'``G<'T>``, 'T> =
+        let rec loop f x =
+            if opaqueId false then
+                let _: '``G<Free<'F<'T>, 'T>>`` = Map.Invoke Unchecked.defaultof<Free<'``G<'T>``, 'T> -> Free<'``F<'T>``, 'T>> Unchecked.defaultof<'``G<Free<'G<'T>, 'T>>``>
+                let _: '``G<Free<'G<'T>, 'T>>`` = Map.Invoke Unchecked.defaultof<'T -> Free<'``G<'T>``, 'T>> Unchecked.defaultof<'``G<'T>``>
+                ()
+            match run x with
+            | Pure x -> Pure x
+            | Roll (x: ^``F<Free<'F<'T>, 'T>>``) -> Roll (Map.Invoke (loop f: _ -> _) (f x) : ^``G<Free<'G<'T>, 'T>>``)
+        loop f x
+
 
 type Free<'``functor<'t>``,'t> with
 

tests/FSharpPlus.Tests/Free.fs

@@ -352,3 +352,9 @@ module Lift3 =
             |> Identity.run
 
         areStEqual result ("1", "2", "3")
+
+    [<Test>]
+    let hoistFunction () =
+        let x: Free<Result<int, string>, int> = Pure 4
+        let y = Free.hoist Result.toOption x
+        Assert.IsInstanceOf<Option<Free<option<int>, int>>> (Some y)