{- -----------------------------------------------------------------------------
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 = Identity CompilerMessage -> CompilerMessage
forall a. Identity a -> a
runIdentity (Identity CompilerMessage -> CompilerMessage)
-> (TrackedErrors a -> Identity CompilerMessage)
-> TrackedErrors a
-> CompilerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackedErrors a -> Identity CompilerMessage
forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m CompilerMessage
getCompilerErrorT

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

getCompilerWarnings :: TrackedErrors a -> CompilerMessage
getCompilerWarnings :: forall a. TrackedErrors a -> CompilerMessage
getCompilerWarnings = Identity CompilerMessage -> CompilerMessage
forall a. Identity a -> a
runIdentity (Identity CompilerMessage -> CompilerMessage)
-> (TrackedErrors a -> Identity CompilerMessage)
-> TrackedErrors a
-> CompilerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackedErrors a -> Identity CompilerMessage
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 = (TrackedErrorsState a -> CompilerMessage)
-> m (TrackedErrorsState a) -> m CompilerMessage
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TrackedErrorsState a -> CompilerMessage
forall a. TrackedErrorsState a -> CompilerMessage
cfErrors (m (TrackedErrorsState a) -> m CompilerMessage)
-> (TrackedErrorsT m a -> m (TrackedErrorsState a))
-> TrackedErrorsT m a
-> m CompilerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackedErrorsT m a -> m (TrackedErrorsState a)
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 = (TrackedErrorsState a -> a) -> m (TrackedErrorsState a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TrackedErrorsState a -> a
forall a. TrackedErrorsState a -> a
csData (m (TrackedErrorsState a) -> m a)
-> (TrackedErrorsT m a -> m (TrackedErrorsState a))
-> TrackedErrorsT m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackedErrorsT m a -> m (TrackedErrorsState a)
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 = (TrackedErrorsState a -> CompilerMessage)
-> m (TrackedErrorsState a) -> m CompilerMessage
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TrackedErrorsState a -> CompilerMessage
forall a. TrackedErrorsState a -> CompilerMessage
getWarnings (m (TrackedErrorsState a) -> m CompilerMessage)
-> (TrackedErrorsT m a -> m (TrackedErrorsState a))
-> TrackedErrorsT m a
-> m CompilerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackedErrorsT m a -> m (TrackedErrorsState a)
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 = Identity (TrackedErrorsT m a) -> TrackedErrorsT m a
forall a. Identity a -> a
runIdentity (Identity (TrackedErrorsT m a) -> TrackedErrorsT m a)
-> Identity (TrackedErrorsT m a) -> TrackedErrorsT m a
forall a b. (a -> b) -> a -> b
$ do
  TrackedErrorsState a
x' <- TrackedErrors a -> Identity (TrackedErrorsState a)
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrors a
x
  TrackedErrorsT m a -> Identity (TrackedErrorsT m a)
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsT m a -> Identity (TrackedErrorsT m a))
-> TrackedErrorsT m a -> Identity (TrackedErrorsT m a)
forall a b. (a -> b) -> a -> b
$ m (TrackedErrorsState a) -> TrackedErrorsT m a
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState a) -> TrackedErrorsT m a)
-> m (TrackedErrorsState a) -> TrackedErrorsT m a
forall a b. (a -> b) -> a -> b
$ TrackedErrorsState a -> m (TrackedErrorsState a)
forall a. a -> m a
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 = Identity (TrackedErrorsT m ()) -> TrackedErrorsT m ()
forall a. Identity a -> a
runIdentity (Identity (TrackedErrorsT m ()) -> TrackedErrorsT m ())
-> Identity (TrackedErrorsT m ()) -> TrackedErrorsT m ()
forall a b. (a -> b) -> a -> b
$ do
  TrackedErrorsState a
x' <- TrackedErrors a -> Identity (TrackedErrorsState a)
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrors a
x
  TrackedErrorsT m () -> Identity (TrackedErrorsT m ())
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsT m () -> Identity (TrackedErrorsT m ()))
-> TrackedErrorsT m () -> Identity (TrackedErrorsT m ())
forall a b. (a -> b) -> a -> b
$ m (TrackedErrorsState ()) -> TrackedErrorsT m ()
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState ()) -> TrackedErrorsT m ())
-> m (TrackedErrorsState ()) -> TrackedErrorsT m ()
forall a b. (a -> b) -> a -> b
$ TrackedErrorsState () -> m (TrackedErrorsState ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState () -> m (TrackedErrorsState ()))
-> TrackedErrorsState () -> m (TrackedErrorsState ())
forall a b. (a -> b) -> a -> b
$
    case TrackedErrorsState a
