]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/Expr/Maybe.hs
Adapte hcompta-cli.
[comptalang.git] / cli / Hcompta / Expr / Maybe.hs
1 {-# LANGUAGE DefaultSignatures #-}
2 {-# LANGUAGE NoImplicitPrelude #-}
3 {-# OPTIONS_GHC -fno-warn-tabs #-}
4
5 module Hcompta.Expr.Maybe where
6
7 import Data.Maybe (Maybe(..))
8 import Control.Monad (Monad(..))
9 import Data.Function (($))
10
11 import Hcompta.Expr.Dup
12
13 -- * Class 'Expr_Maybe'
14
15 class Expr_Maybe repr where
16 default may
17 :: Monad repr
18 => repr (Maybe a)
19 -> repr b
20 -> repr ((->) (repr a) (repr b))
21 -> repr b
22 default nothing
23 :: Monad repr
24 => repr (Maybe a)
25 default just
26 :: Monad repr
27 => repr a
28 -> repr (Maybe a)
29
30 may
31 :: repr (Maybe a)
32 -> repr b
33 -> repr ((->) (repr a) (repr b))
34 -> repr b
35 may r_m r_n r_j = do
36 m <- r_m
37 case m of
38 Nothing -> r_n
39 Just x -> do
40 j <- r_j
41 j (return x)
42 nothing :: repr (Maybe a)
43 nothing = return Nothing
44 just :: repr a -> repr (Maybe a)
45 just r_a = do
46 a <- r_a
47 return $ Just a
48
49 instance -- Expr_Maybe Dup
50 ( Expr_Maybe r1
51 , Expr_Maybe r2
52 , Monad r1
53 , Monad r2
54 ) => Expr_Maybe (Dup r1 r2) where
55 may (m1 `Dup` m2) (n1 `Dup` n2) (r1_j `Dup` r2_j) =
56 may m1 n1 (return $ \r1_a -> do
57 j <- r1_j
58 a <- r1_a
59 dup1 $ j $ r1_a `Dup` return a)
60 `Dup`
61 may m2 n2 (return $ \r2_a -> do
62 j <- r2_j
63 a <- r2_a
64 dup2 $ j $ return a `Dup` r2_a)
65 nothing = nothing `Dup` nothing
66 just (a1 `Dup` a2) = just (a1 `Dup` a2)