module Unison.Result where

import Control.Error.Util (note)
import Control.Monad.Except (ExceptT (..))
import Control.Monad.Fail qualified as Fail
import Control.Monad.Morph qualified as Morph
import Control.Monad.Writer (MonadWriter (..), WriterT (..), runWriterT)
import Unison.Name (Name)
import Unison.Names.ResolutionResult qualified as Names
import Unison.Prelude
import Unison.Syntax.Parser qualified as Parser
import Unison.Term (Term)
import Unison.Typechecker.Context qualified as Context

type Result notes = ResultT notes Identity

type ResultT notes f = MaybeT (WriterT notes f)

data Note v loc
  = Parsing (Parser.Err v)
  | NameResolutionFailures [Names.ResolutionFailure loc]
  | UnknownSymbol v loc
  | TypeError (Context.ErrorNote v loc)
  | TypeInfo (Context.InfoNote v loc)
  | CompilerBug (CompilerBug v loc)
  deriving (Int -> Note v loc -> ShowS
[Note v loc] -> ShowS
Note v loc -> String
(Int -> Note v loc -> ShowS)
-> (Note v loc -> String)
-> ([Note v loc] -> ShowS)
-> Show (Note v loc)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v loc.
(Show loc, Var v, Ord loc) =>
Int -> Note v loc -> ShowS
forall v loc. (Show loc, Var v, Ord loc) => [Note v loc] -> ShowS
forall v loc. (Show loc, Var v, Ord loc) => Note v loc -> String
$cshowsPrec :: forall v loc.
(Show loc, Var v, Ord loc) =>
Int -> Note v loc -> ShowS
showsPrec :: Int -> Note v loc -> ShowS
$cshow :: forall v loc. (Show loc, Var v, Ord loc) => Note v loc -> String
show :: Note v loc -> String
$cshowList :: forall v loc. (Show loc, Var v, Ord loc) => [Note v loc] -> ShowS
showList :: [Note v loc] -> ShowS
Show)

data CompilerBug v loc
  = TopLevelComponentNotFound v (Term v loc)
  | ResolvedNameNotFound v loc Name
  | TypecheckerBug (Context.CompilerBug v loc)
  deriving (Int -> CompilerBug v loc -> ShowS
[CompilerBug v loc] -> ShowS
CompilerBug v loc -> String
(Int -> CompilerBug v loc -> ShowS)
-> (CompilerBug v loc -> String)
-> ([CompilerBug v loc] -> ShowS)
-> Show (CompilerBug v loc)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v loc.
(Show loc, Var v, Ord loc) =>
Int -> CompilerBug v loc -> ShowS
forall v loc.
(Show loc, Var v, Ord loc) =>
[CompilerBug v loc] -> ShowS
forall v loc.
(Show loc, Var v, Ord loc) =>
CompilerBug v loc -> String
$cshowsPrec :: forall v loc.
(Show loc, Var v, Ord loc) =>
Int -> CompilerBug v loc -> ShowS
showsPrec :: Int -> CompilerBug v loc -> ShowS
$cshow :: forall v loc.
(Show loc, Var v, Ord loc) =>
CompilerBug v loc -> String
show :: CompilerBug v loc -> String
$cshowList :: forall v loc.
(Show loc, Var v, Ord loc) =>
[CompilerBug v loc] -> ShowS
showList :: [CompilerBug v loc] -> ShowS
Show)

result :: Result notes a -> Maybe a
result :: forall notes a. Result notes a -> Maybe a
result (Result notes
_ Maybe a
may) = Maybe a
may

pattern Result :: w -> Maybe a -> MaybeT (WriterT w Identity) a
pattern $mResult :: forall {r} {w} {a}.
MaybeT (WriterT w Identity) a
-> (w -> Maybe a -> r) -> ((# #) -> r) -> r
$bResult :: forall w a. w -> Maybe a -> MaybeT (WriterT w Identity) a
Result notes may = MaybeT (WriterT (Identity (may, notes)))

{-# COMPLETE Result #-}

makeResult :: (Applicative m) => notes -> Maybe a -> ResultT notes m a
makeResult :: forall (m :: * -> *) notes a.
Applicative m =>
notes -> Maybe a -> ResultT notes m a
makeResult notes
notes Maybe a
value =
  WriterT notes m (Maybe a) -> MaybeT (WriterT notes m) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a, notes) -> WriterT notes m (Maybe a)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT ((Maybe a, notes) -> m (Maybe a, notes)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a
value, notes
notes)))

