blob: 1abc535a0b80ace7bac131e4acca400325d61aef (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
{-# LANGUAGE GADTs #-}
module Opt where
import Control.Arrow
import Control.Category
import Prelude hiding (id, (.))
data Opt arr a b where
Lift :: arr a b -> Opt arr a b
First :: Opt arr a b -> Opt arr (a,c) (b,c)
runOpt :: Arrow arr => Opt arr a b -> arr a b
runOpt (Lift f) = f
runOpt (First f) = first (runOpt f)
instance Arrow arr => Category (Opt arr) where
id = Lift id
First f . First g = First (f . g)
f . g = Lift (runOpt f . runOpt g)
instance Arrow arr => Arrow (Opt arr) where
arr = Lift . arr
first = First
|