Skip to content

Commit 862bde8

Browse files
committed
Merge pull request #10 from purescript/star
Add Star
2 parents d2dac84 + 314a0b5 commit 862bde8

File tree

2 files changed

+54
-0
lines changed

2 files changed

+54
-0
lines changed

docs/Data/Profunctor/Star.md

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
## Module Data.Profunctor.Star
2+
3+
#### `Star`
4+
5+
``` purescript
6+
newtype Star f a b
7+
= Star (a -> f b)
8+
```
9+
10+
`Star` turns a `Functor` into a `Profunctor`.
11+
12+
##### Instances
13+
``` purescript
14+
instance profunctorStar :: (Functor f) => Profunctor (Star f)
15+
instance strongStar :: (Functor f) => Strong (Star f)
16+
instance choiceStar :: (Applicative f) => Choice (Star f)
17+
```
18+
19+
#### `runStar`
20+
21+
``` purescript
22+
runStar :: forall f a b. Star f a b -> a -> f b
23+
```
24+
25+
Unwrap a value of type `Star f a b`.
26+
27+

src/Data/Profunctor/Star.purs

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
module Data.Profunctor.Star where
2+
3+
import Prelude
4+
5+
import Data.Tuple
6+
import Data.Either
7+
import Data.Profunctor
8+
import Data.Profunctor.Strong
9+
import Data.Profunctor.Choice
10+
11+
-- | `Star` turns a `Functor` into a `Profunctor`.
12+
newtype Star f a b = Star (a -> f b)
13+
14+
-- | Unwrap a value of type `Star f a b`.
15+
runStar :: forall f a b. Star f a b -> a -> f b
16+
runStar (Star f) = f
17+
18+
instance profunctorStar :: (Functor f) => Profunctor (Star f) where
19+
dimap f g (Star ft) = Star (f >>> ft >>> map g)
20+
21+
instance strongStar :: (Functor f) => Strong (Star f) where
22+
first (Star f) = Star \(Tuple s x) -> map (`Tuple` x) (f s)
23+
second (Star f) = Star \(Tuple x s) -> map (Tuple x) (f s)
24+
25+
instance choiceStar :: (Applicative f) => Choice (Star f) where
26+
left (Star f) = Star $ either (map Left <<< f) (pure <<< Right)
27+
right (Star f) = Star $ either (pure <<< Left) (map Right <<< f)

0 commit comments

Comments
 (0)