isSuccess :: (Functor f) => ResultT note f a -> f Bool
isSuccess :: forall (f :: * -> *) note a.
Functor f =>
ResultT note f a -> f Bool
isSuccess = (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool)
-> ((Maybe a, note) -> Maybe a) -> (Maybe a, note) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a, note) -> Maybe a
forall a b. (a, b) -> a
fst ((Maybe a, note) -> Bool) -> f (Maybe a, note) -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (f (Maybe a, note) -> f Bool)
-> (ResultT note f a -> f (Maybe a, note))
-> ResultT note f a
-> f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultT note f a -> f (Maybe a, note)
forall notes (f :: * -> *) a.
ResultT notes f a -> f (Maybe a, notes)
runResultT

isFailure :: (Functor f) => ResultT note f a -> f Bool
isFailure :: forall (f :: * -> *) note a.
Functor f =>
ResultT note f a -> f Bool
isFailure = (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe a -> Bool)
-> ((Maybe a, note) -> Maybe a) -> (Maybe a, note) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a, note) -> Maybe a
forall a b. (a, b) -> a
fst ((Maybe a, note) -> Bool) -> f (Maybe a, note) -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (f (Maybe a, note) -> f Bool)
-> (ResultT note f a -> f (Maybe a, note))
-> ResultT note f a
-> f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultT note f a -> f (Maybe a, note)
forall notes (f :: * -> *) a.
ResultT notes f a -> f (Maybe a, notes)
runResultT

