Skip to content

Commit dc99f17

Browse files
gustygusty
committed
Move Const and Compose to own file
1 parent 058fe1f commit dc99f17

File tree

4 files changed

+149
-133
lines changed

4 files changed

+149
-133
lines changed

‎src/FSharpPlus/Data/Compose.fs

+71
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,71 @@
1+
namespace FSharpPlus.Data
2+
3+
open FSharpPlus
4+
open FSharpPlus.Control
5+
6+
7+
#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4
8+
9+
/// Right-to-left composition of functors. The composition of applicative functors is always applicative, but the composition of monads is not always a monad.
10+
[<Struct>]
11+
type Compose<'``functorF<'functorG<'t>>``> = Compose of '``functorF<'functorG<'t>>`` with
12+
13+
// Functor
14+
static member inline Map (Compose (x: '``FunctorF<'FunctorG<'T>>``), f: 'T -> 'U) =
15+
Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``)
16+
17+
/// <summary>Lifts a function into a Composed Applicative Functor. Same as map.
18+
/// To be used in Applicative Style expressions, combined with &lt;*&gt;
19+
/// </summary>
20+
/// <category index="1">Functor</category>
21+
static member inline (<!>) (f: 'T -> 'U, x: '``FunctorF<'FunctorG<'T>>``) =
22+
Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``)
23+
24+
// Applicative
25+
static member inline Return (x: 'T) : Compose<'``ApplicativeF<'ApplicativeG<'T>``> =
26+
Compose (result (result x: '``ApplicativeG<'T>``))
27+
28+
static member inline (<*>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T -> 'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) =
29+
Compose ((((<*>) : '``ApplicativeG<'T -> 'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) <!> f: '``ApplicativeF<'ApplicativeG<'T> -> 'ApplicativeG<'U>`` ) <*> x: '``ApplicativeF<'ApplicativeG<'U>``)
30+
31+
/// <summary>
32+
/// Sequences two composed applicatives left-to-right, discarding the value of the first argument.
33+
/// </summary>
34+
/// <category index="2">Applicative</category>
35+
static member inline ( *>) (x: '``FunctorF<'FunctorG<'T>>``, y: '``FunctorF<'FunctorG<'U>>``) : '``FunctorF<'FunctorG<'U>>`` =
36+
((fun (_: 'T) (k: 'U) -> k) <!> x : '``FunctorF<'FunctorG<'U -> 'U>>``) <*> y
37+
38+
/// <summary>
39+
/// Sequences two composed applicatives left-to-right, discarding the value of the second argument.
40+
/// </summary>
41+
/// <category index="2">Applicative</category>
42+
static member inline (<* ) (x: '``FunctorF<'FunctorG<'U>>``, y: '``FunctorF<'FunctorG<'T>>``): '``FunctorF<'FunctorG<'U>>`` =
43+
((fun (k: 'U) (_: 'T) -> k) <!> x : '``FunctorF<'FunctorG<'T -> 'U>>``) <*> y
44+
45+
static member inline Lift2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) =
46+
Compose (Lift2.Invoke (Lift2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``)
47+
48+
static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) =
49+
Compose (Lift3.Invoke (Lift3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``)
50+
51+
// Alternative
52+
static member inline get_Empty () : Compose<'``AlternativeF<'ApplicativeG<'T>``> = Compose (getEmpty ())
53+
static member inline (<|>) (Compose x, Compose y) : Compose<'``AlternativeF<'ApplicativeG<'T>``> = Compose (x <|> y)
54+
55+
// ZipApplicative
56+
static member inline (<.>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T -> 'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) =
57+
Compose ((((<.>) : '``ApplicativeG<'T -> 'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) <!> f: '``ApplicativeF<'ApplicativeG<'T> -> 'ApplicativeG<'U>`` ) <.> x: '``ApplicativeF<'ApplicativeG<'U>``)
58+
59+
static member inline Map2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) =
60+
Compose (Map2.Invoke (Map2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``)
61+
62+
static member inline Map3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) =
63+
Compose (Map3.Invoke (Map3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``)
64+
65+
66+
/// Basic operations on Compose
67+
[<RequireQualifiedAccess>]
68+
module Compose =
69+
let run (Compose t) = t
70+
71+
#endif

‎src/FSharpPlus/Data/Const.fs

+76
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,76 @@
1+
namespace FSharpPlus.Data
2+
3+
open FSharpPlus
4+
open FSharpPlus.Internals.Prelude
5+
6+
#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4
7+
8+
/// <summary> The Const functor, defined as Const&lt;&#39;T, &#39;U&gt; where &#39;U is a phantom type. Useful for: Lens getters Its applicative instance plays a fundamental role in Lens.
9+
/// <para/> Useful for: Lens getters.
10+
/// <para/> Its applicative instance plays a fundamental role in Lens. </summary>
11+
[<Struct>]
12+
type Const<'t, 'u> = Const of 't with
13+
14+
// Monoid
15+
static member inline get_Zero () = Const (getZero ()) : Const<'T, 'U>
16+
static member inline (+) (Const x: Const<'T, 'U>, Const y: Const<'T, 'U>) : Const<'T, 'U> = Const (plus x y)
17+
18+
/// Basic operations on Const
19+
[<RequireQualifiedAccess>]
20+
module Const =
21+
let run (Const t) = t
22+
let map (_: 'T -> 'U) (Const x: Const<_, 'T>) : Const<'C, 'U> = Const x
23+
let inline apply (Const f: Const<'C, 'T -> 'U>) (Const x: Const<'C, 'T>) : Const<'C, 'U> = Const (plus f x)
24+
25+
type Const<'t, 'u> with
26+
27+
// Functor
28+
static member Map (Const x: Const<_, 'T>, _: 'T -> 'U) : Const<'C, 'U> = Const x
29+
30+
/// <summary>Lifts a function into a Const. Same as map.
31+
/// To be used in Applicative Style expressions, combined with &lt;*&gt;
32+
/// </summary>
33+
/// <category index="1">Functor</category>
34+
static member (<!>) (_: 'T -> 'U, Const x: Const<_, 'T>) : Const<'C, 'U> = Const x
35+
36+
// Applicative
37+
static member inline Return (_: 'U) = Const (getZero ()) : Const<'T, 'U>
38+
static member inline (<*>) (Const f: Const<'C, 'T -> 'U>, Const x: Const<'C, 'T>) : Const<'C, 'U> = Const (plus f x)
39+
40+
/// <summary>
41+
/// Sequences two Consts left-to-right, discarding the value of the first argument.
42+
/// </summary>
43+
/// <category index="2">Applicative</category>
44+
static member inline ( *>) (Const x: Const<'C, 'T>, Const y: Const<'C, 'U>) : Const<'C, 'U> = Const (plus x y)
45+
46+
/// <summary>
47+
/// Sequences two Consts left-to-right, discarding the value of the second argument.
48+
/// </summary>
49+
/// <category index="2">Applicative</category>
50+
static member inline (<* ) (Const x: Const<'C, 'U>, Const y: Const<'C, 'T>) : Const<'C, 'U> = Const (plus x y)
51+
52+
static member inline Lift2 (_: 'T -> 'U -> 'V, Const x: Const<'C, 'T>, Const y: Const<'C, 'U>) : Const<'C, 'V> = Const (plus x y)
53+
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)
54+
55+
// Contravariant
56+
static member Contramap (Const x: Const<'C, 'T>, _: 'U -> 'T) : Const<'C, 'U> = Const x
57+
58+
// Bifunctor
59+
static member Bimap (Const x: Const<'T, 'V>, f: 'T -> 'U, _: 'V -> 'W) : Const<'U, 'W> = Const (f x)
60+
static member First (Const x: Const<'T, 'V>, f: 'T -> 'U) : Const<'U, 'V> = Const (f x)
61+
62+
// Bifoldable
63+
static member BifoldMap (Const x: Const<'T, 'V>, f: 'T -> 'U, _: 'V -> 'W) = f x
64+
static member BifoldBack (Const x: Const<'T, 'V>, f: 'T -> 'U -> 'U, _: 'V -> 'W -> 'W, z: 'U) = f x z
65+
static member Bifold (Const x: Const<'T, 'V>, f: 'U -> 'T -> 'U, _: 'W -> 'V -> 'W, z: 'U) = f z x
66+
67+
// Bitraversable
68+
static member inline Bitraverse (Const x: Const<'T1, 'U1>, f: 'T1 -> '``Functor<'T2>``, g: 'U1 -> '``Functor<'U2>``) : '``Functor<Const<'T2, 'U2>>`` =
69+
let mid x = map (id: 'U2 -> 'U2) x
70+
if opaqueId false then
71+
let (a: '``Functor<'U2>``) = mid (g Unchecked.defaultof<'U1>)
72+
let (_: '``Functor<Const<'T2, 'U2>>``) = map (Unchecked.defaultof<'U2 -> Const<'T2, 'U2>>) a
73+
()
74+
(Const: _ -> Const<'T2, 'U2>) <!> f x
75+
76+
#endif

‎src/FSharpPlus/Data/Monoids.fs

-133
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
11
namespace FSharpPlus.Data
22

33
open FSharpPlus
4-
open FSharpPlus.Internals.Prelude
54

65
#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4
76
/// The dual of a monoid, obtained by swapping the arguments of append.
@@ -40,79 +39,6 @@ type Any = Any of bool with
4039
static member (+) (Any x, Any y) = Any (x || y)
4140

4241

43-
#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4
44-
45-
/// <summary> The Const functor, defined as Const&lt;&#39;T, &#39;U&gt; where &#39;U is a phantom type. Useful for: Lens getters Its applicative instance plays a fundamental role in Lens.
46-
/// <para/> Useful for: Lens getters.
47-
/// <para/> Its applicative instance plays a fundamental role in Lens. </summary>
48-
[<Struct>]
49-
type Const<'t,'u> = Const of 't with
50-
51-
// Monoid
52-
static member inline get_Zero () = Const (getZero ()) : Const<'T,'U>
53-
static member inline (+) (Const x: Const<'T,'U>, Const y: Const<'T,'U>) = Const (plus x y) : Const<'T,'U>
54-
55-
/// Basic operations on Const
56-
[<RequireQualifiedAccess>]
57-
module Const =
58-
let run (Const t) = t
59-
let map (_: 'T -> 'U) (Const x: Const<_, 'T>) : Const<'C, 'U> = Const x
60-
let inline apply (Const f: Const<'C, 'T -> 'U>) (Const x: Const<'C, 'T>) : Const<'C, 'U> = Const (plus f x)
61-
62-
type Const<'t,'u> with
63-
64-
// Functor
65-
static member Map (Const x: Const<_, 'T>, _: 'T->'U) = Const x : Const<'C,'U>
66-
67-
/// <summary>Lifts a function into a Const. Same as map.
68-
/// To be used in Applicative Style expressions, combined with &lt;*&gt;
69-
/// </summary>
70-
/// <category index="1">Functor</category>
71-
static member (<!>) (_: 'T->'U, Const x: Const<_,'T>) : Const<'C, 'U> = Const x
72-
73-
// Applicative
74-
static member inline Return (_: 'U) = Const (getZero ()) : Const<'T,'U>
75-
static member inline (<*>) (Const f: Const<'C,'T->'U>, Const x: Const<'C,'T>) = Const (plus f x) : Const<'C,'U>
76-
77-
/// <summary>
78-
/// Sequences two Consts left-to-right, discarding the value of the first argument.
79-
/// </summary>
80-
/// <category index="2">Applicative</category>
81-
static member inline ( *>) (Const x: Const<'C, 'T>, Const y: Const<'C, 'U>) : Const<'C, 'U> = Const (plus x y)
82-
83-
/// <summary>
84-
/// Sequences two Consts left-to-right, discarding the value of the second argument.
85-
/// </summary>
86-
/// <category index="2">Applicative</category>
87-
static member inline (<* ) (Const x: Const<'C, 'U>, Const y: Const<'C, 'T>) : Const<'C, 'U> = Const (plus x y)
88-
89-
static member inline Lift2 (_: 'T->'U->'V, Const x: Const<'C,'T>, Const y: Const<'C,'U>) = Const (plus x y) : Const<'C,'V>
90-
static member inline Lift3 (_: 'T->'U->'V->'W, Const x: Const<'C,'T>, Const y: Const<'C,'U>, Const z: Const<'C,'V>) = Const (x ++ y ++ z) : Const<'C,'W>
91-
92-
// Contravariant
93-
static member Contramap (Const x: Const<'C,'T>, _: 'U->'T) = Const x : Const<'C,'U>
94-
95-
// Bifunctor
96-
static member Bimap (Const x: Const<'T,'V>, f: 'T->'U, _: 'V->'W) = Const (f x) : Const<'U,'W>
97-
static member First (Const x: Const<'T,'V>, f: 'T->'U) = Const (f x) : Const<'U,'V>
98-
99-
// Bifoldable
100-
static member BifoldMap (Const x: Const<'T,'V>, f: 'T->'U, _: 'V->'W) = f x
101-
static member BifoldBack (Const x: Const<'T,'V>, f: 'T->'U->'U, _: 'V->'W->'W, z: 'U) = f x z
102-
static member Bifold (Const x: Const<'T,'V>, f: 'U->'T->'U, _: 'W->'V->'W, z: 'U) = f z x
103-
104-
// Bitraversable
105-
static member inline Bitraverse (Const x: Const<'T1,'U1>, f: 'T1->'``Functor<'T2>``, g: 'U1->'``Functor<'U2>``) : '``Functor<Const<'T2,'U2>>`` =
106-
let mid x = map (id: 'U2 -> 'U2) x
107-
if opaqueId false then
108-
let (a: '``Functor<'U2>``) = mid (g Unchecked.defaultof<'U1>)
109-
let (_: '``Functor<Const<'T2,'U2>>``) = map (Unchecked.defaultof<'U2 -> Const<'T2,'U2>>) a
110-
()
111-
(Const : _ -> Const<'T2,'U2>) <!> f x
112-
113-
114-
#endif
115-
11642
/// Option<'T> monoid returning the leftmost non-None value.
11743
[<Struct>]
11844
type First<'t> = First of Option<'t> with
@@ -136,63 +62,4 @@ type Mult<'a> = Mult of 'a with
13662
static member inline get_Zero () = Mult one
13763
static member inline (+) (Mult (x: 'n), Mult (y: 'n)) = Mult (x * y)
13864

139-
140-
open FSharpPlus.Control
141-
142-
/// Right-to-left composition of functors. The composition of applicative functors is always applicative, but the composition of monads is not always a monad.
143-
[<Struct>]
144-
type Compose<'``functorF<'functorG<'t>>``> = Compose of '``functorF<'functorG<'t>>`` with
145-
146-
// Functor
147-
static member inline Map (Compose (x: '``FunctorF<'FunctorG<'T>>``), f: 'T->'U) = Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``)
148-
149-
/// <summary>Lifts a function into a Composed Applicative Functor. Same as map.
150-
/// To be used in Applicative Style expressions, combined with &lt;*&gt;
151-
/// </summary>
152-
/// <category index="1">Functor</category>
153-
static member inline (<!>) (f: 'T->'U, x: '``FunctorF<'FunctorG<'T>>``) = Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``)
154-
155-
// Applicative
156-
static member inline Return (x: 'T) = Compose (result (result x: '``ApplicativeG<'T>``)) : Compose<'``ApplicativeF<'ApplicativeG<'T>``>
157-
158-
static member inline (<*>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T->'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) =
159-
Compose ((((<*>) : '``ApplicativeG<'T->'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) <!> f: '``ApplicativeF<'ApplicativeG<'T>->'ApplicativeG<'U>`` ) <*> x: '``ApplicativeF<'ApplicativeG<'U>``)
160-
161-
/// <summary>
162-
/// Sequences two composed applicatives left-to-right, discarding the value of the first argument.
163-
/// </summary>
164-
/// <category index="2">Applicative</category>
165-
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
166-
167-
/// <summary>
168-
/// Sequences two composed applicatives left-to-right, discarding the value of the second argument.
169-
/// </summary>
170-
/// <category index="2">Applicative</category>
171-
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
172-
173-
static member inline Lift2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) =
174-
Compose (Lift2.Invoke (Lift2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``)
175-
176-
static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) =
177-
Compose (Lift3.Invoke (Lift3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``)
178-
179-
// Alternative
180-
static member inline get_Empty () = Compose (getEmpty ()) : Compose<'``AlternativeF<'ApplicativeG<'T>``>
181-
static member inline (<|>) (Compose x, Compose y) = Compose (x <|> y) : Compose<'``AlternativeF<'ApplicativeG<'T>``>
182-
183-
// ZipApplicative
184-
static member inline (<.>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T->'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) =
185-
Compose ((((<.>) : '``ApplicativeG<'T->'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) <!> f: '``ApplicativeF<'ApplicativeG<'T>->'ApplicativeG<'U>`` ) <.> x: '``ApplicativeF<'ApplicativeG<'U>``)
186-
187-
static member inline Map2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) =
188-
Compose (Map2.Invoke (Map2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``)
189-
190-
static member inline Map3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) =
191-
Compose (Map3.Invoke (Map3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``)
192-
193-
/// Basic operations on Compose
194-
[<RequireQualifiedAccess>]
195-
module Compose =
196-
let run (Compose t) = t
197-
19865
#endif

‎src/FSharpPlus/FSharpPlus.fsproj

+2
Original file line numberDiff line numberDiff line change
@@ -96,6 +96,8 @@
9696
<Compile Include="Data/Reader.fs" />
9797
<Compile Include="Data/Writer.fs" />
9898
<Compile Include="Data/State.fs" />
99+
<Compile Include="Data/Const.fs" />
100+
<Compile Include="Data/Compose.fs" />
99101
<Compile Include="Data/Monoids.fs" />
100102
<Compile Include="Data/MultiMap.fs" />
101103
<Compile Include="Lens.fs" />

0 commit comments

Comments
 (0)