Introduce WeedError
This change is meant to make working with an unspecified 's' type parameter easier.
This commit is contained in:
parent
f25099d6f3
commit
0fea2b960a
1 changed files with 26 additions and 8 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue