Improve FAlternative classHEADmaster

2 files changed, 7 insertions, 7 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
diff --git a/src/HSVIS/Parser.hs b/src/HSVIS/Parser.hs
index bea0524..0d35184 100644
--- a/src/HSVIS/Parser.hs
+++ b/src/HSVIS/Parser.hs
@@ -135,12 +135,6 @@ instance FAlternative Parser where
 
   noFail (Parser f) = Parser $ \ctx ps kok kfat _ -> f ctx ps kok kfat ()
 
-  toFallible :: forall fail a. KnownFallible fail => Parser fail a -> Parser 'Fallible a
-  toFallible (Parser f) = Parser $ \ctx ps kok kfat kbt ->
-    f ctx ps kok kfat (case knownFallible @fail of
-                         SFallible -> kbt
-                         SInfallible -> ())
-
 instance MonadState PS (Parser fail) where
   state f = Parser $ \_ ps kok _ _ ->
     let (x, ps') = f ps