aboutsummaryrefslogtreecommitdiff
path: root/src/Control
diff options
context:
space:
mode:
Diffstat (limited to 'src/Control')
-rw-r--r--src/Control/FAlternative.hs8
1 files changed, 7 insertions, 1 deletions
diff --git a/src/Control/FAlternative.hs b/src/Control/FAlternative.hs
index 473b3df..8fd35c3 100644
--- a/src/Control/FAlternative.hs
+++ b/src/Control/FAlternative.hs
@@ -1,6 +1,8 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
module Control.FAlternative where
import Data.List.NonEmpty (NonEmpty(..))
@@ -24,7 +26,11 @@ class (forall fail. Applicative (f fail)) => FAlternative f where
faempty :: f 'Fallible a
(<|>>) :: f 'Fallible a -> f fail a -> f fail a
noFail :: f 'Infallible a -> f fail a
- toFallible :: KnownFallible fail => f fail a -> f 'Fallible a
+
+toFallible :: forall fail f a. (FAlternative f, KnownFallible fail) => f fail a -> f 'Fallible a
+toFallible = case knownFallible @fail of
+ SFallible -> id
+ SInfallible -> noFail
faasum :: FAlternative f => [f 'Fallible a] -> f fail a -> f fail a
faasum l p = foldr (<|>>) p l