Introduce WeedError

This change is meant to make working with an unspecified 's' type parameter
easier.
This commit is contained in:
Joscha 2020-04-03 01:13:58 +00:00
parent f25099d6f3
commit 0fea2b960a

View file

@ -1,12 +1,14 @@
module Mima.Asm.Weed module Mima.Asm.Weed
( Weed ( Weed
, runWeed , runWeed
, transformErrors
, critical , critical
, harmless , harmless
, WeedError(..)
, errorWith
-- * Megaparsec compatibility -- * Megaparsec compatibility
, defaultPosState , defaultPosState
, errorAt , asParseErrors
, errorsAt
, runWeedBundle , runWeedBundle
) where ) where
@ -40,18 +42,34 @@ runWeed :: Weed e a -> Either (NE.NonEmpty e) a
-- keep the Endo trick, the tradeoff isn't worth it. The problem here -- keep the Endo trick, the tradeoff isn't worth it. The problem here
-- is that I can't easily check if 'es' is 'mempty' with these -- is that I can't easily check if 'es' is 'mempty' with these
-- endofunctors. -- endofunctors.
runWeed (Weed es (Left e)) = Left $ NE.fromList $ appEndo es [e] runWeed (Weed es (Left e)) = Left $ e NE.:| appEndo es []
runWeed (Weed es (Right a)) = runWeed (Weed es (Right a)) =
case appEndo es [] of case appEndo es [] of
(x:xs) -> Left $ x NE.:| xs (x:xs) -> Left $ x NE.:| xs
[] -> Right a [] -> Right a
transformErrors :: (e1 -> e2) -> Weed e1 a -> Weed e2 a
transformErrors f (Weed es result) = Weed es' result'
where
es' = Endo $ (++) $ map f $ appEndo es []
result' = case result of
Right a -> Right a
Left e -> Left $ f e
critical :: e -> Weed e a critical :: e -> Weed e a
critical e = Weed mempty (Left e) critical e = Weed mempty (Left e)
harmless :: e -> Weed e () harmless :: e -> Weed e ()
harmless e = Weed (Endo (e:)) (Right ()) harmless e = Weed (Endo (e:)) (Right ())
data WeedError a = WeedError a String
instance Functor WeedError where
fmap f (WeedError a s) = WeedError (f a) s
errorWith :: a -> String -> WeedError a
errorWith = WeedError
{- Megaparsec compatibility -} {- Megaparsec compatibility -}
defaultPosState :: FilePath -> s -> PosState s defaultPosState :: FilePath -> s -> PosState s
@ -63,11 +81,11 @@ defaultPosState filename input = PosState
, pstateLinePrefix = "" , pstateLinePrefix = ""
} }
errorAt :: (Ord e) => Int -> String -> ParseError s e asParseErrors :: Weed (WeedError Int) a -> Weed (ParseError s e) a
errorAt o errorMsg = errorsAt o [errorMsg] asParseErrors = transformErrors toParseError
where
errorsAt :: (Ord e) => Int -> [String] -> ParseError s e toParseError (WeedError offset msg) =
errorsAt o = FancyError o . Set.fromList . map ErrorFail FancyError offset $ Set.singleton $ ErrorFail msg
runWeedBundle :: FilePath -> s -> Weed (ParseError s e) a -> Either (ParseErrorBundle s e) a runWeedBundle :: FilePath -> s -> Weed (ParseError s e) a -> Either (ParseErrorBundle s e) a
runWeedBundle filename input w = case runWeed w of runWeedBundle filename input w = case runWeed w of