{-# LANGUAGE NoImplicitPrelude #-} module Data.Tickle.IsolateError( -- * Data type IsolateError(..) -- * Reduction , isolateError -- * Prisms , _NegativeSize , _IsolateXFail , _UnexpectedConsumed , _Not_NegativeSize , _Not_IsolateXFail , _Not_UnexpectedConsumed ) where import Papa data IsolateError e = NegativeSize | IsolateXFail e | UnexpectedConsumed Int Int deriving (Eq, Ord, Show) -- | -- -- >>> isolateError 7 (\_ -> 8) (\_ _ -> 9) (_NegativeSize # ()) -- 7 -- -- >>> isolateError 7 (+10) (\_ _ -> 9) (_IsolateXFail # 99) -- 109 -- -- >>> isolateError 7 (\_ -> 8) (+) (_UnexpectedConsumed # (12, 14)) -- 26 isolateError :: a -> (e -> a) -> (Int -> Int -> a) -> IsolateError e -> a isolateError n _ _ NegativeSize = n isolateError _ f _ (IsolateXFail e) = f e isolateError _ _ u (UnexpectedConsumed m n) = u m n -- | Map a function on the possible failure. -- -- >>> fmap (+1) (_NegativeSize # () :: IsolateError Int) -- NegativeSize -- -- >>> fmap reverse (_IsolateXFail # "abc") -- IsolateXFail "cba" -- -- >>> fmap (+1) (_UnexpectedConsumed # (7, 8) :: IsolateError Int) -- UnexpectedConsumed 7 8 instance Functor IsolateError where fmap _ NegativeSize = NegativeSize fmap f (IsolateXFail e) = IsolateXFail (f e) fmap _ (UnexpectedConsumed m n) = UnexpectedConsumed m n -- | Duplicate on the possible failure. -- -- >>> extended (isolateError 12 (+10) (*)) (_IsolateXFail # 99) -- IsolateXFail 109 -- -- >>> extended (isolateError 12 (+10) (*)) (_UnexpectedConsumed # (12, 13)) -- UnexpectedConsumed 12 13 -- -- >>> extended (isolateError 12 (+10) (*)) (_NegativeSize # ()) -- NegativeSize instance Extend IsolateError where extended _ NegativeSize = NegativeSize extended f i@(IsolateXFail _) = IsolateXFail (f i) extended _ (UnexpectedConsumed m n) = UnexpectedConsumed m n duplicated NegativeSize = NegativeSize duplicated i@(IsolateXFail _) = IsolateXFail i duplicated (UnexpectedConsumed m n) = UnexpectedConsumed m n -- | -- -- >>> IsolateXFail (+10) <.> IsolateXFail 99 -- IsolateXFail 109 -- -- >>> IsolateXFail (+10) <.> NegativeSize -- NegativeSize -- -- >>> IsolateXFail (+10) <.> UnexpectedConsumed 3 4 -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 <.> UnexpectedConsumed 5 6 -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 <.> NegativeSize -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 <.> IsolateXFail (+10) -- UnexpectedConsumed 3 4 -- -- >>> NegativeSize <.> UnexpectedConsumed 5 6 -- NegativeSize -- -- >>> NegativeSize <.> NegativeSize -- NegativeSize -- -- >>> NegativeSize <.> IsolateXFail (+10) -- NegativeSize instance Apply IsolateError where IsolateXFail f <.> IsolateXFail x = IsolateXFail (f x) IsolateXFail _ <.> NegativeSize = NegativeSize IsolateXFail _ <.> UnexpectedConsumed x y = UnexpectedConsumed x y NegativeSize <.> _ = NegativeSize UnexpectedConsumed x y <.> _ = UnexpectedConsumed x y -- | -- -- >>> IsolateXFail (+10) <*> IsolateXFail 99 -- IsolateXFail 109 -- -- >>> IsolateXFail (+10) <*> NegativeSize -- NegativeSize -- -- >>> IsolateXFail (+10) <*> UnexpectedConsumed 3 4 -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 <*> UnexpectedConsumed 5 6 -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 <*> NegativeSize -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 <*> IsolateXFail (+10) -- UnexpectedConsumed 3 4 -- -- >>> NegativeSize <*> UnexpectedConsumed 5 6 -- NegativeSize -- -- >>> NegativeSize <*> NegativeSize -- NegativeSize -- -- >>> NegativeSize <*> IsolateXFail (+10) -- NegativeSize -- -- >>> pure 5 :: IsolateError Int -- IsolateXFail 5 instance Applicative IsolateError where pure = IsolateXFail (<*>) = (<.>) -- | -- -- >>> IsolateXFail 99 >>- \n -> IsolateXFail (n + 10) -- IsolateXFail 109 -- -- >>> IsolateXFail 99 >>- \_ -> NegativeSize -- NegativeSize -- -- >>> IsolateXFail 99 >>- \_ -> UnexpectedConsumed 3 4 -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 >>- \n -> IsolateXFail (n + 10) -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 >>- \_ -> NegativeSize -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 >>- \_ -> UnexpectedConsumed 5 6 -- UnexpectedConsumed 3 4 -- -- >>> NegativeSize >>- \n -> IsolateXFail (n + 10) -- NegativeSize -- -- >>> NegativeSize >>- \_ -> NegativeSize -- NegativeSize -- -- >>> NegativeSize >>- \_ -> UnexpectedConsumed 3 4 -- NegativeSize instance Bind IsolateError where IsolateXFail x >>- f = f x NegativeSize >>- _ = NegativeSize UnexpectedConsumed x y >>- _ = UnexpectedConsumed x y -- | -- -- >>> IsolateXFail 99 >>= \n -> IsolateXFail (n + 10) -- IsolateXFail 109 -- -- >>> IsolateXFail 99 >>= \_ -> NegativeSize -- NegativeSize -- -- >>> IsolateXFail 99 >>= \_ -> UnexpectedConsumed 3 4 -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 >>= \n -> IsolateXFail (n + 10) -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 >>= \_ -> NegativeSize -- UnexpectedConsumed 3 4 -- -- >>> UnexpectedConsumed 3 4 >>= \_ -> UnexpectedConsumed 5 6 -- UnexpectedConsumed 3 4 -- -- >>> NegativeSize >>= \n -> IsolateXFail (n + 10) -- NegativeSize -- -- >>> NegativeSize >>= \_ -> NegativeSize -- NegativeSize -- -- >>> NegativeSize >>= \_ -> UnexpectedConsumed 3 4 -- NegativeSize -- -- >>> return 5 :: IsolateError Int -- IsolateXFail 5 instance Monad IsolateError where (>>=) = (>>-) return = pure -- | -- -- >>> IsolateXFail 99 IsolateXFail 55 -- IsolateXFail 99 -- -- >>> IsolateXFail 99 NegativeSize -- IsolateXFail 99 -- -- >>> IsolateXFail 99 UnexpectedConsumed 3 4 -- IsolateXFail 99 -- -- >>> UnexpectedConsumed 3 4 IsolateXFail 55 -- IsolateXFail 55 -- -- >>> UnexpectedConsumed 3 4 NegativeSize -- NegativeSize -- -- >>> UnexpectedConsumed 3 4 UnexpectedConsumed 3 4 -- UnexpectedConsumed 3 4 -- -- >>> NegativeSize IsolateXFail 55 -- IsolateXFail 55 -- -- >>> NegativeSize NegativeSize -- NegativeSize -- -- >>> NegativeSize UnexpectedConsumed 3 4 -- UnexpectedConsumed 3 4 instance Alt IsolateError where IsolateXFail x _ = IsolateXFail x _ y = y -- | -- -- >>> IsolateXFail 99 <> IsolateXFail 55 -- IsolateXFail 99 -- -- >>> IsolateXFail 99 <> NegativeSize -- IsolateXFail 99 -- -- >>> IsolateXFail 99 <> UnexpectedConsumed 3 4 -- IsolateXFail 99 -- -- >>> UnexpectedConsumed 3 4 <> IsolateXFail 55 -- IsolateXFail 55 -- -- >>> UnexpectedConsumed 3 4 <> NegativeSize -- NegativeSize -- -- >>> UnexpectedConsumed 3 4 <> UnexpectedConsumed 3 4 -- UnexpectedConsumed 3 4 -- -- >>> NegativeSize <> IsolateXFail 55 -- IsolateXFail 55 -- -- >>> NegativeSize <> NegativeSize -- NegativeSize -- -- >>> NegativeSize <> UnexpectedConsumed 3 4 -- UnexpectedConsumed 3 4 instance Semigroup (IsolateError e) where (<>) = () -- | -- -- >>> _NegativeSize # () -- NegativeSize -- -- >>> (_NegativeSize # ()) ^? _NegativeSize -- Just () -- -- >>> (_IsolateXFail # 8) ^? _NegativeSize -- Nothing -- -- >>> (_UnexpectedConsumed # (12, 13)) ^? _NegativeSize -- Nothing _NegativeSize :: Prism' (IsolateError e) () _NegativeSize = _Not_IsolateXFail . _Nothing -- | -- -- >>> _IsolateXFail # 8 -- IsolateXFail 8 -- -- >>> (_NegativeSize # ()) ^? _IsolateXFail -- Nothing -- -- >>> (_IsolateXFail # 8) ^? _IsolateXFail -- Just 8 -- -- >>> (_UnexpectedConsumed # (12, 13)) ^? _IsolateXFail -- Nothing _IsolateXFail :: Prism (IsolateError e) (IsolateError g) e g _IsolateXFail = _Not_NegativeSize . _Right -- | -- -- >>> _UnexpectedConsumed # (12,13) -- UnexpectedConsumed 12 13 -- -- >>> (_NegativeSize # ()) ^? _UnexpectedConsumed -- Nothing -- -- >>> (_IsolateXFail # 8) ^? _UnexpectedConsumed -- Nothing -- -- >>> (_UnexpectedConsumed # (12, 13)) ^? _UnexpectedConsumed -- Just (12,13) _UnexpectedConsumed :: Prism' (IsolateError e) (Int, Int) _UnexpectedConsumed = _Not_IsolateXFail . _Just -- | -- -- >>> _Not_NegativeSize # Left (8, 9) -- UnexpectedConsumed 8 9 -- -- >>> _Not_NegativeSize # Right 'a' -- IsolateXFail 'a' -- -- >>> (_NegativeSize # ()) ^? _Not_NegativeSize -- Nothing -- -- >>> (_IsolateXFail # 8) ^? _Not_NegativeSize -- Just (Right 8) -- -- >>> (_UnexpectedConsumed # (12, 13)) ^? _Not_NegativeSize -- Just (Left (12,13)) _Not_NegativeSize :: Prism (IsolateError e) (IsolateError g) (Either (Int, Int) e) (Either (Int, Int) g) _Not_NegativeSize = prism (\a -> case a of Right e -> IsolateXFail e Left (l, m) -> UnexpectedConsumed l m) (\x -> case x of IsolateXFail e -> Right (Right e) UnexpectedConsumed d e -> Right (Left (d, e)) NegativeSize -> Left NegativeSize) -- | -- -- >>> _Not_IsolateXFail # Nothing -- NegativeSize -- -- >>> _Not_IsolateXFail # Just (7, 8) -- UnexpectedConsumed 7 8 -- -- >>> (_NegativeSize # ()) ^? _Not_IsolateXFail -- Just Nothing -- -- >>> (_IsolateXFail # 8) ^? _Not_IsolateXFail -- Nothing -- -- >>> (_UnexpectedConsumed # (12, 13)) ^? _Not_IsolateXFail -- Just (Just (12,13)) _Not_IsolateXFail :: Prism' (IsolateError e) (Maybe (Int, Int)) _Not_IsolateXFail = prism' (\a -> case a of Nothing -> NegativeSize Just (l, m) -> UnexpectedConsumed l m) (\x -> case x of IsolateXFail _ -> Nothing UnexpectedConsumed d e -> Just (Just (d, e)) NegativeSize -> Just Nothing) -- | -- -- >>> _Not_UnexpectedConsumed # Nothing -- NegativeSize -- -- >>> _Not_UnexpectedConsumed # Just 99 -- IsolateXFail 99 -- -- >>> (_NegativeSize # ()) ^? _Not_UnexpectedConsumed -- Just Nothing -- -- >>> (_IsolateXFail # 8) ^? _Not_UnexpectedConsumed -- Just (Just 8) -- -- >>> (_UnexpectedConsumed # (12, 13)) ^? _Not_UnexpectedConsumed -- Nothing _Not_UnexpectedConsumed :: Prism (IsolateError e) (IsolateError g) (Maybe e) (Maybe g) _Not_UnexpectedConsumed = prism (\a -> case a of Nothing -> NegativeSize Just e -> IsolateXFail e) (\x -> case x of IsolateXFail e -> Right (Just e) UnexpectedConsumed d e -> Left (UnexpectedConsumed d e) NegativeSize -> Right Nothing)