diff options
| -rw-r--r-- | src/Control/FAlternative.hs | 8 | ||||
| -rw-r--r-- | src/HSVIS/Parser.hs | 6 |
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 |