{-# LANGUAGE DeriveFunctor #-}
module Overloaded.Plugin.Rewrite where

import Control.Monad (ap)

import qualified GHC.Compat.All  as GHC

-------------------------------------------------------------------------------
-- Rewrite
-------------------------------------------------------------------------------

data Rewrite a
    = NoRewrite
    | Rewrite a -- TODO: add warnings
    | WithName (GHC.Name -> Rewrite a)
    | Error (GHC.DynFlags -> IO ())
  deriving (a -> Rewrite b -> Rewrite a
(a -> b) -> Rewrite a -> Rewrite b
(forall a b. (a -> b) -> Rewrite a -> Rewrite b)
-> (forall a b. a -> Rewrite b -> Rewrite a) -> Functor Rewrite
forall a b. a -> Rewrite b -> Rewrite a
forall a b. (a -> b) -> Rewrite a -> Rewrite b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Rewrite b -> Rewrite a
$c<$ :: forall a b. a -> Rewrite b -> Rewrite a
fmap :: (a -> b) -> Rewrite a -> Rewrite b
$cfmap :: forall a b. (a -> b) -> Rewrite a -> Rewrite b
Functor)

instance Semigroup (Rewrite a) where
    Rewrite a
NoRewrite <> :: Rewrite a -> Rewrite a -> Rewrite a
<> Rewrite a
x = Rewrite a
x
    Rewrite a
x         <> Rewrite a
_ = Rewrite a
x

instance Monoid (Rewrite a) where
    mempty :: Rewrite a
mempty  = Rewrite a
forall a. Rewrite a
NoRewrite
    mappend :: Rewrite a -> Rewrite a -> Rewrite a
mappend = Rewrite a -> Rewrite a -> Rewrite a
forall a. Semigroup a => a -> a -> a
(<>)

instance Applicative Rewrite where
    pure :: a -> Rewrite a
pure = a -> Rewrite a
forall a. a -> Rewrite a
Rewrite
    <*> :: Rewrite (a -> b) -> Rewrite a -> Rewrite b
(<*>) = Rewrite (a -> b) -> Rewrite a -> Rewrite b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Rewrite where
    return :: a -> Rewrite a
return = a -> Rewrite a
forall a. a -> Rewrite a
Rewrite
    Rewrite a
NoRewrite >>= :: Rewrite a -> (a -> Rewrite b) -> Rewrite b
>>= a -> Rewrite b
_ = Rewrite b
forall a. Rewrite a
NoRewrite
    Rewrite a
a >>= a -> Rewrite b
k = a -> Rewrite b
k a
a
    WithName Name -> Rewrite a
f >>= a -> Rewrite b
k = (Name -> Rewrite b) -> Rewrite b
forall a. (Name -> Rewrite a) -> Rewrite a
WithName (\Name
n -> Name -> Rewrite a
f Name
n Rewrite a -> (a -> Rewrite b) -> Rewrite b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Rewrite b
k)
    Error DynFlags -> IO ()
err >>= a -> Rewrite b
_ = (DynFlags -> IO ()) -> Rewrite b
forall a. (DynFlags -> IO ()) -> Rewrite a
Error DynFlags -> IO ()
err