module Web.Willow.Common.Parser.Switch
( SwitchCase ( .. )
, switch
) where
import qualified Control.Applicative as A
import qualified Data.Foldable as D
import qualified Data.Either as E
switch :: A.Alternative m => [SwitchCase test m out] -> test -> m out
switch :: [SwitchCase test m out] -> test -> m out
switch [SwitchCase test m out]
cases test
test = [m out] -> m out
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
D.asum ([m out] -> m out)
-> ([Either (m out) (m out)] -> [m out])
-> [Either (m out) (m out)]
-> m out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (m out) (m out) -> m out)
-> [Either (m out) (m out)] -> [m out]
forall a b. (a -> b) -> [a] -> [b]
map ((m out -> m out)
-> (m out -> m out) -> Either (m out) (m out) -> m out
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either m out -> m out
forall a. a -> a
id m out -> m out
forall a. a -> a
id) ([Either (m out) (m out)] -> m out)
-> [Either (m out) (m out)] -> m out
forall a b. (a -> b) -> a -> b
$
[Either (m out) (m out)]
headRights [Either (m out) (m out)]
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. [a] -> [a] -> [a]
++ Int -> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. Int -> [a] -> [a]
take Int
1 [Either (m out) (m out)]
remaining [Either (m out) (m out)]
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. [a] -> [a] -> [a]
++ (Either (m out) (m out) -> Bool)
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. (a -> Bool) -> [a] -> [a]
filter Either (m out) (m out) -> Bool
forall a b. Either a b -> Bool
E.isRight (Int -> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. Int -> [a] -> [a]
drop Int
1 [Either (m out) (m out)]
remaining)
where ([Either (m out) (m out)]
headRights, [Either (m out) (m out)]
remaining) = (Either (m out) (m out) -> Bool)
-> [Either (m out) (m out)]
-> ([Either (m out) (m out)], [Either (m out) (m out)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Either (m out) (m out) -> Bool
forall a b. Either a b -> Bool
E.isRight ([Either (m out) (m out)]
-> ([Either (m out) (m out)], [Either (m out) (m out)]))
-> [Either (m out) (m out)]
-> ([Either (m out) (m out)], [Either (m out) (m out)])
forall a b. (a -> b) -> a -> b
$ (SwitchCase test m out
-> [Either (m out) (m out)] -> [Either (m out) (m out)])
-> [Either (m out) (m out)]
-> [SwitchCase test m out]
-> [Either (m out) (m out)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SwitchCase test m out
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall (m :: * -> *) out.
SwitchCase test m out
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
switch' [] [SwitchCase test m out]
cases
switch' :: SwitchCase test m out
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
switch' (If test -> Bool
f test -> m out
p) [Either (m out) (m out)]
m
| test -> Bool
f test
test = m out -> Either (m out) (m out)
forall a b. a -> Either a b
Left (test -> m out
p test
test) Either (m out) (m out)
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. a -> [a] -> [a]
: [Either (m out) (m out)]
m
| Bool
otherwise = [Either (m out) (m out)]
m
switch' (If_ test -> Bool
f m out
p) [Either (m out) (m out)]
m
| test -> Bool
f test
test = m out -> Either (m out) (m out)
forall a b. a -> Either a b
Left m out
p Either (m out) (m out)
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. a -> [a] -> [a]
: [Either (m out) (m out)]
m
| Bool
otherwise = [Either (m out) (m out)]
m
switch' (Else test -> m out
p) [Either (m out) (m out)]
m = m out -> Either (m out) (m out)
forall a b. a -> Either a b
Left (test -> m out
p test
test) Either (m out) (m out)
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. a -> [a] -> [a]
: [Either (m out) (m out)]
m
switch' (Else_ m out
p) [Either (m out) (m out)]
m = m out -> Either (m out) (m out)
forall a b. a -> Either a b
Left m out
p Either (m out) (m out)
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. a -> [a] -> [a]
: [Either (m out) (m out)]
m
switch' (When test -> Bool
f test -> m out
p) [Either (m out) (m out)]
m
| test -> Bool
f test
test = m out -> Either (m out) (m out)
forall a b. b -> Either a b
Right (test -> m out
p test
test) Either (m out) (m out)
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. a -> [a] -> [a]
: [Either (m out) (m out)]
m
| Bool
otherwise = [Either (m out) (m out)]
m
switch' (When_ test -> Bool
f m out
p) [Either (m out) (m out)]
m
| test -> Bool
f test
test = m out -> Either (m out) (m out)
forall a b. b -> Either a b
Right m out
p Either (m out) (m out)
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. a -> [a] -> [a]
: [Either (m out) (m out)]
m
| Bool
otherwise = [Either (m out) (m out)]
m
switch' (Always test -> m out
p) [Either (m out) (m out)]
m = m out -> Either (m out) (m out)
forall a b. b -> Either a b
Right (test -> m out
p test
test) Either (m out) (m out)
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. a -> [a] -> [a]
: [Either (m out) (m out)]
m
switch' (Always_ m out
p) [Either (m out) (m out)]
m = m out -> Either (m out) (m out)
forall a b. b -> Either a b
Right m out
p Either (m out) (m out)
-> [Either (m out) (m out)] -> [Either (m out) (m out)]
forall a. a -> [a] -> [a]
: [Either (m out) (m out)]
m
data SwitchCase test m out
= If (test -> Bool) (test -> m out)
| If_ (test -> Bool) (m out)
| Else (test -> m out)
| Else_ (m out)
| When (test -> Bool) (test -> m out)
| When_ (test -> Bool) (m out)
| Always (test -> m out)
| Always_ (m out)