x' of
         (CompilerFail CompilerMessage
ws CompilerMessage
es)      -> CompilerMessage -> [String] -> () -> TrackedErrorsState ()
forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess (CompilerMessage
ws CompilerMessage -> CompilerMessage -> CompilerMessage
forall a. Semigroup a => a -> a -> a
<> CompilerMessage
es) [] ()
         (CompilerSuccess CompilerMessage
ws [String]
bs a
_) -> CompilerMessage -> [String] -> () -> TrackedErrorsState ()
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 = Identity (TrackedErrorsT m ()) -> TrackedErrorsT m ()
forall a. Identity a -> a
runIdentity (Identity (TrackedErrorsT m ()) -> TrackedErrorsT m ())
-> Identity (TrackedErrorsT m ()) -> TrackedErrorsT m ()
forall a b. (a -> b) -> a -> b
$ do
  TrackedErrorsState a
x' <- TrackedErrors a -> Identity (TrackedErrorsState a)
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrors a
x
  TrackedErrorsT m () -> Identity (TrackedErrorsT m ())
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsT m () -> Identity (TrackedErrorsT m ()))
-> TrackedErrorsT m () -> Identity (TrackedErrorsT m ())
forall a b. (a -> b) -> a -> b
$ m (TrackedErrorsState ()) -> TrackedErrorsT m ()
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState ()) -> TrackedErrorsT m ())
-> m (TrackedErrorsState ()) -> TrackedErrorsT m ()
forall a b. (a -> b) -> a -> b
$ TrackedErrorsState () -> m (TrackedErrorsState ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState () -> m (TrackedErrorsState ()))
-> TrackedErrorsState () -> m (TrackedErrorsState ())
forall a b. (a -> b) -> a -> b
$
    case TrackedErrorsState a
x' of
         (CompilerSuccess CompilerMessage
ws [String]
bs a
_) -> [String] -> TrackedErrorsState () -> TrackedErrorsState ()
forall a. [String] -> TrackedErrorsState a -> TrackedErrorsState a
includeBackground [String]
bs (TrackedErrorsState () -> TrackedErrorsState ())
-> TrackedErrorsState () -> TrackedErrorsState ()
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> CompilerMessage -> TrackedErrorsState ()
forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail CompilerMessage
forall a. Monoid a => a
mempty CompilerMessage
ws
         (CompilerFail CompilerMessage
ws CompilerMessage
es)      -> CompilerMessage -> CompilerMessage -> TrackedErrorsState ()
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' <- TrackedErrorsT m a -> m (TrackedErrorsState a)
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
  TrackedErrors a -> m (TrackedErrors a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors a -> m (TrackedErrors a))
-> TrackedErrors a -> m (TrackedErrors a)
forall a b. (a -> b) -> a -> b
$ Identity (TrackedErrorsState a) -> TrackedErrors a
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (Identity (TrackedErrorsState a) -> TrackedErrors a)
-> Identity (TrackedErrorsState a) -> TrackedErrors a
forall a b. (a -> b) -> a -> b
$ TrackedErrorsState a -> Identity (TrackedErrorsState a)
forall a. a -> Identity a
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' <- TrackedErrorsIO a -> IO (TrackedErrors a)
forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m (TrackedErrors a)
toTrackedErrors TrackedErrorsIO a
x
  let w :: CompilerMessage
w = TrackedErrors a -> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerWarnings (TrackedErrors a -> CompilerMessage)
-> TrackedErrors a -> CompilerMessage
forall a b. (a -> b) -> a -> b
$ TrackedErrors a
x' TrackedErrors a -> String -> TrackedErrors a
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
warn
  let e :: CompilerMessage
e = TrackedErrors a -> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerError    (TrackedErrors a -> CompilerMessage)
-> TrackedErrors a -> CompilerMessage
forall a b. (a -> b) -> a -> b
$ TrackedErrors a
x' TrackedErrors a -> String -> TrackedErrors a
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<?? String
err
  if TrackedErrors a -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors a
