From 0fea2b960a8325290a42e51933279a80ba7a918a Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Fri, 3 Apr 2020 01:13:58 +0000
Subject: [PATCH] Introduce WeedError

This change is meant to make working with an unspecified 's' type parameter
easier.
---
 src/Mima/Asm/Weed.hs | 34 ++++++++++++++++++++++++++--------
 1 file changed, 26 insertions(+), 8 deletions(-)

diff --git a/src/Mima/Asm/Weed.hs b/src/Mima/Asm/Weed.hs
index 659201b..dcca1c3 100644
--- a/src/Mima/Asm/Weed.hs
+++ b/src/Mima/Asm/Weed.hs
@@ -1,12 +1,14 @@
 module Mima.Asm.Weed
   ( Weed
   , runWeed
+  , transformErrors
   , critical
   , harmless
+  , WeedError(..)
+  , errorWith
   -- * Megaparsec compatibility
   , defaultPosState
-  , errorAt
-  , errorsAt
+  , asParseErrors
   , runWeedBundle
   ) 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
 -- is that I can't easily check if 'es' is 'mempty' with these
 -- 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)) =
   case appEndo es [] of
     (x:xs) -> Left $ x NE.:| xs
     []     -> 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 mempty (Left e)
 
 harmless :: e -> Weed e ()
 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 -}
 
 defaultPosState :: FilePath -> s -> PosState s
@@ -63,11 +81,11 @@ defaultPosState filename input = PosState
   , pstateLinePrefix = ""
   }
 
-errorAt :: (Ord e) => Int -> String -> ParseError s e
-errorAt o errorMsg = errorsAt o [errorMsg]
-
-errorsAt :: (Ord e) => Int -> [String] -> ParseError s e
-errorsAt o = FancyError o . Set.fromList . map ErrorFail
+asParseErrors :: Weed (WeedError Int) a -> Weed (ParseError s e) a
+asParseErrors = transformErrors toParseError
+  where
+    toParseError (WeedError offset msg) =
+      FancyError offset $ Set.singleton $ ErrorFail msg
 
 runWeedBundle :: FilePath -> s -> Weed (ParseError s e) a -> Either (ParseErrorBundle s e) a
 runWeedBundle filename input w = case runWeed w of