{-# LANGUAGE MonoLocalBinds #-}

module MonadicBang.Utils where

import Control.Monad.Trans.Maybe
import Data.Monoid
import GHC.Stack (withFrozenCallStack, HasCallStack)

type DList a = Endo [a]

-- | Handle a specific AST node
type Handler m a = a -> m a

-- | Try handling an AST node, but may fail (usually because the handler is not
-- applicable)
type Try m a = Handler (MaybeT m) a

{-# INLINE fromDList #-}
fromDList :: DList a -> [a]
fromDList :: forall a. DList a -> [a]
fromDList = DList a -> [a] -> [a]
forall a. Endo a -> a -> a
appEndo (DList a -> [a] -> [a]) -> [a] -> DList a -> [a]
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? []

{-# INLINE (??) #-}
(??) :: Functor f => f (a -> b) -> a -> f b
f (a -> b)
fs ?? :: forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? a
x = ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) ((a -> b) -> b) -> f (a -> b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a -> b)
fs

-- This is included in transformers 0.6, but that can't be used together with ghc 9.4
{-# INLINE hoistMaybe #-}
hoistMaybe :: Applicative m => Maybe a -> MaybeT m a
hoistMaybe :: forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a)
-> (Maybe a -> m (Maybe a)) -> Maybe a -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

panic :: HasCallStack => String -> a
panic :: forall a. HasCallStack => String -> a
panic String
message = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => a) -> a) -> (HasCallStack => a) -> a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
  [String] -> String
unlines [String
"MonadicBang panic:", String
message, String
"", String
submitReport]
  where
    submitReport :: String
submitReport = String
"This is likely a bug. Please submit a bug report at https://github.com/JakobBruenker/monadic-bang/issues"