x'
     then do
       Handle -> String -> IO ()
hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> String
forall a. Show a => a -> String
show CompilerMessage
w
       Handle -> String -> IO ()
hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> String
forall a. Show a => a -> String
show CompilerMessage
e
       IO a
forall a. IO a
exitFailure
     else do
       Handle -> String -> IO ()
hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> String
forall a. Show a => a -> String
show CompilerMessage
w
       a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ TrackedErrors a -> a
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 = TrackedErrorsState a -> String
forall a. Show a => TrackedErrorsState a -> String
format where
    format :: TrackedErrorsState a -> String
format (CompilerFail CompilerMessage
w CompilerMessage
e) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
errors [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
warnings where
      errors :: [String]
errors   = String -> [String] -> [String]
showAs String
"Errors:"   ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> String
forall a. Show a => a -> String
show CompilerMessage
e
      warnings :: [String]
warnings = String -> [String] -> [String]
showAs String
"Warnings:" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> String
forall a. Show a => a -> String
show CompilerMessage
w
    format (CompilerSuccess CompilerMessage
w [String]
b a
x) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
content [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
warnings [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
background where
      content :: [String]
content    = [a -> String
forall a. Show a => a -> String
show a
x]
      warnings :: [String]
warnings   = String -> [String] -> [String]
showAs String
"Warnings:" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> String
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
mString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance Show a => Show (TrackedErrors a) where
  show :: TrackedErrors a -> String
show = TrackedErrorsState a -> String
forall a. Show a => a -> String
show (TrackedErrorsState a -> String)
-> (TrackedErrors a -> TrackedErrorsState a)
-> TrackedErrors a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (TrackedErrorsState a) -> TrackedErrorsState a
forall a. Identity a -> a
runIdentity (Identity (TrackedErrorsState a) -> TrackedErrorsState a)
-> (TrackedErrors a -> Identity (TrackedErrorsState a))
-> TrackedErrors a
-> TrackedErrorsState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackedErrors a -> Identity (TrackedErrorsState a)
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 = m (TrackedErrorsState b) -> TrackedErrorsT m b
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState b) -> TrackedErrorsT m b)
-> m (TrackedErrorsState b) -> TrackedErrorsT m b
forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- TrackedErrorsT m a -> m (TrackedErrorsState a)
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerFail CompilerMessage
w CompilerMessage
e      -> TrackedErrorsState b -> m (TrackedErrorsState b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState b -> m (TrackedErrorsState b))
-> TrackedErrorsState b -> m (TrackedErrorsState b)
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> CompilerMessage -> TrackedErrorsState b
forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail CompilerMessage
w CompilerMessage
e -- Not the same a.
         CompilerSuccess CompilerMessage
w [String]
b a
d -> TrackedErrorsState b -> m (TrackedErrorsState b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState b -> m (TrackedErrorsState b))
-> TrackedErrorsState b -> m (TrackedErrorsState b)
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> [String] -> b -> TrackedErrorsState 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 = m (TrackedErrorsState a) -> TrackedErrorsT m a
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState a) -> TrackedErrorsT m a)
-> (a -> m (TrackedErrorsState a)) -> a -> TrackedErrorsT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TrackedErrorsState a -> m (TrackedErrorsState a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState a -> m (TrackedErrorsState a))
-> (a -> TrackedErrorsState a) -> a -> m (TrackedErrorsState a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerMessage -> [String] -> a -> TrackedErrorsState a
forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess CompilerMessage
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 = m (TrackedErrorsState b) -> TrackedErrorsT m b
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState b) -> TrackedErrorsT m b)
-> m (TrackedErrorsState b) -> TrackedErrorsT m b
forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState (a -> b)
f' <- TrackedErrorsT m (a -> b) -> m (TrackedErrorsState (a -> b))
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m (a -> b)
f
    TrackedErrorsState a
x' <- TrackedErrorsT m a -> m (TrackedErrorsState a)
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
_) ->
           TrackedErrorsState b -> m (TrackedErrorsState b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState b -> m (TrackedErrorsState b))
-> TrackedErrorsState b -> m (TrackedErrorsState b)
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> CompilerMessage -> TrackedErrorsState 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) ->
           TrackedErrorsState b -> m (TrackedErrorsState b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState b -> m (TrackedErrorsState b))
-> TrackedErrorsState b -> m (TrackedErrorsState b)
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> CompilerMessage -> TrackedErrorsState b
forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail (TrackedErrorsState (a -> b) -> CompilerMessage
forall a. TrackedErrorsState a -> CompilerMessage
getWarnings TrackedErrorsState (a -> b)
i CompilerMessage -> CompilerMessage -> CompilerMessage
forall a. Semigroup a => a -> a -> a
<> CompilerMessage
w) ([String] -> CompilerMessage -> CompilerMessage
prefixCompilerMessages (TrackedErrorsState (a -> b) -> [String]
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) ->
           TrackedErrorsState b -> m (TrackedErrorsState b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState b -> m (TrackedErrorsState b))
-> TrackedErrorsState b -> m (TrackedErrorsState b)
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> [String] -> b -> TrackedErrorsState b
forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess (CompilerMessage
w1 CompilerMessage -> CompilerMessage -> CompilerMessage
forall a. Semigroup a => a -> a -> a
<> CompilerMessage
w2) ([String]
b1 [String] -> [String] -> [String]
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 = m (TrackedErrorsState b) -> TrackedErrorsT m b
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState b) -> TrackedErrorsT m b)
-> m (TrackedErrorsState b) -> TrackedErrorsT m b
forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- TrackedErrorsT m a -> m (TrackedErrorsState a)
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerFail CompilerMessage
w CompilerMessage
e -> TrackedErrorsState b -> m (TrackedErrorsState b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState b -> m (TrackedErrorsState b))
-> TrackedErrorsState b -> m (TrackedErrorsState b)
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> CompilerMessage -> TrackedErrorsState 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 <- TrackedErrorsT m b -> m (TrackedErrorsState b)
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState (TrackedErrorsT m b -> m (TrackedErrorsState b))
-> TrackedErrorsT m b -> m (TrackedErrorsState b)
forall a b. (a -> b) -> a -> b
$ a -> TrackedErrorsT m b
f a
d
           TrackedErrorsState b -> m (TrackedErrorsState b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState b -> m (TrackedErrorsState b))
-> TrackedErrorsState b -> m (TrackedErrorsState b)
forall a b. (a -> b) -> a -> b
$ [String] -> TrackedErrorsState b -> TrackedErrorsState b
forall a. [String] -> TrackedErrorsState a -> TrackedErrorsState a
includeBackground [String]
b (TrackedErrorsState b -> TrackedErrorsState b)
-> TrackedErrorsState b -> TrackedErrorsState b
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> TrackedErrorsState b -> TrackedErrorsState b
forall a.
CompilerMessage -> TrackedErrorsState a -> TrackedErrorsState a
includeWarnings CompilerMessage
w TrackedErrorsState b
d2
  return :: forall a. a -> TrackedErrorsT m a
return = a -> TrackedErrorsT m a
forall a. a -> TrackedErrorsT m a
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 = String -> TrackedErrorsT m a
forall a. String -> TrackedErrorsT m a
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 = m (TrackedErrorsState a) -> TrackedErrorsT m a
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState a) -> TrackedErrorsT m a)
-> (m a -> m (TrackedErrorsState a)) -> m a -> TrackedErrorsT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> TrackedErrorsState a) -> m a -> m (TrackedErrorsState a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CompilerMessage -> [String] -> a -> TrackedErrorsState a
forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess CompilerMessage
forall a. Monoid a => a
mempty [])

instance MonadIO m => MonadIO (TrackedErrorsT m) where
  liftIO :: forall a. IO a -> TrackedErrorsT m a
