-
Notifications
You must be signed in to change notification settings - Fork 96
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
4 changed files
with
149 additions
and
133 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,71 @@ | ||
namespace FSharpPlus.Data | ||
|
||
open FSharpPlus | ||
open FSharpPlus.Control | ||
|
||
|
||
#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 | ||
|
||
/// Right-to-left composition of functors. The composition of applicative functors is always applicative, but the composition of monads is not always a monad. | ||
[<Struct>] | ||
type Compose<'``functorF<'functorG<'t>>``> = Compose of '``functorF<'functorG<'t>>`` with | ||
|
||
// Functor | ||
static member inline Map (Compose (x: '``FunctorF<'FunctorG<'T>>``), f: 'T -> 'U) = | ||
Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``) | ||
|
||
/// <summary>Lifts a function into a Composed Applicative Functor. Same as map. | ||
/// To be used in Applicative Style expressions, combined with <*> | ||
/// </summary> | ||
/// <category index="1">Functor</category> | ||
static member inline (<!>) (f: 'T -> 'U, x: '``FunctorF<'FunctorG<'T>>``) = | ||
Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``) | ||
|
||
// Applicative | ||
static member inline Return (x: 'T) : Compose<'``ApplicativeF<'ApplicativeG<'T>``> = | ||
Compose (result (result x: '``ApplicativeG<'T>``)) | ||
|
||
static member inline (<*>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T -> 'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) = | ||
Compose ((((<*>) : '``ApplicativeG<'T -> 'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) <!> f: '``ApplicativeF<'ApplicativeG<'T> -> 'ApplicativeG<'U>`` ) <*> x: '``ApplicativeF<'ApplicativeG<'U>``) | ||
|
||
/// <summary> | ||
/// Sequences two composed applicatives left-to-right, discarding the value of the first argument. | ||
/// </summary> | ||
/// <category index="2">Applicative</category> | ||
static member inline ( *>) (x: '``FunctorF<'FunctorG<'T>>``, y: '``FunctorF<'FunctorG<'U>>``) : '``FunctorF<'FunctorG<'U>>`` = | ||
((fun (_: 'T) (k: 'U) -> k) <!> x : '``FunctorF<'FunctorG<'U -> 'U>>``) <*> y | ||
|
||
/// <summary> | ||
/// Sequences two composed applicatives left-to-right, discarding the value of the second argument. | ||
/// </summary> | ||
/// <category index="2">Applicative</category> | ||
static member inline (<* ) (x: '``FunctorF<'FunctorG<'U>>``, y: '``FunctorF<'FunctorG<'T>>``): '``FunctorF<'FunctorG<'U>>`` = | ||
((fun (k: 'U) (_: 'T) -> k) <!> x : '``FunctorF<'FunctorG<'T -> 'U>>``) <*> y | ||
|
||
static member inline Lift2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) = | ||
Compose (Lift2.Invoke (Lift2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``) | ||
|
||
static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) = | ||
Compose (Lift3.Invoke (Lift3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``) | ||
|
||
// Alternative | ||
static member inline get_Empty () : Compose<'``AlternativeF<'ApplicativeG<'T>``> = Compose (getEmpty ()) | ||
static member inline (<|>) (Compose x, Compose y) : Compose<'``AlternativeF<'ApplicativeG<'T>``> = Compose (x <|> y) | ||
|
||
// ZipApplicative | ||
static member inline (<.>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T -> 'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) = | ||
Compose ((((<.>) : '``ApplicativeG<'T -> 'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) <!> f: '``ApplicativeF<'ApplicativeG<'T> -> 'ApplicativeG<'U>`` ) <.> x: '``ApplicativeF<'ApplicativeG<'U>``) | ||
|
||
static member inline Map2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) = | ||
Compose (Map2.Invoke (Map2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``) | ||
|
||
static member inline Map3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) = | ||
Compose (Map3.Invoke (Map3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``) | ||
|
||
|
||
/// Basic operations on Compose | ||
[<RequireQualifiedAccess>] | ||
module Compose = | ||
let run (Compose t) = t | ||
|
||
#endif |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,76 @@ | ||
namespace FSharpPlus.Data | ||
|
||
open FSharpPlus | ||
open FSharpPlus.Internals.Prelude | ||
|
||
#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4 | ||
|
||
/// <summary> The Const functor, defined as Const<'T, 'U> where 'U is a phantom type. Useful for: Lens getters Its applicative instance plays a fundamental role in Lens. | ||
/// <para/> Useful for: Lens getters. | ||
/// <para/> Its applicative instance plays a fundamental role in Lens. </summary> | ||
[<Struct>] | ||
type Const<'t, 'u> = Const of 't with | ||
|
||
// Monoid | ||
static member inline get_Zero () = Const (getZero ()) : Const<'T, 'U> | ||
static member inline (+) (Const x: Const<'T, 'U>, Const y: Const<'T, 'U>) : Const<'T, 'U> = Const (plus x y) | ||
|
||
/// Basic operations on Const | ||
[<RequireQualifiedAccess>] | ||
module Const = | ||
let run (Const t) = t | ||
let map (_: 'T -> 'U) (Const x: Const<_, 'T>) : Const<'C, 'U> = Const x | ||
let inline apply (Const f: Const<'C, 'T -> 'U>) (Const x: Const<'C, 'T>) : Const<'C, 'U> = Const (plus f x) | ||
|
||
type Const<'t, 'u> with | ||
|
||
// Functor | ||
static member Map (Const x: Const<_, 'T>, _: 'T -> 'U) : Const<'C, 'U> = Const x | ||
|
||
/// <summary>Lifts a function into a Const. Same as map. | ||
/// To be used in Applicative Style expressions, combined with <*> | ||
/// </summary> | ||
/// <category index="1">Functor</category> | ||
static member (<!>) (_: 'T -> 'U, Const x: Const<_, 'T>) : Const<'C, 'U> = Const x | ||
|
||
// Applicative | ||
static member inline Return (_: 'U) = Const (getZero ()) : Const<'T, 'U> | ||
static member inline (<*>) (Const f: Const<'C, 'T -> 'U>, Const x: Const<'C, 'T>) : Const<'C, 'U> = Const (plus f x) | ||
|
||
/// <summary> | ||
/// Sequences two Consts left-to-right, discarding the value of the first argument. | ||
/// </summary> | ||
/// <category index="2">Applicative</category> | ||
static member inline ( *>) (Const x: Const<'C, 'T>, Const y: Const<'C, 'U>) : Const<'C, 'U> = Const (plus x y) | ||
|
||
/// <summary> | ||
/// Sequences two Consts left-to-right, discarding the value of the second argument. | ||
/// </summary> | ||
/// <category index="2">Applicative</category> | ||
static member inline (<* ) (Const x: Const<'C, 'U>, Const y: Const<'C, 'T>) : Const<'C, 'U> = Const (plus x y) | ||
|
||
static member inline Lift2 (_: 'T -> 'U -> 'V, Const x: Const<'C, 'T>, Const y: Const<'C, 'U>) : Const<'C, 'V> = Const (plus x y) | ||
static member inline Lift3 (_: 'T -> 'U -> 'V -> 'W, Const x: Const<'C, 'T>, Const y: Const<'C, 'U>, Const z: Const<'C, 'V>) : Const<'C, 'W> = Const (x ++ y ++ z) | ||
|
||
// Contravariant | ||
static member Contramap (Const x: Const<'C, 'T>, _: 'U -> 'T) : Const<'C, 'U> = Const x | ||
|
||
// Bifunctor | ||
static member Bimap (Const x: Const<'T, 'V>, f: 'T -> 'U, _: 'V -> 'W) : Const<'U, 'W> = Const (f x) | ||
static member First (Const x: Const<'T, 'V>, f: 'T -> 'U) : Const<'U, 'V> = Const (f x) | ||
|
||
// Bifoldable | ||
static member BifoldMap (Const x: Const<'T, 'V>, f: 'T -> 'U, _: 'V -> 'W) = f x | ||
static member BifoldBack (Const x: Const<'T, 'V>, f: 'T -> 'U -> 'U, _: 'V -> 'W -> 'W, z: 'U) = f x z | ||
static member Bifold (Const x: Const<'T, 'V>, f: 'U -> 'T -> 'U, _: 'W -> 'V -> 'W, z: 'U) = f z x | ||
|
||
// Bitraversable | ||
static member inline Bitraverse (Const x: Const<'T1, 'U1>, f: 'T1 -> '``Functor<'T2>``, g: 'U1 -> '``Functor<'U2>``) : '``Functor<Const<'T2, 'U2>>`` = | ||
let mid x = map (id: 'U2 -> 'U2) x | ||
if opaqueId false then | ||
let (a: '``Functor<'U2>``) = mid (g Unchecked.defaultof<'U1>) | ||
let (_: '``Functor<Const<'T2, 'U2>>``) = map (Unchecked.defaultof<'U2 -> Const<'T2, 'U2>>) a | ||
() | ||
(Const: _ -> Const<'T2, 'U2>) <!> f x | ||
|
||
#endif |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters