{- -----------------------------------------------------------------------------
Copyright 2019-2020 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Safe #-}

module Base.TrackedErrors (
  TrackedErrors,
  TrackedErrorsIO,
  TrackedErrorsT,
  asCompilerError,
  asCompilerWarnings,
  fromTrackedErrors,
  getCompilerError,
  getCompilerErrorT,
  getCompilerSuccess,
  getCompilerSuccessT,
  getCompilerWarnings,
  getCompilerWarningsT,
  toTrackedErrors,
  tryTrackedErrorsIO,
) where

import Control.Applicative
import Control.Monad.IO.Class ()
import Control.Monad.Trans
import Data.Foldable
import Data.Functor
import Data.Functor.Identity
import Data.List (intercalate)
import Prelude hiding (concat,foldr)
import System.Exit
import System.IO

#if MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ()
#elif MIN_VERSION_base(4,9,0)
import Control.Monad.Fail
#endif

#if MIN_VERSION_base(4,11,0)
#else
import Data.Semigroup
#endif

import Base.CompilerError
import Base.CompilerMessage


type TrackedErrors = TrackedErrorsT Identity

type TrackedErrorsIO = TrackedErrorsT IO

data TrackedErrorsT m a =
  TrackedErrorsT {
    forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState :: m (TrackedErrorsState a)
  }

getCompilerError :: TrackedErrors a -> CompilerMessage
getCompilerError :: forall a. TrackedErrors a -> CompilerMessage
getCompilerError = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m CompilerMessage
getCompilerErrorT

getCompilerSuccess :: TrackedErrors a -> a
getCompilerSuccess :: forall a. TrackedErrors a -> a
getCompilerSuccess = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => TrackedErrorsT m a -> m a
getCompilerSuccessT

getCompilerWarnings :: TrackedErrors a -> CompilerMessage
getCompilerWarnings :: forall a. TrackedErrors a -> CompilerMessage
getCompilerWarnings = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m CompilerMessage
getCompilerWarningsT

getCompilerErrorT :: Monad m => TrackedErrorsT m a -> m CompilerMessage
getCompilerErrorT :: forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m CompilerMessage
getCompilerErrorT = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. TrackedErrorsState a -> CompilerMessage
cfErrors forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState

getCompilerSuccessT :: Monad m => TrackedErrorsT m a -> m a
getCompilerSuccessT :: forall (m :: * -> *) a. Monad m => TrackedErrorsT m a -> m a
getCompilerSuccessT = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. TrackedErrorsState a -> a
csData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState

getCompilerWarningsT :: Monad m => TrackedErrorsT m a -> m CompilerMessage
getCompilerWarningsT :: forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m CompilerMessage
getCompilerWarningsT = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. TrackedErrorsState a -> CompilerMessage
getWarnings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState

fromTrackedErrors :: Monad m => TrackedErrors a -> TrackedErrorsT m a
fromTrackedErrors :: forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m a
fromTrackedErrors TrackedErrors a
x = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ do
  TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrors a
x
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return TrackedErrorsState a
x'

asCompilerWarnings :: Monad m => TrackedErrors a -> TrackedErrorsT m ()
asCompilerWarnings :: forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m ()
asCompilerWarnings TrackedErrors a
x = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ do
  TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrors a
x
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    case TrackedErrorsState a
x' of
         (CompilerFail CompilerMessage
ws CompilerMessage
es)      -> forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess (CompilerMessage
ws forall a. Semigroup a => a -> a -> a
<> CompilerMessage
es) [] ()
         (CompilerSuccess CompilerMessage
ws [String]
bs a
_) -> forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess CompilerMessage
ws [String]
bs ()

asCompilerError :: Monad m => TrackedErrors a -> TrackedErrorsT m ()
asCompilerError :: forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m ()
asCompilerError TrackedErrors a
x = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ do
  TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrors a
x
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    case TrackedErrorsState a
x' of
         (CompilerSuccess CompilerMessage
ws [String]
bs a
_) -> forall a. [String] -> TrackedErrorsState a -> TrackedErrorsState a
includeBackground [String]
bs forall a b. (a -> b) -> a -> b
$ forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail forall a. Monoid a => a
mempty CompilerMessage
ws
         (CompilerFail CompilerMessage
ws CompilerMessage
es)      -> forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail CompilerMessage
ws CompilerMessage
es

toTrackedErrors :: Monad m => TrackedErrorsT m a -> m (TrackedErrors a)
toTrackedErrors :: forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m (TrackedErrors a)
toTrackedErrors TrackedErrorsT m a
x = do
  TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return TrackedErrorsState a
x'

tryTrackedErrorsIO :: String -> String -> TrackedErrorsIO a -> IO a
tryTrackedErrorsIO :: forall a. String -> String -> TrackedErrorsIO a -> IO a
tryTrackedErrorsIO String
warn String
err TrackedErrorsIO a
x = do
  TrackedErrors a
x' <- forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m (TrackedErrors a)
toTrackedErrors TrackedErrorsIO a
x
  let w :: CompilerMessage
w = forall a. TrackedErrors a -> CompilerMessage
getCompilerWarnings forall a b. (a -> b) -> a -> b
$ TrackedErrors a
x' forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
warn
  let e :: CompilerMessage
e = forall a. TrackedErrors a -> CompilerMessage
getCompilerError    forall a b. (a -> b) -> a -> b
$ TrackedErrors a
x' forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
err
  if forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors a
x'
     then do
       Handle -> String -> IO ()
hPutStr Handle
stderr forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CompilerMessage
w
       Handle -> String -> IO ()
hPutStr Handle
stderr forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CompilerMessage
e
       forall a. IO a
exitFailure
     else do
       Handle -> String -> IO ()
hPutStr Handle
stderr forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CompilerMessage
w
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. TrackedErrors a -> a
getCompilerSuccess TrackedErrors a
x'

data TrackedErrorsState a =
  CompilerFail {
    forall a. TrackedErrorsState a -> CompilerMessage
cfWarnings :: CompilerMessage,
    forall a. TrackedErrorsState a -> CompilerMessage
cfErrors :: CompilerMessage
  } |
  CompilerSuccess {
    forall a. TrackedErrorsState a -> CompilerMessage
csWarnings :: CompilerMessage,
    forall a. TrackedErrorsState a -> [String]
csBackground :: [String],
    forall a. TrackedErrorsState a -> a
csData :: a
  }

instance Show a => Show (TrackedErrorsState a) where
  show :: TrackedErrorsState a -> String
show = forall a. Show a => TrackedErrorsState a -> String
format where
    format :: TrackedErrorsState a -> String
format (CompilerFail CompilerMessage
w CompilerMessage
e) = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ [String]
errors forall a. [a] -> [a] -> [a]
++ [String]
warnings where
      errors :: [String]
errors   = String -> [String] -> [String]
showAs String
"Errors:"   forall a b. (a -> b) -> a -> b
$ String -> [String]
lines forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CompilerMessage
e
      warnings :: [String]
warnings = String -> [String] -> [String]
showAs String
"Warnings:" forall a b. (a -> b) -> a -> b
$ String -> [String]
lines forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CompilerMessage
w
    format (CompilerSuccess CompilerMessage
w [String]
b a
x) = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ [String]
content forall a. [a] -> [a] -> [a]
++ [String]
warnings forall a. [a] -> [a] -> [a]
++ [String]
background where
      content :: [String]
content    = [forall a. Show a => a -> String
show a
x]
      warnings :: [String]
warnings   = String -> [String] -> [String]
showAs String
"Warnings:" forall a b. (a -> b) -> a -> b
$ String -> [String]
lines forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CompilerMessage
w
      background :: [String]
background = String -> [String] -> [String]
showAs String
"Background:" [String]
b
    showAs :: String -> [String] -> [String]
showAs String
m = (String
mforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String
"  " forall a. [a] -> [a] -> [a]
++)

instance Show a => Show (TrackedErrors a) where
  show :: TrackedErrors a -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState

instance (Functor m, Monad m) => Functor (TrackedErrorsT m) where
  fmap :: forall a b. (a -> b) -> TrackedErrorsT m a -> TrackedErrorsT m b
fmap a -> b
f TrackedErrorsT m a
x = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerFail CompilerMessage
w CompilerMessage
e      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail CompilerMessage
w CompilerMessage
e -- Not the same a.
         CompilerSuccess CompilerMessage
w [String]
b a
d -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess CompilerMessage
w [String]
b (a -> b
f a
d)

instance (Applicative m, Monad m) => Applicative (TrackedErrorsT m) where
  pure :: forall a. a -> TrackedErrorsT m a
pure = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess forall a. Monoid a => a
mempty []
  TrackedErrorsT m (a -> b)
f <*> :: forall a b.
TrackedErrorsT m (a -> b)
-> TrackedErrorsT m a -> TrackedErrorsT m b
<*> TrackedErrorsT m a
x = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState (a -> b)
f' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m (a -> b)
f
    TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case (TrackedErrorsState (a -> b)
f',TrackedErrorsState a
x') of
         (CompilerFail CompilerMessage
w CompilerMessage
e,TrackedErrorsState a
_) ->
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail CompilerMessage
w CompilerMessage
e -- Not the same a.
         (TrackedErrorsState (a -> b)
i,CompilerFail CompilerMessage
w CompilerMessage
e) ->
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail (forall a. TrackedErrorsState a -> CompilerMessage
getWarnings TrackedErrorsState (a -> b)
i forall a. Semigroup a => a -> a -> a
<> CompilerMessage
w) ([String] -> CompilerMessage -> CompilerMessage
prefixCompilerMessages (forall a. TrackedErrorsState a -> [String]
getBackground TrackedErrorsState (a -> b)
i) CompilerMessage
e)
         (CompilerSuccess CompilerMessage
w1 [String]
b1 a -> b
f2,CompilerSuccess CompilerMessage
w2 [String]
b2 a
d) ->
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess (CompilerMessage
w1 forall a. Semigroup a => a -> a -> a
<> CompilerMessage
w2) ([String]
b1 forall a. [a] -> [a] -> [a]
++ [String]
b2) (a -> b
f2 a
d)

instance Monad m => Monad (TrackedErrorsT m) where
  TrackedErrorsT m a
x >>= :: forall a b.
TrackedErrorsT m a
-> (a -> TrackedErrorsT m b) -> TrackedErrorsT m b
>>= a -> TrackedErrorsT m b
f = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerFail CompilerMessage
w CompilerMessage
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail CompilerMessage
w CompilerMessage
e -- Not the same a.
         CompilerSuccess CompilerMessage
w [String]
b a
d -> do
           TrackedErrorsState b
d2 <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState forall a b. (a -> b) -> a -> b
$ a -> TrackedErrorsT m b
f a
d
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [String] -> TrackedErrorsState a -> TrackedErrorsState a
includeBackground [String]
b forall a b. (a -> b) -> a -> b
$ forall a.
CompilerMessage -> TrackedErrorsState a -> TrackedErrorsState a
includeWarnings CompilerMessage
w TrackedErrorsState b
d2
  return :: forall a. a -> TrackedErrorsT m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure

#if MIN_VERSION_base(4,9,0)
instance Monad m => MonadFail (TrackedErrorsT m) where
  fail :: forall a. String -> TrackedErrorsT m a
fail = forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM
#endif

instance MonadTrans TrackedErrorsT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> TrackedErrorsT m a
lift = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess forall a. Monoid a => a
mempty [])

instance MonadIO m => MonadIO (TrackedErrorsT m) where
  liftIO :: forall a. IO a -> TrackedErrorsT m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance Monad m => ErrorContextM (TrackedErrorsT m) where
  compilerErrorM :: forall a. String -> TrackedErrorsT m a
compilerErrorM String
e = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ String -> CompilerMessage
compilerMessage String
e
  withContextM :: forall a. TrackedErrorsT m a -> String -> TrackedErrorsT m a
withContextM TrackedErrorsT m a
x String
c = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerFail CompilerMessage
w CompilerMessage
e        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail (String -> CompilerMessage -> CompilerMessage
pushWarningScope String
c CompilerMessage
w) (String -> CompilerMessage -> CompilerMessage
pushErrorScope String
c CompilerMessage
e)
         CompilerSuccess CompilerMessage
w [String]
bs a
x2 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess (String -> CompilerMessage -> CompilerMessage
pushWarningScope String
c CompilerMessage
w) [String]
bs a
x2
  summarizeErrorsM :: forall a. TrackedErrorsT m a -> String -> TrackedErrorsT m a
summarizeErrorsM TrackedErrorsT m a
x String
e2 = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerFail CompilerMessage
w CompilerMessage
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail CompilerMessage
w (String -> CompilerMessage -> CompilerMessage
pushErrorScope String
e2 CompilerMessage
e)
         TrackedErrorsState a
x2 -> forall (m :: * -> *) a. Monad m => a -> m a
return TrackedErrorsState a
x2
  compilerWarningM :: String -> TrackedErrorsT m ()
compilerWarningM String
w = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess (String -> CompilerMessage
compilerMessage String
w) [] ())
  compilerBackgroundM :: String -> TrackedErrorsT m ()
compilerBackgroundM String
b = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess forall a. Monoid a => a
mempty [String
b] ())
  resetBackgroundM :: forall a. TrackedErrorsT m a -> TrackedErrorsT m a
resetBackgroundM TrackedErrorsT m a
x = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerSuccess CompilerMessage
w [String]
_ a
d -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess CompilerMessage
w [] a
d
         TrackedErrorsState a
x2                   -> forall (m :: * -> *) a. Monad m => a -> m a
return TrackedErrorsState a
x2

instance Monad m => CollectErrorsM (TrackedErrorsT m) where
  collectAllM :: forall (f :: * -> *) a.
Foldable f =>
f (TrackedErrorsT m a) -> TrackedErrorsT m [a]
collectAllM = forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Foldable f) =>
([TrackedErrorsState a] -> TrackedErrorsState b)
-> f (TrackedErrorsT m a) -> TrackedErrorsT m b
combineResults (forall {a}.
([CompilerMessage], a, [String], [CompilerMessage])
-> TrackedErrorsState a
select forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Foldable f =>
f (TrackedErrorsState a)
-> ([CompilerMessage], [a], [String], [CompilerMessage])
splitErrorsAndData) where
    select :: ([CompilerMessage], a, [String], [CompilerMessage])
-> TrackedErrorsState a
select ([],a
xs2,[String]
bs,[CompilerMessage]
ws) = forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess ([CompilerMessage] -> CompilerMessage
compilerMessages [CompilerMessage]
ws) [String]
bs a
xs2
    select ([CompilerMessage]
es,a
_,[String]
bs,[CompilerMessage]
ws)   = forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail ([CompilerMessage] -> CompilerMessage
compilerMessages [CompilerMessage]
ws) forall a b. (a -> b) -> a -> b
$ [String] -> CompilerMessage -> CompilerMessage
prefixCompilerMessages [String]
bs forall a b. (a -> b) -> a -> b
$ [CompilerMessage] -> CompilerMessage
compilerMessages [CompilerMessage]
es
  collectAnyM :: forall (f :: * -> *) a.
Foldable f =>
f (TrackedErrorsT m a) -> TrackedErrorsT m [a]
collectAnyM = forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Foldable f) =>
([TrackedErrorsState a] -> TrackedErrorsState b)
-> f (TrackedErrorsT m a) -> TrackedErrorsT m b
combineResults (forall {a} {a}.
(a, a, [String], [CompilerMessage]) -> TrackedErrorsState a
select forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Foldable f =>
f (TrackedErrorsState a)
-> ([CompilerMessage], [a], [String], [CompilerMessage])
splitErrorsAndData) where
    select :: (a, a, [String], [CompilerMessage]) -> TrackedErrorsState a
select (a
_,a
xs2,[String]
bs,[CompilerMessage]
ws) = forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess ([CompilerMessage] -> CompilerMessage
compilerMessages [CompilerMessage]
ws) [String]
bs a
xs2
  collectFirstM :: forall (f :: * -> *) a.
Foldable f =>
f (TrackedErrorsT m a) -> TrackedErrorsT m a
collectFirstM = forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Foldable f) =>
([TrackedErrorsState a] -> TrackedErrorsState b)
-> f (TrackedErrorsT m a) -> TrackedErrorsT m b
combineResults (forall {a}.
([CompilerMessage], [a], [String], [CompilerMessage])
-> TrackedErrorsState a
select forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Foldable f =>
f (TrackedErrorsState a)
-> ([CompilerMessage], [a], [String], [CompilerMessage])
splitErrorsAndData) where
    select :: ([CompilerMessage], [a], [String], [CompilerMessage])
