module UVMHS.Lib.Errors where

import UVMHS.Core
import UVMHS.Lib.Parser
import UVMHS.Lib.Pretty

oops ∷ (Monad m,MonadReader r m,HasLens r e,MonadError e m) ⇒ m a
oops :: forall (m :: * -> *) r e a.
(Monad m, MonadReader r m, HasLens r e, MonadError e m) =>
m a
oops = e -> m a
forall a. e -> m a
forall {k} e (m :: k -> *) (a :: k). MonadError e m => e -> m a
throw (e -> m a) -> m e -> m a
forall (m :: * -> *) a b. Bind m => (a -> m b) -> m a -> m b
*$ (r ⟢ e) -> m e
forall r'. (r ⟢ r') -> m r'
forall r (m :: * -> *) r'. MonadReader r m => (r ⟢ r') -> m r'
askL r ⟢ e
forall a b. HasLens a b => a ⟢ b
hasLens

data GError = GError
  { GError -> () -> 𝕊
gerrorTyp ∷ () → 𝕊
  , GError -> () -> 𝑃 SrcCxt
gerrorLoc ∷ () → 𝑃 SrcCxt
  , GError -> () -> 𝕊
gerrorMsg ∷ () → 𝕊
  , GError -> () -> Doc
gerrorCxt ∷ () → Doc
  }
makeLenses ''GError

instance Pretty GError where
  pretty :: GError -> Doc