liftIO = m a -> TrackedErrorsT m a
forall (m :: * -> *) a. Monad m => m a -> TrackedErrorsT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TrackedErrorsT m a)
-> (IO a -> m a) -> IO a -> TrackedErrorsT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
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 = m (TrackedErrorsState a) -> TrackedErrorsT m a
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState a) -> TrackedErrorsT m a)
-> m (TrackedErrorsState a) -> TrackedErrorsT m a
forall a b. (a -> b) -> a -> b
$ TrackedErrorsState a -> m (TrackedErrorsState a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState a -> m (TrackedErrorsState a))
-> TrackedErrorsState a -> m (TrackedErrorsState a)
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> CompilerMessage -> TrackedErrorsState a
forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail CompilerMessage
forall a. Monoid a => a
mempty (CompilerMessage -> TrackedErrorsState a)
-> CompilerMessage -> TrackedErrorsState a
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 = m (TrackedErrorsState a) -> TrackedErrorsT m a
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState a) -> TrackedErrorsT m a)
-> m (TrackedErrorsState a) -> TrackedErrorsT m a
forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- TrackedErrorsT m a -> m (TrackedErrorsState a)
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerFail CompilerMessage
w CompilerMessage
e        -> TrackedErrorsState a -> m (TrackedErrorsState a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState a -> m (TrackedErrorsState a))
-> TrackedErrorsState a -> m (TrackedErrorsState a)
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> CompilerMessage -> TrackedErrorsState a
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 -> TrackedErrorsState a -> m (TrackedErrorsState a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState a -> m (TrackedErrorsState a))
-> TrackedErrorsState a -> m (TrackedErrorsState a)
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> [String] -> a -> TrackedErrorsState a
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 = m (TrackedErrorsState a) -> TrackedErrorsT m a
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState a) -> TrackedErrorsT m a)
-> m (TrackedErrorsState a) -> TrackedErrorsT m a
forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- TrackedErrorsT m a -> m (TrackedErrorsState a)
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerFail CompilerMessage
w CompilerMessage
e -> TrackedErrorsState a -> m (TrackedErrorsState a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState a -> m (TrackedErrorsState a))
-> TrackedErrorsState a -> m (TrackedErrorsState a)
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> CompilerMessage -> TrackedErrorsState a
forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail CompilerMessage
w (String -> CompilerMessage -> CompilerMessage
pushErrorScope String
e2 CompilerMessage
e)
         TrackedErrorsState a
x2 -> TrackedErrorsState a -> m (TrackedErrorsState a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TrackedErrorsState a
x2
  compilerWarningM :: String -> TrackedErrorsT m ()
compilerWarningM String
w = m (TrackedErrorsState ()) -> TrackedErrorsT m ()
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (TrackedErrorsState () -> m (TrackedErrorsState ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState () -> m (TrackedErrorsState ()))
-> TrackedErrorsState () -> m (TrackedErrorsState ())
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> [String] -> () -> TrackedErrorsState ()
forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess (String -> CompilerMessage
compilerMessage String
w) [] ())
  compilerBackgroundM :: String -> TrackedErrorsT m ()
compilerBackgroundM String
b = m (TrackedErrorsState ()) -> TrackedErrorsT m ()
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (TrackedErrorsState () -> m (TrackedErrorsState ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState () -> m (TrackedErrorsState ()))
-> TrackedErrorsState () -> m (TrackedErrorsState ())
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> [String] -> () -> TrackedErrorsState ()
forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess CompilerMessage
forall a. Monoid a => a
mempty [String
b] ())
  resetBackgroundM :: forall a. TrackedErrorsT m a -> TrackedErrorsT m a
resetBackgroundM TrackedErrorsT m a
x = m (TrackedErrorsState a) -> TrackedErrorsT m a
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState a) -> TrackedErrorsT m a)
-> m (TrackedErrorsState a) -> TrackedErrorsT m a
forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- TrackedErrorsT m a -> m (TrackedErrorsState a)
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 -> TrackedErrorsState a -> m (TrackedErrorsState a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrorsState a -> m (TrackedErrorsState a))
-> TrackedErrorsState a -> m (TrackedErrorsState a)
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> [String] -> a -> TrackedErrorsState a
forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess CompilerMessage
w [] a
d
         TrackedErrorsState a