-> TrackedErrorsState a
select ([CompilerMessage]
_,a
x:[a]
_,[String]
bs,[CompilerMessage]
ws) = forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess ([CompilerMessage] -> CompilerMessage
compilerMessages [CompilerMessage]
ws) [String]
bs a
x
    select ([CompilerMessage]
es,[a]
_,[String]
bs,[CompilerMessage]
ws)  = forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail ([CompilerMessage] -> CompilerMessage
compilerMessages [CompilerMessage]
ws) forall a b. (a -> b) -> a -> b
$ [String] -> CompilerMessage -> CompilerMessage
prefixCompilerMessages [String]
bs forall a b. (a -> b) -> a -> b
$ [CompilerMessage] -> CompilerMessage
compilerMessages [CompilerMessage]
es

instance ErrorContextT TrackedErrorsT where
  isCompilerErrorT :: forall (m :: * -> *) a.
(Monad m, ErrorContextM (TrackedErrorsT m)) =>
TrackedErrorsT m a -> m Bool
isCompilerErrorT TrackedErrorsT m a
x = do
    TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerFail CompilerMessage
_ CompilerMessage
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
         TrackedErrorsState a
_                -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  ifElseSuccessT :: forall (m :: * -> *) a.
(Monad m, ErrorContextM (TrackedErrorsT m)) =>
TrackedErrorsT m a -> m () -> m () -> TrackedErrorsT m a
ifElseSuccessT TrackedErrorsT m a
x m ()
success m ()
failure = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerSuccess CompilerMessage
_ [String]
_ a
_ -> m ()
success
         TrackedErrorsState a