pretty (GError () -> 𝕊
typ () -> 𝑃 SrcCxt
loc () -> 𝕊
msg () -> Doc
cxt) = 𝐼 Doc -> Doc
forall t. ToIter Doc t => t -> Doc
ppVertical (𝐼 Doc -> Doc) -> 𝐼 Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [𝐼 Doc] -> 𝐼 Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat
    [ Doc -> 𝐼 Doc
forall a. a -> 𝐼 a
single𝐼 (Doc -> 𝐼 Doc) -> Doc -> 𝐼 Doc
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppHeader (𝕊 -> Doc) -> 𝕊 -> Doc
forall a b. (a -> b) -> a -> b
$ () -> 𝕊
typ ()
    , (SrcCxt -> Doc) -> 𝐼 SrcCxt -> 𝐼 Doc
forall a b. (a -> b) -> 𝐼 a -> 𝐼 b
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
map SrcCxt -> Doc
forall a. Pretty a => a -> Doc
pretty (𝐼 SrcCxt -> 𝐼 Doc) -> 𝐼 SrcCxt -> 𝐼 Doc
forall a b. (a -> b) -> a -> b
$ 𝑃 SrcCxt -> 𝐼 SrcCxt
forall a t. ToIter a t => t -> 𝐼 a
iter (𝑃 SrcCxt -> 𝐼 SrcCxt) -> 𝑃 SrcCxt -> 𝐼 SrcCxt
forall a b. (a -> b) -> a -> b
$ () -> 𝑃 SrcCxt
loc ()
    , Doc -> 𝐼 Doc
forall a. a -> 𝐼 a
single𝐼 (Doc -> 𝐼 Doc) -> Doc -> 𝐼 Doc
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppErr (𝕊 -> Doc) -> 𝕊 -> Doc
forall a b. (a -> b) -> a -> b
$ () -> 𝕊
msg ()
    , Doc -> 𝐼 Doc
forall a. a -> 𝐼 a
single𝐼 (Doc -> 𝐼 Doc) -> Doc -> 𝐼 Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
forall a. Pretty a => a -> Doc
pretty (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ () -> Doc
cxt ()
    ]

gerror₀ ∷ GError
gerror₀ :: GError
gerror₀ = (() -> 𝕊) -> (() -> 𝑃 SrcCxt) -> (() -> 𝕊) -> (() -> Doc) -> GError
GError (𝕊 -> () -> 𝕊
forall a b. a -> b -> a
const 𝕊
"internal error") () -> 𝑃 SrcCxt
forall a. Null a => a
null (𝕊 -> () -> 𝕊
forall a b. a -> b -> a
const 𝕊
"<unknown cause>") () -> Doc
forall a. Null a => a
null

gerrorFromIO ∷ IOError → GError
gerrorFromIO :: IOError -> GError
gerrorFromIO IOError
e = (() -> 𝕊) -> (() -> 𝑃 SrcCxt) -> (() -> 𝕊) -> (() -> Doc) -> GError
GError (𝕊 -> () -> 𝕊
forall a b. a -> b -> a
const 𝕊
"IO Error") () -> 𝑃 SrcCxt
forall a. Null a => a
null (\ () → IOError -> 𝕊
forall a. Show a => a -> 𝕊
show𝕊 IOError
e) () -> Doc
forall a. Null a => a
null

errSetTyp ∷ (Monad m,MonadReader r m,HasLens r GError) ⇒ (() → 𝕊) → m a → m a
errSetTyp :: forall (m :: * -> *) r a.
(Monad m, MonadReader r m, HasLens r GError) =>
(() -> 𝕊) -> m a -> m a
errSetTyp = (r ⟢ (() -> 𝕊)) -> (() -> 𝕊) -> m a -> m a
forall a r'. (r ⟢ r') -> r' -> m a -> m a
forall r (m :: * -> *) a r'.
MonadReader r m =>
(r ⟢ r') -> r' -> m a -> m a
localL ((r ⟢ (() -> 𝕊)) -> (() -> 𝕊) -> m a -> m a)
-> (r ⟢ (() -> 𝕊)) -> (() -> 𝕊) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ GError ⟢ (() -> 𝕊)
gerrorTypL (GError ⟢ (() -> 𝕊)) -> (r ⟢ GError) -> r ⟢ (() -> 𝕊)
forall b c a. (b ⟢ c) -> (a ⟢ b) -> a ⟢ c
forall {k} (t :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Transitive t =>
t b c -> t a b -> t a c
⊚ r ⟢ GError
forall a b. HasLens a b => a ⟢ b
hasLens

errSetLoc ∷ (Monad m,MonadReader r m,HasLens r GError) ⇒ (() → 𝑃 SrcCxt) → m a → m a
errSetLoc :: forall (m :: * -> *) r a.
(Monad m, MonadReader r m, HasLens r GError) =>
(() -> 𝑃 SrcCxt) -> m a -> m a
errSetLoc = (r ⟢ (() -> 𝑃 SrcCxt)) -> (() -> 𝑃 SrcCxt) -> m a -> m a
forall a r'. (r ⟢ r') -> r' -> m a -> m a
forall r (m :: * -> *) a r'.
MonadReader r m =>
(r ⟢ r') -> r' -> m a -> m a
localL ((r ⟢ (() -> 𝑃 SrcCxt)) -> (() -> 𝑃 SrcCxt) -> m a -> m a)
-> (r ⟢ (() -> 𝑃 SrcCxt)) -> (() -> 𝑃 SrcCxt) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ GError ⟢ (() -> 𝑃 SrcCxt)
gerrorLocL (GError ⟢ (() -> 𝑃 SrcCxt)) -> (r ⟢ GError) -> r ⟢ (() -> 𝑃 SrcCxt)
forall b c a. (b ⟢ c) -> (a ⟢ b) -> a ⟢ c
forall {k} (t :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Transitive t =>
t b c -> t a b -> t a c
⊚ r ⟢ GError
forall a b. HasLens a b => a ⟢ b
hasLens

errSetMsg ∷ (Monad m,MonadReader r m,HasLens r GError) ⇒ (() → 𝕊) → m a → m a
errSetMsg :: forall (m :: * -> *) r a.
(Monad m, MonadReader r m, HasLens r GError) =>
(() -> 𝕊) -> m a -> m a
errSetMsg = (r ⟢ (() -> 𝕊)) -> (() -> 𝕊) -> m a -> m a
forall a r'. (r ⟢ r') -> r' -> m a -> m a
forall r (m :: * -> *) a r'.
MonadReader r m =>
(r ⟢ r') -> r' -> m a -> m a
localL ((r ⟢ (() -> 𝕊)) -> (() -> 𝕊) -> m a -> m a)
-> (r ⟢ (() -> 𝕊)) -> (() -> 𝕊) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ GError ⟢ (() -> 𝕊)
gerrorMsgL (GError ⟢ (() -> 𝕊)) -> (r ⟢ GError) -> r ⟢ (() -> 𝕊)
forall b c a. (b ⟢ c) -> (a ⟢ b) -> a ⟢ c
forall {k} (t :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Transitive t =>
t b c -> t a b -> t a c
⊚ r ⟢ GError
forall a b. HasLens a b => a ⟢ b
hasLens

errSetCxt ∷ (Monad m,MonadReader r m,HasLens r GError) ⇒ (() → Doc) → m a → m a
errSetCxt :: forall (m :: * -> *) r a.
(Monad m, MonadReader r m, HasLens r GError) =>
(() -> Doc) -> m a -> m a
errSetCxt = (r ⟢ (() -> Doc)) -> (() -> Doc) -> m a -> m a
forall a r'. (r ⟢ r') -> r' -> m a -> m a
forall r (m :: * -> *) a r'.
MonadReader r m =>
(r ⟢ r') -> r' -> m a -> m a
localL ((r ⟢ (() -> Doc)) -> (() -> Doc) -> m a -> m a)
-> (r ⟢ (() -> Doc)) -> (() -> Doc) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ GError ⟢ (() -> Doc)
gerrorCxtL (GError ⟢ (() -> Doc)) -> (r ⟢ GError) -> r ⟢ (() -> Doc)
forall b c a. (b ⟢ c) -> (a ⟢ b) -> a ⟢ c
forall {k} (t :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Transitive t =>
t b c -> t a b -> t a c
⊚ r ⟢ GError
forall a b. HasLens a b => a ⟢ b
hasLens

errModCxt ∷ (Monad m,MonadReader r m,HasLens r GError) ⇒ (Doc → Doc) → m a → m a
errModCxt :: forall (m :: * -> *) r a.
(Monad m, MonadReader r m, HasLens r GError) =>
(Doc -> Doc) -> m a -> m a
errModCxt = (r ⟢ (() -> Doc)) -> ((() -> Doc) -> () -> Doc) -> m a -> m a
forall (m :: * -> *) r₁ r₂ a.
(Monad m, MonadReader r₁ m) =>
(r₁ ⟢ r₂) -> (r₂ -> r₂) -> m a -> m a
mapEnvL (GError ⟢ (() -> Doc)
gerrorCxtL (GError ⟢ (() -> Doc)) -> (r ⟢ GError) -> r ⟢ (() -> Doc)
forall b c a. (b ⟢ c) -> (a ⟢ b) -> a ⟢ c
forall {k} (t :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Transitive t =>
t b c -> t a b -> t a c
⊚ r ⟢ GError
forall a b. HasLens a b => a ⟢ b
hasLens) (((() -> Doc) -> () -> Doc) -> m a -> m a)
-> ((Doc -> Doc) -> (() -> Doc) -> () -> Doc)
-> (Doc -> Doc)
-> m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ (Doc -> Doc) -> (() -> Doc) -> () -> Doc
forall a b. (a -> b) -> (() -> a) -> () -> b
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
map

errTyp ∷ (Monad m,MonadReader r m,HasLens r GError) ⇒ m 𝕊
errTyp :: forall (m :: * -> *) r.
(Monad m, MonadReader r m, HasLens r GError) =>
m 𝕊
errTyp = () -> (() -> 𝕊) -> 𝕊
forall a b. a -> (a -> b) -> b
appto () ((() -> 𝕊) -> 𝕊) -> m (() -> 𝕊) -> m 𝕊
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ (r ⟢ (() -> 𝕊)) -> m (() -> 𝕊)
forall r'. (r ⟢ r') -> m r'
forall r (m :: * -> *) r'. MonadReader r m => (r ⟢ r') -> m r'
askL ((r ⟢ (() -> 𝕊)) -> m (() -> 𝕊)) -> (r ⟢ (() -> 𝕊)) -> m (() -> 𝕊)
forall a b. (a -> b) -> a -> b
$ GError ⟢ (() -> 𝕊)
gerrorTypL (GError ⟢ (() -> 𝕊)) -> (r ⟢ GError) -> r ⟢ (() -> 𝕊)
forall b c a. (b ⟢ c) -> (a ⟢ b) -> a ⟢ c
forall {k} (t :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Transitive t =>
t b c -> t a b -> t a c
⊚ r ⟢ GError
forall a b. HasLens a b => a ⟢ b
hasLens

errLoc ∷ (Monad m,MonadReader r m,HasLens r GError) ⇒ m (𝑃 SrcCxt)
errLoc :: forall (m :: * -> *) r.
(Monad m, MonadReader r m, HasLens r GError) =>
m (𝑃 SrcCxt)
errLoc = () -> (() -> 𝑃 SrcCxt) -> 𝑃 SrcCxt
forall a b. a -> (a -> b) -> b
appto () ((() -> 𝑃 SrcCxt) -> 𝑃 SrcCxt)
-> m (() -> 𝑃 SrcCxt) -> m (𝑃 SrcCxt)
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ (r ⟢ (() -> 𝑃 SrcCxt)) -> m (() -> 𝑃 SrcCxt)
forall r'. (r ⟢ r') -> m r'
forall r (m :: * -> *) r'. MonadReader r m => (r ⟢ r') -> m r'
askL ((r ⟢ (() -> 𝑃 SrcCxt)) -> m (() -> 𝑃 SrcCxt))
-> (r ⟢ (() -> 𝑃 SrcCxt)) -> m (() -> 𝑃 SrcCxt)
forall a b. (a -> b) -> a -> b
$ GError ⟢ (() -> 𝑃 SrcCxt)
gerrorLocL (GError ⟢ (() -> 𝑃 SrcCxt)) -> (r ⟢ GError) -> r ⟢ (() -> 𝑃 SrcCxt)
forall b c a. (b ⟢ c) -> (a ⟢ b) -> a ⟢ c
forall {k} (t :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Transitive t =>
t b c -> t a b -> t a c
⊚ r ⟢ GError
forall a b. HasLens a b => a ⟢ b
hasLens

errMsg ∷ (Monad m,MonadReader r m,HasLens r GError) ⇒ m 𝕊
errMsg :: forall (m :: * -> *) r.
(Monad m, MonadReader r m, HasLens r GError) =>
m 𝕊
errMsg = () -> (() -> 𝕊) -> 𝕊
forall a b. a -> (a -> b) -> b
appto () ((() -> 𝕊) -> 𝕊) -> m (() -> 𝕊) -> m 𝕊
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ (r ⟢ (() -> 𝕊)) -> m (() -> 𝕊)
forall r'. (r ⟢ r') -> m r'
forall r (m :: * -> *) r'. MonadReader r m => (r ⟢ r') -> m r'
askL ((r ⟢ (() -> 𝕊)) -> m (() -> 𝕊)) -> (r ⟢ (() -> 𝕊)) -> m (() -> 𝕊)
forall a b. (a -> b) -> a -> b
$ GError ⟢ (() -> 𝕊)
gerrorMsgL (GError ⟢ (() -> 𝕊)) -> (r ⟢ GError) -> r ⟢ (() -> 𝕊)
forall b c a. (b ⟢ c) -> (a ⟢ b) -> a ⟢ c
forall {k} (t :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Transitive t =>
t b c -> t a b -> t a c
⊚ r ⟢ GError
forall a b. HasLens a b => a ⟢ b
hasLens

errCxt ∷ (Monad m,MonadReader r m,HasLens r GError) ⇒ m Doc
errCxt :: forall (m :: * -> *) r.
(Monad m, MonadReader r m, HasLens r GError) =>
m Doc
errCxt = () -> (() -> Doc) -> Doc
forall a b. a -> (a -> b) -> b
appto () ((() -> Doc) -> Doc) -> m (() -> Doc) -> m Doc
forall (t :: * -> *) a b. Functor t => (a -> b) -> t a -> t b
^$ (r ⟢ (() -> Doc)) -> m (() -> Doc)
forall r'. (r ⟢ r') -> m r'
forall r (m :: * -> *) r'. MonadReader r m => (r ⟢ r') -> m r'
askL ((r ⟢ (() -> Doc)) -> m (() -> Doc))
-> (r ⟢ (() -> Doc)) -> m (() -> Doc)
forall a b. (a -> b) -> a -> b
$ GError ⟢ (() -> Doc)
gerrorCxtL (GError ⟢ (() -> Doc)) -> (r ⟢ GError) -> r ⟢ (() -> Doc)
forall b c a. (b ⟢ c) -> (a ⟢ b) -> a ⟢ c
forall {k} (t :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Transitive t =>
t b c -> t a b -> t a c
⊚ r ⟢ GError
forall a b. HasLens a b => a ⟢ b
hasLens