x2                   -> TrackedErrorsState a -> m (TrackedErrorsState a)
forall a. a -> m a
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 = ([TrackedErrorsState a] -> TrackedErrorsState [a])
-> f (TrackedErrorsT m a) -> TrackedErrorsT m [a]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Foldable f) =>
([TrackedErrorsState a] -> TrackedErrorsState b)
-> f (TrackedErrorsT m a) -> TrackedErrorsT m b
combineResults (([CompilerMessage], [a], [String], [CompilerMessage])
-> TrackedErrorsState [a]
forall {a}.
([CompilerMessage], a, [String], [CompilerMessage])
-> TrackedErrorsState a
select (([CompilerMessage], [a], [String], [CompilerMessage])
 -> TrackedErrorsState [a])
-> ([TrackedErrorsState a]
    -> ([CompilerMessage], [a], [String], [CompilerMessage]))
-> [TrackedErrorsState a]
-> TrackedErrorsState [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TrackedErrorsState a]
-> ([CompilerMessage], [a], [String], [CompilerMessage])
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) = CompilerMessage -> [String] -> a -> TrackedErrorsState a
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)   = CompilerMessage -> CompilerMessage -> TrackedErrorsState a
forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail ([CompilerMessage] -> CompilerMessage
compilerMessages [CompilerMessage]
ws) (CompilerMessage -> TrackedErrorsState a)
-> CompilerMessage -> TrackedErrorsState a
forall a b. (a -> b) -> a -> b
$ [String] -> CompilerMessage -> CompilerMessage
prefixCompilerMessages [String]
bs (CompilerMessage -> CompilerMessage)
-> CompilerMessage -> CompilerMessage
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 = ([TrackedErrorsState a] -> TrackedErrorsState [a])
-> f (TrackedErrorsT m a) -> TrackedErrorsT m [a]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Foldable f) =>
([TrackedErrorsState a] -> TrackedErrorsState b)
-> f (TrackedErrorsT m a) -> TrackedErrorsT m b
combineResults (([CompilerMessage], [a], [String], [CompilerMessage])
-> TrackedErrorsState [a]
forall {a} {a}.
(a, a, [String], [CompilerMessage]) -> TrackedErrorsState a
select (([CompilerMessage], [a], [String], [CompilerMessage])
 -> TrackedErrorsState [a])
-> ([TrackedErrorsState a]
    -> ([CompilerMessage], [a], [String], [CompilerMessage]))
-> [TrackedErrorsState a]
-> TrackedErrorsState [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TrackedErrorsState a]
-> ([CompilerMessage], [a], [String], [CompilerMessage])
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) = CompilerMessage -> [String] -> a -> TrackedErrorsState a
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 = ([TrackedErrorsState a] -> TrackedErrorsState a)
-> f (TrackedErrorsT m a) -> TrackedErrorsT m a
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Foldable f) =>
([TrackedErrorsState a] -> TrackedErrorsState b)
-> f (TrackedErrorsT m a) -> TrackedErrorsT m b
combineResults (([CompilerMessage], [a], [String], [CompilerMessage])
-> TrackedErrorsState a
forall {a}.
([CompilerMessage], [a], [String], [CompilerMessage])
-> TrackedErrorsState a
select (([CompilerMessage], [a], [String], [CompilerMessage])
 -> TrackedErrorsState a)
-> ([TrackedErrorsState a]
    -> ([CompilerMessage], [a], [String], [CompilerMessage]))
-> [TrackedErrorsState a]
-> TrackedErrorsState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TrackedErrorsState a]
-> ([CompilerMessage], [a], [String], [CompilerMessage])
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) = CompilerMessage -> [String] -> a -> TrackedErrorsState a
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)  = CompilerMessage -> CompilerMessage -> TrackedErrorsState a
forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail ([CompilerMessage] -> CompilerMessage
compilerMessages [CompilerMessage]
ws) (CompilerMessage -> TrackedErrorsState a)
-> CompilerMessage -> TrackedErrorsState a
forall a b. (a -> b) -> a -> b
$ [String] -> CompilerMessage -> CompilerMessage
prefixCompilerMessages [String]
bs (CompilerMessage -> CompilerMessage)
-> CompilerMessage -> CompilerMessage
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' <- TrackedErrorsT m a -> m (TrackedErrorsState a)
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState TrackedErrorsT m a
x
    case TrackedErrorsState a
x' of
         CompilerFail CompilerMessage
_ CompilerMessage
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
         TrackedErrorsState a
_                -> Bool -> m Bool
forall a. a -> m 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 = m (TrackedErrorsState a) -> TrackedErrorsT m a
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState a) -> TrackedErrorsT m a)
-> m (TrackedErrorsState a) -> TrackedErrorsT m a
forall a b. (a -> b) -> a -> b
$ do
    TrackedErrorsState a
x' <- TrackedErrorsT m a -> m (TrackedErrorsState a)
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
    TrackedErrorsState a -> m (TrackedErrorsState a)