_                     -> m ()
failure
    forall (m :: * -> *) a. Monad m => a -> m a
return TrackedErrorsState a
x'

combineResults :: (Monad m, Foldable f) =>
  ([TrackedErrorsState a] -> TrackedErrorsState b) -> f (TrackedErrorsT m a) -> TrackedErrorsT m b
combineResults :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Foldable f) =>
([TrackedErrorsState a] -> TrackedErrorsState b)
-> f (TrackedErrorsT m a) -> TrackedErrorsT m b
combineResults [TrackedErrorsState a] -> TrackedErrorsState b
f = forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TrackedErrorsState a] -> TrackedErrorsState b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) []

getWarnings :: TrackedErrorsState a -> CompilerMessage
getWarnings :: forall a. TrackedErrorsState a -> CompilerMessage
getWarnings (CompilerFail CompilerMessage
w CompilerMessage
_)      = CompilerMessage
w
getWarnings (CompilerSuccess CompilerMessage
w [String]
_ a
_) = CompilerMessage
w

includeWarnings :: CompilerMessage -> TrackedErrorsState a -> TrackedErrorsState a
includeWarnings :: forall a.
CompilerMessage -> TrackedErrorsState a -> TrackedErrorsState a
includeWarnings = forall a.
CompilerMessage -> TrackedErrorsState a -> TrackedErrorsState a
update where
  update :: CompilerMessage -> TrackedErrorsState a -> TrackedErrorsState a
update CompilerMessage
w (CompilerSuccess CompilerMessage
w2 [String]
b a
d) = forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess (CompilerMessage
w forall a. Semigroup a => a -> a -> a
<> CompilerMessage
w2) [String]
b a
d
  update CompilerMessage
w (CompilerFail CompilerMessage
w2 CompilerMessage
e)      = forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail (CompilerMessage
w forall a. Semigroup a => a -> a -> a
<> CompilerMessage
w2) CompilerMessage
e

getBackground :: TrackedErrorsState a -> [String]
getBackground :: forall a. TrackedErrorsState a -> [String]
getBackground (CompilerSuccess CompilerMessage
_ [String]
b a
_) = [String]
b
getBackground TrackedErrorsState a
_                      = []

includeBackground :: [String] -> TrackedErrorsState a -> TrackedErrorsState a
includeBackground :: forall a. [String] -> TrackedErrorsState a -> TrackedErrorsState a
includeBackground [String]
b  (CompilerFail CompilerMessage
w CompilerMessage
e)       = forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail CompilerMessage
w ([String] -> CompilerMessage -> CompilerMessage
prefixCompilerMessages [String]
b CompilerMessage
e)
includeBackground [String]
b1 (CompilerSuccess CompilerMessage
w [String]
b2 a
d) = forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess CompilerMessage
w ([String]
b1 forall a. [a] -> [a] -> [a]
++ [String]
b2) a
d

splitErrorsAndData :: Foldable f => f (TrackedErrorsState a) -> ([CompilerMessage],[a],[String],[CompilerMessage])
splitErrorsAndData :: forall (f :: * -> *) a.
Foldable f =>
f (TrackedErrorsState a)
-> ([CompilerMessage], [a], [String], [CompilerMessage])
splitErrorsAndData = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}.
TrackedErrorsState a
-> ([CompilerMessage], [a], [String], [CompilerMessage])
-> ([CompilerMessage], [a], [String], [CompilerMessage])
partition ([],[],[],[]) where
  partition :: TrackedErrorsState a
-> ([CompilerMessage], [a], [String], [CompilerMessage])
-> ([CompilerMessage], [a], [String], [CompilerMessage])
partition (CompilerFail CompilerMessage
w CompilerMessage
e)      ([CompilerMessage]
es,[a]
ds,[String]
bs,[CompilerMessage]
ws) = (CompilerMessage
eforall a. a -> [a] -> [a]
:[CompilerMessage]
es,[a]
ds,[String]
bs,CompilerMessage
wforall a. a -> [a] -> [a]
:[CompilerMessage]
ws)
  partition (CompilerSuccess CompilerMessage
w [String]
b a
d) ([CompilerMessage]
es,[a]
ds,[String]
bs,[CompilerMessage]
ws) = ([CompilerMessage]
es,a
dforall a. a -> [a] -> [a]
:[a]
ds,[String]
bforall a. [a] -> [a] -> [a]
++[String]
bs,CompilerMessage
wforall a. a -> [a] -> [a]
:[CompilerMessage]
ws)