toMaybe :: (Functor f) => ResultT note f a -> f (Maybe a)
toMaybe :: forall (f :: * -> *) note a.
Functor f =>
ResultT note f a -> f (Maybe a)
toMaybe = ((Maybe a, note) -> Maybe a
forall a b. (a, b) -> a
fst ((Maybe a, note) -> Maybe a) -> f (Maybe a, note) -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (f (Maybe a, note) -> f (Maybe a))
-> (ResultT note f a -> f (Maybe a, note))
-> ResultT note f a
-> f (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultT note f a -> f (Maybe a, note)
forall notes (f :: * -> *) a.
ResultT notes f a -> f (Maybe a, notes)
runResultT

runResultT :: ResultT notes f a -> f (Maybe a, notes)
runResultT :: forall notes (f :: * -> *) a.
ResultT notes f a -> f (Maybe a, notes)
runResultT = WriterT notes f (Maybe a) -> f (Maybe a, notes)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT notes f (Maybe a) -> f (Maybe a, notes))
-> (ResultT notes f a -> WriterT notes f (Maybe a))
-> ResultT notes f a
-> f (Maybe a, notes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultT notes f a -> WriterT notes f (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT

-- Returns the `Result` in the `f` functor.
getResult :: (Functor f) => ResultT notes f a -> f (Result notes a)
getResult :: forall (f :: * -> *) notes a.
Functor f =>
ResultT notes f a -> f (Result notes a)
getResult ResultT notes f a
r = (Maybe a -> notes -> Result notes a)
-> (Maybe a, notes) -> Result notes a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((notes -> Maybe a -> Result notes a)
-> Maybe a -> notes -> Result notes a
forall a b c. (a -> b -> c) -> b -> a -> c
flip notes -> Maybe a -> Result notes a
forall w a. w -> Maybe a -> MaybeT (WriterT w Identity) a
Result) ((Maybe a, notes) -> Result notes a)
-> f (Maybe a, notes) -> f (Result notes a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResultT notes f a -> f (Maybe a, notes)
forall notes (f :: * -> *) a.
ResultT notes f a -> f (Maybe a, notes)
runResultT ResultT notes f a
r

toEither :: (Functor f) => ResultT notes f a -> ExceptT notes f a
toEither :: forall (f :: * -> *) notes a.
Functor f =>
ResultT notes f a -> ExceptT notes f a
toEither ResultT notes f a
r = f (Either notes a) -> ExceptT notes f a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT ((Maybe a, notes) -> Either notes a
forall {b} {a}. (Maybe b, a) -> Either a b
go ((Maybe a, notes) -> Either notes a)
-> f (Maybe a, notes) -> f (Either notes a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResultT notes f a -> f (Maybe a, notes)
forall notes (f :: * -> *) a.
ResultT notes f a -> f (Maybe a, notes)
runResultT ResultT notes f a
r)
  where
    go :: (Maybe b, a) -> Either a b
go (Maybe b
may, a
notes) = a -> Maybe b -> Either a b
forall a b. a -> Maybe b -> Either a b
note a
notes Maybe b
may

tell1 :: (Monad f) => note -> ResultT (Seq note) f ()
tell1 :: forall (f :: * -> *) note.
Monad f =>
note -> ResultT (Seq note) f ()
tell1 = Seq note -> MaybeT (WriterT (Seq note) f) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Seq note -> MaybeT (WriterT (Seq note) f) ())
-> (note -> Seq note) -> note -> MaybeT (WriterT (Seq note) f) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. note -> Seq note
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

fromParsing :: (Monad f) => Either (Parser.Err v) a -> ResultT (Seq (Note v loc)) f a
fromParsing :: forall (f :: * -> *) v a loc.
Monad f =>
Either (Err v) a -> ResultT (Seq (Note v loc)) f a
fromParsing (Left Err v
e) = do
  Note v loc -> ResultT (Seq (Note v loc)) f ()
forall (f :: * -> *) note.
Monad f =>
note -> ResultT (Seq note) f ()
tell1 (Note v loc -> ResultT (Seq (Note v loc)) f ())
-> Note v loc -> ResultT (Seq (Note v loc)) f ()
forall a b. (a -> b) -> a -> b
$ Err v -> Note v loc
forall v loc. Err v -> Note v loc
Parsing Err v
e
  String -> ResultT (Seq (Note v loc)) f a
forall a. String -> MaybeT (WriterT (Seq (Note v loc)) f) a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
""
fromParsing (Right a
a) = a -> ResultT (Seq (Note v loc)) f a
forall a. a -> MaybeT (WriterT (Seq (Note v loc)) f) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

tellAndFail :: (Monad f) => note -> ResultT (Seq note) f a
tellAndFail :: forall (f :: * -> *) note a.
Monad f =>
note -> ResultT (Seq note) f a
tellAndFail note
note = note -> ResultT (Seq note) f ()
forall (f :: * -> *) note.
Monad f =>
note -> ResultT (Seq note) f ()
tell1 note
note ResultT (Seq note) f ()
-> MaybeT (WriterT (Seq note) f) a
-> MaybeT (WriterT (Seq note) f) a
forall a b.
MaybeT (WriterT (Seq note) f) a
-> MaybeT (WriterT (Seq note) f) b
-> MaybeT (WriterT (Seq note) f) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> MaybeT (WriterT (Seq note) f) a
forall a. String -> MaybeT (WriterT (Seq note) f) a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
"Elegantly and responsibly"

compilerBug :: (Monad f) => CompilerBug v loc -> ResultT (Seq (Note v loc)) f a
compilerBug :: forall (f :: * -> *) v loc a.
Monad f =>
CompilerBug v loc -> ResultT (Seq (Note v loc)) f a
compilerBug = Note v loc -> ResultT (Seq (Note v loc)) f a
forall (f :: * -> *) note a.
Monad f =>
note -> ResultT (Seq note) f a
tellAndFail (Note v loc -> ResultT (Seq (Note v loc)) f a)
-> (CompilerBug v loc -> Note v loc)
-> CompilerBug v loc
-> ResultT (Seq (Note v loc)) f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerBug v loc -> Note v loc
forall v loc. CompilerBug v loc -> Note v loc
CompilerBug

hoist ::
  (Monad f, Monoid notes) =>
  (forall a. f a -> g a) ->
  ResultT notes f b ->
  ResultT notes g b
hoist :: forall (f :: * -> *) notes (g :: * -> *) b.
(Monad f, Monoid notes) =>
(forall a. f a -> g a) -> ResultT notes f b -> ResultT notes g b
hoist forall a. f a -> g a
morph = (forall a. WriterT notes f a -> WriterT notes g a)
-> MaybeT (WriterT notes f) b -> MaybeT (WriterT notes g) b
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> MaybeT m b -> MaybeT n b
Morph.hoist ((forall a. f a -> g a) -> WriterT notes f a -> WriterT notes g a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> WriterT notes m b -> WriterT notes n b
Morph.hoist f a -> g a
forall a. f a -> g a
morph)