forall a. a -> m a
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 = m (TrackedErrorsState b) -> TrackedErrorsT m b
forall (m :: * -> *) a.
m (TrackedErrorsState a) -> TrackedErrorsT m a
TrackedErrorsT (m (TrackedErrorsState b) -> TrackedErrorsT m b)
-> (f (TrackedErrorsT m a) -> m (TrackedErrorsState b))
-> f (TrackedErrorsT m a)
-> TrackedErrorsT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TrackedErrorsState a] -> TrackedErrorsState b)
-> m [TrackedErrorsState a] -> m (TrackedErrorsState b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TrackedErrorsState a] -> TrackedErrorsState b
f (m [TrackedErrorsState a] -> m (TrackedErrorsState b))
-> (f (TrackedErrorsT m a) -> m [TrackedErrorsState a])
-> f (TrackedErrorsT m a)
-> m (TrackedErrorsState b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [m (TrackedErrorsState a)] -> m [TrackedErrorsState a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m (TrackedErrorsState a)] -> m [TrackedErrorsState a])
-> (f (TrackedErrorsT m a) -> [m (TrackedErrorsState a)])
-> f (TrackedErrorsT m a)
-> m [TrackedErrorsState a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TrackedErrorsT m a -> m (TrackedErrorsState a))
-> [TrackedErrorsT m a] -> [m (TrackedErrorsState a)]
forall a b. (a -> b) -> [a] -> [b]
map TrackedErrorsT m a -> m (TrackedErrorsState a)
forall (m :: * -> *) a.
TrackedErrorsT m a -> m (TrackedErrorsState a)
tetState ([TrackedErrorsT m a] -> [m (TrackedErrorsState a)])
-> (f (TrackedErrorsT m a) -> [TrackedErrorsT m a])
-> f (TrackedErrorsT m a)
-> [m (TrackedErrorsState a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TrackedErrorsT m a
 -> [TrackedErrorsT m a] -> [TrackedErrorsT m a])
-> [TrackedErrorsT m a]
-> f (TrackedErrorsT m a)
-> [TrackedErrorsT m a]
forall a b. (a -> b -> b) -> b -> f a -> b
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 = CompilerMessage -> TrackedErrorsState a -> TrackedErrorsState a
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) = CompilerMessage -> [String] -> a -> TrackedErrorsState a
forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess (CompilerMessage
w CompilerMessage -> CompilerMessage -> CompilerMessage
forall a. Semigroup a => a -> a -> a
<> CompilerMessage
w2) [String]
b a
d
  update CompilerMessage
w (CompilerFail CompilerMessage
w2 CompilerMessage
e)      = CompilerMessage -> CompilerMessage -> TrackedErrorsState a
forall a.
CompilerMessage -> CompilerMessage -> TrackedErrorsState a
CompilerFail (CompilerMessage
w CompilerMessage -> CompilerMessage -> CompilerMessage
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)       = CompilerMessage -> CompilerMessage -> TrackedErrorsState a
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) = CompilerMessage -> [String] -> a -> TrackedErrorsState a
forall a. CompilerMessage -> [String] -> a -> TrackedErrorsState a
CompilerSuccess CompilerMessage
w ([String]
b1 [String] -> [String] -> [String]
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 = (TrackedErrorsState a
 -> ([CompilerMessage], [a], [String], [CompilerMessage])
 -> ([CompilerMessage], [a], [String], [CompilerMessage]))
-> ([CompilerMessage], [a], [String], [CompilerMessage])
-> f (TrackedErrorsState a)
-> ([CompilerMessage], [a], [String], [CompilerMessage])
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TrackedErrorsState a
-> ([CompilerMessage], [a], [String], [CompilerMessage])
-> ([CompilerMessage], [a], [String], [CompilerMessage])
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
eCompilerMessage -> [CompilerMessage] -> [CompilerMessage]
forall a. a -> [a] -> [a]
:[CompilerMessage]
es,[a]
ds,[String]
bs,CompilerMessage
wCompilerMessage -> [CompilerMessage] -> [CompilerMessage]
forall 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
da -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ds,[String]
b[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String]
bs,CompilerMessage
wCompilerMessage -> [CompilerMessage] -> [CompilerMessage]
forall a. a -> [a] -> [a]
:[CompilerMessage]
ws)