{- -----------------------------------------------------------------------------
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.CompileInfo (
  CompileInfo,
  CompileInfoIO,
  CompileMessage,
  asCompileError,
  asCompileWarnings,
  fromCompileInfo,
  getCompileError,
  getCompileErrorT,
  getCompileSuccess,
  getCompileSuccessT,
  getCompileWarnings,
  getCompileWarningsT,
  isCompileError,
  isCompileErrorT,
  isEmptyCompileMessage,
  toCompileInfo,
  tryCompileInfoIO,
) 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

import Base.CompileError


type CompileInfo a = CompileInfoT Identity a

type CompileInfoIO a = CompileInfoT IO a

data CompileInfoT m a =
  CompileInfoT {
    CompileInfoT m a -> m (CompileInfoState a)
citState :: m (CompileInfoState a)
  }

getCompileError :: CompileInfo a -> CompileMessage
getCompileError :: CompileInfo a -> CompileMessage
getCompileError = Identity CompileMessage -> CompileMessage
forall a. Identity a -> a
runIdentity (Identity CompileMessage -> CompileMessage)
-> (CompileInfo a -> Identity CompileMessage)
-> CompileInfo a
-> CompileMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileInfo a -> Identity CompileMessage
forall (m :: * -> *) a.
Monad m =>
CompileInfoT m a -> m CompileMessage
getCompileErrorT

getCompileSuccess :: CompileInfo a -> a
getCompileSuccess :: CompileInfo a -> a
getCompileSuccess = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> (CompileInfo a -> Identity a) -> CompileInfo a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileInfo a -> Identity a
forall (m :: * -> *) a. Monad m => CompileInfoT m a -> m a
getCompileSuccessT

getCompileWarnings :: CompileInfo a -> CompileMessage
getCompileWarnings :: CompileInfo a -> CompileMessage
getCompileWarnings = Identity CompileMessage -> CompileMessage
forall a. Identity a -> a
runIdentity (Identity CompileMessage -> CompileMessage)
-> (CompileInfo a -> Identity CompileMessage)
-> CompileInfo a
-> CompileMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileInfo a -> Identity CompileMessage
forall (m :: * -> *) a.
Monad m =>
CompileInfoT m a -> m CompileMessage
getCompileWarningsT

isCompileError :: CompileInfo a -> Bool
isCompileError :: CompileInfo a -> Bool
isCompileError = Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool)
-> (CompileInfo a -> Identity Bool) -> CompileInfo a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileInfo a -> Identity Bool
forall (m :: * -> *) a. Monad m => CompileInfoT m a -> m Bool
isCompileErrorT

getCompileErrorT :: Monad m => CompileInfoT m a -> m CompileMessage
getCompileErrorT :: CompileInfoT m a -> m CompileMessage
getCompileErrorT = (CompileInfoState a -> CompileMessage)
-> m (CompileInfoState a) -> m CompileMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompileInfoState a -> CompileMessage
forall a. CompileInfoState a -> CompileMessage
cfErrors (m (CompileInfoState a) -> m CompileMessage)
-> (CompileInfoT m a -> m (CompileInfoState a))
-> CompileInfoT m a
-> m CompileMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileInfoT m a -> m (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState

getCompileSuccessT :: Monad m => CompileInfoT m a -> m a
getCompileSuccessT :: CompileInfoT m a -> m a
getCompileSuccessT = (CompileInfoState a -> a) -> m (CompileInfoState a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompileInfoState a -> a
forall a. CompileInfoState a -> a
csData (m (CompileInfoState a) -> m a)
-> (CompileInfoT m a -> m (CompileInfoState a))
-> CompileInfoT m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileInfoT m a -> m (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState

getCompileWarningsT :: Monad m => CompileInfoT m a -> m CompileMessage
getCompileWarningsT :: CompileInfoT m a -> m CompileMessage
getCompileWarningsT = (CompileInfoState a -> CompileMessage)
-> m (CompileInfoState a) -> m CompileMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompileInfoState a -> CompileMessage
forall a. CompileInfoState a -> CompileMessage
getWarnings (m (CompileInfoState a) -> m CompileMessage)
-> (CompileInfoT m a -> m (CompileInfoState a))
-> CompileInfoT m a
-> m CompileMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileInfoT m a -> m (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState

isCompileErrorT :: Monad m => CompileInfoT m a -> m Bool
isCompileErrorT :: CompileInfoT m a -> m Bool
isCompileErrorT CompileInfoT m a
x = do
  CompileInfoState a
x' <- CompileInfoT m a -> m (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfoT m a
x
  case CompileInfoState a
x' of
       CompileFail CompileMessage
_ CompileMessage
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       CompileInfoState a
_               -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

isEmptyCompileMessage :: CompileMessage -> Bool
isEmptyCompileMessage :: CompileMessage -> Bool
isEmptyCompileMessage (CompileMessage [Char]
"" [CompileMessage]
ws) = (CompileMessage -> Bool) -> [CompileMessage] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CompileMessage -> Bool
isEmptyCompileMessage [CompileMessage]
ws
isEmptyCompileMessage CompileMessage
_                      = Bool
False

fromCompileInfo :: Monad m => CompileInfo a -> CompileInfoT m a
fromCompileInfo :: CompileInfo a -> CompileInfoT m a
fromCompileInfo CompileInfo a
x = Identity (CompileInfoT m a) -> CompileInfoT m a
forall a. Identity a -> a
runIdentity (Identity (CompileInfoT m a) -> CompileInfoT m a)
-> Identity (CompileInfoT m a) -> CompileInfoT m a
forall a b. (a -> b) -> a -> b
$ do
  CompileInfoState a
x' <- CompileInfo a -> Identity (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfo a
x
  CompileInfoT m a -> Identity (CompileInfoT m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoT m a -> Identity (CompileInfoT m a))
-> CompileInfoT m a -> Identity (CompileInfoT m a)
forall a b. (a -> b) -> a -> b
$ m (CompileInfoState a) -> CompileInfoT m a
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState a) -> CompileInfoT m a)
-> m (CompileInfoState a) -> CompileInfoT m a
forall a b. (a -> b) -> a -> b
$ CompileInfoState a -> m (CompileInfoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return CompileInfoState a
x'

asCompileWarnings :: Monad m => CompileInfo a -> CompileInfoT m ()
asCompileWarnings :: CompileInfo a -> CompileInfoT m ()
asCompileWarnings CompileInfo a
x = Identity (CompileInfoT m ()) -> CompileInfoT m ()
forall a. Identity a -> a
runIdentity (Identity (CompileInfoT m ()) -> CompileInfoT m ())
-> Identity (CompileInfoT m ()) -> CompileInfoT m ()
forall a b. (a -> b) -> a -> b
$ do
  CompileInfoState a
x' <- CompileInfo a -> Identity (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfo a
x
  CompileInfoT m () -> Identity (CompileInfoT m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoT m () -> Identity (CompileInfoT m ()))
-> CompileInfoT m () -> Identity (CompileInfoT m ())
forall a b. (a -> b) -> a -> b
$ m (CompileInfoState ()) -> CompileInfoT m ()
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState ()) -> CompileInfoT m ())
-> m (CompileInfoState ()) -> CompileInfoT m ()
forall a b. (a -> b) -> a -> b
$ CompileInfoState () -> m (CompileInfoState ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState () -> m (CompileInfoState ()))
-> CompileInfoState () -> m (CompileInfoState ())
forall a b. (a -> b) -> a -> b
$
    case CompileInfoState a
x' of
         (CompileFail CompileMessage
ws CompileMessage
es)      -> CompileMessage -> [[Char]] -> () -> CompileInfoState ()
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess (CompileMessage
ws CompileMessage -> CompileMessage -> CompileMessage
`mergeMessages` CompileMessage
es) [] ()
         (CompileSuccess CompileMessage
ws [[Char]]
bs a
_) -> CompileMessage -> [[Char]] -> () -> CompileInfoState ()
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess CompileMessage
ws [[Char]]
bs ()

asCompileError :: Monad m => CompileInfo a -> CompileInfoT m ()
asCompileError :: CompileInfo a -> CompileInfoT m ()
asCompileError CompileInfo a
x = Identity (CompileInfoT m ()) -> CompileInfoT m ()
forall a. Identity a -> a
runIdentity (Identity (CompileInfoT m ()) -> CompileInfoT m ())
-> Identity (CompileInfoT m ()) -> CompileInfoT m ()
forall a b. (a -> b) -> a -> b
$ do
  CompileInfoState a
x' <- CompileInfo a -> Identity (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfo a
x
  CompileInfoT m () -> Identity (CompileInfoT m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoT m () -> Identity (CompileInfoT m ()))
-> CompileInfoT m () -> Identity (CompileInfoT m ())
forall a b. (a -> b) -> a -> b
$ m (CompileInfoState ()) -> CompileInfoT m ()
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState ()) -> CompileInfoT m ())
-> m (CompileInfoState ()) -> CompileInfoT m ()
forall a b. (a -> b) -> a -> b
$ CompileInfoState () -> m (CompileInfoState ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState () -> m (CompileInfoState ()))
-> CompileInfoState () -> m (CompileInfoState ())
forall a b. (a -> b) -> a -> b
$
    case CompileInfoState a
x' of
         (CompileSuccess CompileMessage
ws [[Char]]
bs a
_) -> [[Char]] -> CompileInfoState () -> CompileInfoState ()
forall a. [[Char]] -> CompileInfoState a -> CompileInfoState a
includeBackground [[Char]]
bs (CompileInfoState () -> CompileInfoState ())
-> CompileInfoState () -> CompileInfoState ()
forall a b. (a -> b) -> a -> b
$ CompileMessage -> CompileMessage -> CompileInfoState ()
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail CompileMessage
emptyMessage CompileMessage
ws
         (CompileFail CompileMessage
ws CompileMessage
es)      -> CompileMessage -> CompileMessage -> CompileInfoState ()
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail CompileMessage
ws CompileMessage
es

toCompileInfo :: Monad m => CompileInfoT m a -> m (CompileInfo a)
toCompileInfo :: CompileInfoT m a -> m (CompileInfo a)
toCompileInfo CompileInfoT m a
x = do
  CompileInfoState a
x' <- CompileInfoT m a -> m (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfoT m a
x
  CompileInfo a -> m (CompileInfo a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfo a -> m (CompileInfo a))
-> CompileInfo a -> m (CompileInfo a)
forall a b. (a -> b) -> a -> b
$ Identity (CompileInfoState a) -> CompileInfo a
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (Identity (CompileInfoState a) -> CompileInfo a)
-> Identity (CompileInfoState a) -> CompileInfo a
forall a b. (a -> b) -> a -> b
$ CompileInfoState a -> Identity (CompileInfoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return CompileInfoState a
x'

tryCompileInfoIO :: String -> String -> CompileInfoIO a -> IO a
tryCompileInfoIO :: [Char] -> [Char] -> CompileInfoIO a -> IO a
tryCompileInfoIO [Char]
warn [Char]
err CompileInfoIO a
x = do
  CompileInfo a
x' <- CompileInfoIO a -> IO (CompileInfo a)
forall (m :: * -> *) a.
Monad m =>
CompileInfoT m a -> m (CompileInfo a)
toCompileInfo CompileInfoIO a
x
  let w :: CompileMessage
w = CompileInfo a -> CompileMessage
forall a. CompileInfo a -> CompileMessage
getCompileWarnings (CompileInfo a -> CompileMessage)
-> CompileInfo a -> CompileMessage
forall a b. (a -> b) -> a -> b
$ CompileInfo a
x' CompileInfo a -> [Char] -> CompileInfo a
forall (m :: * -> *) a. CompileErrorM m => m a -> [Char] -> m a
<?? [Char]
warn
  let e :: CompileMessage
e = CompileInfo a -> CompileMessage
forall a. CompileInfo a -> CompileMessage
getCompileError    (CompileInfo a -> CompileMessage)
-> CompileInfo a -> CompileMessage
forall a b. (a -> b) -> a -> b
$ CompileInfo a
x' CompileInfo a -> [Char] -> CompileInfo a
forall (m :: * -> *) a. CompileErrorM m => m a -> [Char] -> m a
<?? [Char]
err
  if CompileInfo a -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfo a
x'
     then do
       Handle -> [Char] -> IO ()
hPutStr Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [Char]
forall a. Show a => a -> [Char]
show CompileMessage
w
       Handle -> [Char] -> IO ()
hPutStr Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [Char]
forall a. Show a => a -> [Char]
show CompileMessage
e
       IO a
forall a. IO a
exitFailure
     else do
       Handle -> [Char] -> IO ()
hPutStr Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [Char]
forall a. Show a => a -> [Char]
show CompileMessage
w
       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
$ CompileInfo a -> a
forall a. CompileInfo a -> a
getCompileSuccess CompileInfo a
x'

data CompileMessage =
  CompileMessage {
    CompileMessage -> [Char]
cmMessage :: String,
    CompileMessage -> [CompileMessage]
cmNested :: [CompileMessage]
  }

instance Show CompileMessage where
  show :: CompileMessage -> [Char]
show = [Char] -> CompileMessage -> [Char]
format [Char]
"" where
    format :: [Char] -> CompileMessage -> [Char]
format [Char]
indent (CompileMessage [] [CompileMessage]
ms) =
      [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((CompileMessage -> [Char]) -> [CompileMessage] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> CompileMessage -> [Char]
format [Char]
indent) [CompileMessage]
ms)
    format [Char]
indent (CompileMessage [Char]
m [CompileMessage]
ms) =
      ([Char] -> ShowS
doIndent [Char]
indent [Char]
m) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((CompileMessage -> [Char]) -> [CompileMessage] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> CompileMessage -> [Char]
format ([Char] -> CompileMessage -> [Char])
-> [Char] -> CompileMessage -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
indent [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"  ") [CompileMessage]
ms)
    doIndent :: [Char] -> ShowS
doIndent [Char]
indent [Char]
s = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
indent [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
s

data CompileInfoState a =
  CompileFail {
    CompileInfoState a -> CompileMessage
cfWarnings :: CompileMessage,
    CompileInfoState a -> CompileMessage
cfErrors :: CompileMessage
  } |
  CompileSuccess {
    CompileInfoState a -> CompileMessage
csWarnings :: CompileMessage,
    CompileInfoState a -> [[Char]]
csBackground :: [String],
    CompileInfoState a -> a
csData :: a
  }

instance Show a => Show (CompileInfoState a) where
  show :: CompileInfoState a -> [Char]
show = CompileInfoState a -> [Char]
forall a. Show a => CompileInfoState a -> [Char]
format where
    format :: CompileInfoState a -> [Char]
format (CompileFail CompileMessage
w CompileMessage
e) = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
errors [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
warnings where
      errors :: [[Char]]
errors   = [Char] -> [[Char]] -> [[Char]]
showAs [Char]
"Errors:"   ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [Char]
forall a. Show a => a -> [Char]
show CompileMessage
e
      warnings :: [[Char]]
warnings = [Char] -> [[Char]] -> [[Char]]
showAs [Char]
"Warnings:" ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [Char]
forall a. Show a => a -> [Char]
show CompileMessage
w
    format (CompileSuccess CompileMessage
w [[Char]]
b a
x) = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
content [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
warnings [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
background where
      content :: [[Char]]
content    = [a -> [Char]
forall a. Show a => a -> [Char]
show a
x]
      warnings :: [[Char]]
warnings   = [Char] -> [[Char]] -> [[Char]]
showAs [Char]
"Warnings:" ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [Char]
forall a. Show a => a -> [Char]
show CompileMessage
w
      background :: [[Char]]
background = [Char] -> [[Char]] -> [[Char]]
showAs [Char]
"Background:" [[Char]]
b
    showAs :: [Char] -> [[Char]] -> [[Char]]
showAs [Char]
m = ([Char]
m[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:) ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"  " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance Show a => Show (CompileInfo a) where
  show :: CompileInfo a -> [Char]
show = CompileInfoState a -> [Char]
forall a. Show a => a -> [Char]
show (CompileInfoState a -> [Char])
-> (CompileInfo a -> CompileInfoState a) -> CompileInfo a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (CompileInfoState a) -> CompileInfoState a
forall a. Identity a -> a
runIdentity (Identity (CompileInfoState a) -> CompileInfoState a)
-> (CompileInfo a -> Identity (CompileInfoState a))
-> CompileInfo a
-> CompileInfoState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileInfo a -> Identity (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState

instance (Functor m, Monad m) => Functor (CompileInfoT m) where
  fmap :: (a -> b) -> CompileInfoT m a -> CompileInfoT m b
fmap a -> b
f CompileInfoT m a
x = m (CompileInfoState b) -> CompileInfoT m b
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState b) -> CompileInfoT m b)
-> m (CompileInfoState b) -> CompileInfoT m b
forall a b. (a -> b) -> a -> b
$ do
    CompileInfoState a
x' <- CompileInfoT m a -> m (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfoT m a
x
    case CompileInfoState a
x' of
         CompileFail CompileMessage
w CompileMessage
e      -> CompileInfoState b -> m (CompileInfoState b)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState b -> m (CompileInfoState b))
-> CompileInfoState b -> m (CompileInfoState b)
forall a b. (a -> b) -> a -> b
$ CompileMessage -> CompileMessage -> CompileInfoState b
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail CompileMessage
w CompileMessage
e -- Not the same a.
         CompileSuccess CompileMessage
w [[Char]]
b a
d -> CompileInfoState b -> m (CompileInfoState b)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState b -> m (CompileInfoState b))
-> CompileInfoState b -> m (CompileInfoState b)
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [[Char]] -> b -> CompileInfoState b
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess CompileMessage
w [[Char]]
b (a -> b
f a
d)

instance (Applicative m, Monad m) => Applicative (CompileInfoT m) where
  pure :: a -> CompileInfoT m a
pure = m (CompileInfoState a) -> CompileInfoT m a
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState a) -> CompileInfoT m a)
-> (a -> m (CompileInfoState a)) -> a -> CompileInfoT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CompileInfoState a -> m (CompileInfoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState a -> m (CompileInfoState a))
-> (a -> CompileInfoState a) -> a -> m (CompileInfoState a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileMessage -> [[Char]] -> a -> CompileInfoState a
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess CompileMessage
emptyMessage []
  CompileInfoT m (a -> b)
f <*> :: CompileInfoT m (a -> b) -> CompileInfoT m a -> CompileInfoT m b
<*> CompileInfoT m a
x = m (CompileInfoState b) -> CompileInfoT m b
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState b) -> CompileInfoT m b)
-> m (CompileInfoState b) -> CompileInfoT m b
forall a b. (a -> b) -> a -> b
$ do
    CompileInfoState (a -> b)
f' <- CompileInfoT m (a -> b) -> m (CompileInfoState (a -> b))
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfoT m (a -> b)
f
    CompileInfoState a
x' <- CompileInfoT m a -> m (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfoT m a
x
    case (CompileInfoState (a -> b)
f',CompileInfoState a
x') of
         (CompileFail CompileMessage
w CompileMessage
e,CompileInfoState a
_) ->
           CompileInfoState b -> m (CompileInfoState b)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState b -> m (CompileInfoState b))
-> CompileInfoState b -> m (CompileInfoState b)
forall a b. (a -> b) -> a -> b
$ CompileMessage -> CompileMessage -> CompileInfoState b
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail CompileMessage
w CompileMessage
e -- Not the same a.
         (CompileInfoState (a -> b)
i,CompileFail CompileMessage
w CompileMessage
e) ->
           CompileInfoState b -> m (CompileInfoState b)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState b -> m (CompileInfoState b))
-> CompileInfoState b -> m (CompileInfoState b)
forall a b. (a -> b) -> a -> b
$ CompileMessage -> CompileMessage -> CompileInfoState b
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail (CompileInfoState (a -> b) -> CompileMessage
forall a. CompileInfoState a -> CompileMessage
getWarnings CompileInfoState (a -> b)
i CompileMessage -> CompileMessage -> CompileMessage
`mergeMessages` CompileMessage
w) ([[Char]] -> CompileMessage -> CompileMessage
addBackground (CompileInfoState (a -> b) -> [[Char]]
forall a. CompileInfoState a -> [[Char]]
getBackground CompileInfoState (a -> b)
i) CompileMessage
e)
         (CompileSuccess CompileMessage
w1 [[Char]]
b1 a -> b
f2,CompileSuccess CompileMessage
w2 [[Char]]
b2 a
d) ->
           CompileInfoState b -> m (CompileInfoState b)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState b -> m (CompileInfoState b))
-> CompileInfoState b -> m (CompileInfoState b)
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [[Char]] -> b -> CompileInfoState b
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess (CompileMessage
w1 CompileMessage -> CompileMessage -> CompileMessage
`mergeMessages` CompileMessage
w2) ([[Char]]
b1 [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
b2) (a -> b
f2 a
d)

instance Monad m => Monad (CompileInfoT m) where
  CompileInfoT m a
x >>= :: CompileInfoT m a -> (a -> CompileInfoT m b) -> CompileInfoT m b
>>= a -> CompileInfoT m b
f = m (CompileInfoState b) -> CompileInfoT m b
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState b) -> CompileInfoT m b)
-> m (CompileInfoState b) -> CompileInfoT m b
forall a b. (a -> b) -> a -> b
$ do
    CompileInfoState a
x' <- CompileInfoT m a -> m (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfoT m a
x
    case CompileInfoState a
x' of
         CompileFail CompileMessage
w CompileMessage
e -> CompileInfoState b -> m (CompileInfoState b)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState b -> m (CompileInfoState b))
-> CompileInfoState b -> m (CompileInfoState b)
forall a b. (a -> b) -> a -> b
$ CompileMessage -> CompileMessage -> CompileInfoState b
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail CompileMessage
w CompileMessage
e -- Not the same a.
         CompileSuccess CompileMessage
w [[Char]]
b a
d -> do
           CompileInfoState b
d2 <- CompileInfoT m b -> m (CompileInfoState b)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState (CompileInfoT m b -> m (CompileInfoState b))
-> CompileInfoT m b -> m (CompileInfoState b)
forall a b. (a -> b) -> a -> b
$ a -> CompileInfoT m b
f a
d
           CompileInfoState b -> m (CompileInfoState b)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState b -> m (CompileInfoState b))
-> CompileInfoState b -> m (CompileInfoState b)
forall a b. (a -> b) -> a -> b
$ [[Char]] -> CompileInfoState b -> CompileInfoState b
forall a. [[Char]] -> CompileInfoState a -> CompileInfoState a
includeBackground [[Char]]
b (CompileInfoState b -> CompileInfoState b)
-> CompileInfoState b -> CompileInfoState b
forall a b. (a -> b) -> a -> b
$ CompileMessage -> CompileInfoState b -> CompileInfoState b
forall a.
CompileMessage -> CompileInfoState a -> CompileInfoState a
includeWarnings CompileMessage
w CompileInfoState b
d2
  return :: a -> CompileInfoT m a
return = a -> CompileInfoT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

#if MIN_VERSION_base(4,9,0)
instance Monad m => MonadFail (CompileInfoT m) where
  fail :: [Char] -> CompileInfoT m a
fail = [Char] -> CompileInfoT m a
forall (m :: * -> *) a. CompileErrorM m => [Char] -> m a
compileErrorM
#endif

instance MonadTrans CompileInfoT where
  lift :: m a -> CompileInfoT m a
lift = m (CompileInfoState a) -> CompileInfoT m a
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState a) -> CompileInfoT m a)
-> (m a -> m (CompileInfoState a)) -> m a -> CompileInfoT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> CompileInfoState a) -> m a -> m (CompileInfoState a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CompileMessage -> [[Char]] -> a -> CompileInfoState a
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess CompileMessage
emptyMessage [])

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

instance Monad m => CompileErrorM (CompileInfoT m) where
  compileErrorM :: [Char] -> CompileInfoT m a
compileErrorM [Char]
e = m (CompileInfoState a) -> CompileInfoT m a
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState a) -> CompileInfoT m a)
-> m (CompileInfoState a) -> CompileInfoT m a
forall a b. (a -> b) -> a -> b
$ CompileInfoState a -> m (CompileInfoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState a -> m (CompileInfoState a))
-> CompileInfoState a -> m (CompileInfoState a)
forall a b. (a -> b) -> a -> b
$ CompileMessage -> CompileMessage -> CompileInfoState a
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail CompileMessage
emptyMessage (CompileMessage -> CompileInfoState a)
-> CompileMessage -> CompileInfoState a
forall a b. (a -> b) -> a -> b
$ [Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
e []
  collectAllM :: f (CompileInfoT m a) -> CompileInfoT m [a]
collectAllM = ([CompileInfoState a] -> CompileInfoState [a])
-> f (CompileInfoT m a) -> CompileInfoT m [a]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Foldable f) =>
([CompileInfoState a] -> CompileInfoState b)
-> f (CompileInfoT m a) -> CompileInfoT m b
combineResults (([CompileMessage], [a], [[Char]], [CompileMessage])
-> CompileInfoState [a]
forall a.
([CompileMessage], a, [[Char]], [CompileMessage])
-> CompileInfoState a
select (([CompileMessage], [a], [[Char]], [CompileMessage])
 -> CompileInfoState [a])
-> ([CompileInfoState a]
    -> ([CompileMessage], [a], [[Char]], [CompileMessage]))
-> [CompileInfoState a]
-> CompileInfoState [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CompileInfoState a]
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
forall (f :: * -> *) a.
Foldable f =>
f (CompileInfoState a)
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
splitErrorsAndData) where
    select :: ([CompileMessage], a, [[Char]], [CompileMessage])
-> CompileInfoState a
select ([],a
xs2,[[Char]]
bs,[CompileMessage]
ws) = CompileMessage -> [[Char]] -> a -> CompileInfoState a
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess ([Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" [CompileMessage]
ws) [[Char]]
bs a
xs2
    select ([CompileMessage]
es,a
_,[[Char]]
bs,[CompileMessage]
ws)   = CompileMessage -> CompileMessage -> CompileInfoState a
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail ([Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" [CompileMessage]
ws) (CompileMessage -> CompileInfoState a)
-> CompileMessage -> CompileInfoState a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> CompileMessage -> CompileMessage
addBackground [[Char]]
bs (CompileMessage -> CompileMessage)
-> CompileMessage -> CompileMessage
forall a b. (a -> b) -> a -> b
$ [Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" [CompileMessage]
es
  collectAnyM :: f (CompileInfoT m a) -> CompileInfoT m [a]
collectAnyM = ([CompileInfoState a] -> CompileInfoState [a])
-> f (CompileInfoT m a) -> CompileInfoT m [a]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Foldable f) =>
([CompileInfoState a] -> CompileInfoState b)
-> f (CompileInfoT m a) -> CompileInfoT m b
combineResults (([CompileMessage], [a], [[Char]], [CompileMessage])
-> CompileInfoState [a]
forall a a.
(a, a, [[Char]], [CompileMessage]) -> CompileInfoState a
select (([CompileMessage], [a], [[Char]], [CompileMessage])
 -> CompileInfoState [a])
-> ([CompileInfoState a]
    -> ([CompileMessage], [a], [[Char]], [CompileMessage]))
-> [CompileInfoState a]
-> CompileInfoState [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CompileInfoState a]
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
forall (f :: * -> *) a.
Foldable f =>
f (CompileInfoState a)
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
splitErrorsAndData) where
    select :: (a, a, [[Char]], [CompileMessage]) -> CompileInfoState a
select (a
_,a
xs2,[[Char]]
bs,[CompileMessage]
ws) = CompileMessage -> [[Char]] -> a -> CompileInfoState a
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess ([Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" [CompileMessage]
ws) [[Char]]
bs a
xs2
  collectFirstM :: f (CompileInfoT m a) -> CompileInfoT m a
collectFirstM = ([CompileInfoState a] -> CompileInfoState a)
-> f (CompileInfoT m a) -> CompileInfoT m a
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Foldable f) =>
([CompileInfoState a] -> CompileInfoState b)
-> f (CompileInfoT m a) -> CompileInfoT m b
combineResults (([CompileMessage], [a], [[Char]], [CompileMessage])
-> CompileInfoState a
forall a.
([CompileMessage], [a], [[Char]], [CompileMessage])
-> CompileInfoState a
select (([CompileMessage], [a], [[Char]], [CompileMessage])
 -> CompileInfoState a)
-> ([CompileInfoState a]
    -> ([CompileMessage], [a], [[Char]], [CompileMessage]))
-> [CompileInfoState a]
-> CompileInfoState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CompileInfoState a]
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
forall (f :: * -> *) a.
Foldable f =>
f (CompileInfoState a)
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
splitErrorsAndData) where
    select :: ([CompileMessage], [a], [[Char]], [CompileMessage])
-> CompileInfoState a
select ([CompileMessage]
_,a
x:[a]
_,[[Char]]
bs,[CompileMessage]
ws) = CompileMessage -> [[Char]] -> a -> CompileInfoState a
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess ([Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" [CompileMessage]
ws) [[Char]]
bs a
x
    select ([CompileMessage]
es,[a]
_,[[Char]]
bs,[CompileMessage]
ws)  = CompileMessage -> CompileMessage -> CompileInfoState a
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail ([Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" [CompileMessage]
ws) (CompileMessage -> CompileInfoState a)
-> CompileMessage -> CompileInfoState a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> CompileMessage -> CompileMessage
addBackground [[Char]]
bs (CompileMessage -> CompileMessage)
-> CompileMessage -> CompileMessage
forall a b. (a -> b) -> a -> b
$ [Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" [CompileMessage]
es
  withContextM :: CompileInfoT m a -> [Char] -> CompileInfoT m a
withContextM CompileInfoT m a
x [Char]
c = m (CompileInfoState a) -> CompileInfoT m a
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState a) -> CompileInfoT m a)
-> m (CompileInfoState a) -> CompileInfoT m a
forall a b. (a -> b) -> a -> b
$ do
    CompileInfoState a
x' <- CompileInfoT m a -> m (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfoT m a
x
    case CompileInfoState a
x' of
         CompileFail CompileMessage
w CompileMessage
e        -> CompileInfoState a -> m (CompileInfoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState a -> m (CompileInfoState a))
-> CompileInfoState a -> m (CompileInfoState a)
forall a b. (a -> b) -> a -> b
$ CompileMessage -> CompileMessage -> CompileInfoState a
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail ([Char] -> CompileMessage -> CompileMessage
pushWarningScope [Char]
c CompileMessage
w) ([Char] -> CompileMessage -> CompileMessage
pushErrorScope [Char]
c CompileMessage
e)
         CompileSuccess CompileMessage
w [[Char]]
bs a
x2 -> CompileInfoState a -> m (CompileInfoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState a -> m (CompileInfoState a))
-> CompileInfoState a -> m (CompileInfoState a)
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [[Char]] -> a -> CompileInfoState a
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess ([Char] -> CompileMessage -> CompileMessage
pushWarningScope [Char]
c CompileMessage
w) [[Char]]
bs a
x2
  summarizeErrorsM :: CompileInfoT m a -> [Char] -> CompileInfoT m a
summarizeErrorsM CompileInfoT m a
x [Char]
e2 = m (CompileInfoState a) -> CompileInfoT m a
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState a) -> CompileInfoT m a)
-> m (CompileInfoState a) -> CompileInfoT m a
forall a b. (a -> b) -> a -> b
$ do
    CompileInfoState a
x' <- CompileInfoT m a -> m (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfoT m a
x
    case CompileInfoState a
x' of
         CompileFail CompileMessage
w CompileMessage
e -> CompileInfoState a -> m (CompileInfoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState a -> m (CompileInfoState a))
-> CompileInfoState a -> m (CompileInfoState a)
forall a b. (a -> b) -> a -> b
$ CompileMessage -> CompileMessage -> CompileInfoState a
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail CompileMessage
w ([Char] -> CompileMessage -> CompileMessage
pushErrorScope [Char]
e2 CompileMessage
e)
         CompileInfoState a
x2 -> CompileInfoState a -> m (CompileInfoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return CompileInfoState a
x2
  compileWarningM :: [Char] -> CompileInfoT m ()
compileWarningM [Char]
w = m (CompileInfoState ()) -> CompileInfoT m ()
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (CompileInfoState () -> m (CompileInfoState ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState () -> m (CompileInfoState ()))
-> CompileInfoState () -> m (CompileInfoState ())
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [[Char]] -> () -> CompileInfoState ()
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess ([Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
w []) [] ())
  compileBackgroundM :: [Char] -> CompileInfoT m ()
compileBackgroundM [Char]
b = m (CompileInfoState ()) -> CompileInfoT m ()
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (CompileInfoState () -> m (CompileInfoState ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState () -> m (CompileInfoState ()))
-> CompileInfoState () -> m (CompileInfoState ())
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [[Char]] -> () -> CompileInfoState ()
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess CompileMessage
emptyMessage [[Char]
b] ())
  resetBackgroundM :: CompileInfoT m a -> CompileInfoT m a
resetBackgroundM CompileInfoT m a
x = m (CompileInfoState a) -> CompileInfoT m a
forall (m :: * -> *) a. m (CompileInfoState a) -> CompileInfoT m a
CompileInfoT (m (CompileInfoState a) -> CompileInfoT m a)
-> m (CompileInfoState a) -> CompileInfoT m a
forall a b. (a -> b) -> a -> b
$ do
    CompileInfoState a
x' <- CompileInfoT m a -> m (CompileInfoState a)
forall (m :: * -> *) a. CompileInfoT m a -> m (CompileInfoState a)
citState CompileInfoT m a
x
    case CompileInfoState a
x' of
         CompileSuccess CompileMessage
w [[Char]]
_ a
d -> CompileInfoState a -> m (CompileInfoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfoState a -> m (CompileInfoState a))
-> CompileInfoState a -> m (CompileInfoState a)
forall a b. (a -> b) -> a -> b
$ CompileMessage -> [[Char]] -> a -> CompileInfoState a
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess CompileMessage
w [] a
d
         CompileInfoState a
x2                   -> CompileInfoState a -> m (CompileInfoState a)
forall (m :: * -> *) a. Monad m => a -> m a
return CompileInfoState a
x2

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

emptyMessage :: CompileMessage
emptyMessage :: CompileMessage
emptyMessage = [Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" []

pushErrorScope :: String -> CompileMessage -> CompileMessage
pushErrorScope :: [Char] -> CompileMessage -> CompileMessage
pushErrorScope [Char]
e2 ea :: CompileMessage
ea@(CompileMessage [Char]
e [CompileMessage]
ms)
  | [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
e            = [Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
e2 [CompileMessage]
ms
  | Bool
otherwise         = [Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
e2 [CompileMessage
ea]

pushWarningScope :: String -> CompileMessage -> CompileMessage
pushWarningScope :: [Char] -> CompileMessage -> CompileMessage
pushWarningScope [Char]
e2 CompileMessage
ea
  | CompileMessage -> Bool
isEmptyCompileMessage CompileMessage
ea = CompileMessage
emptyMessage  -- Skip the scope if there isn't already a warning.
  | Bool
otherwise                = [Char] -> CompileMessage -> CompileMessage
pushErrorScope [Char]
e2 CompileMessage
ea

mergeMessages :: CompileMessage -> CompileMessage -> CompileMessage
mergeMessages :: CompileMessage -> CompileMessage -> CompileMessage
mergeMessages (CompileMessage [Char]
"" []) CompileMessage
e2                       = CompileMessage
e2
mergeMessages CompileMessage
e1                     (CompileMessage [Char]
"" [])   = CompileMessage
e1
mergeMessages (CompileMessage [Char]
"" [CompileMessage]
es1) (CompileMessage [Char]
"" [CompileMessage]
es2) = [Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" ([CompileMessage]
es1 [CompileMessage] -> [CompileMessage] -> [CompileMessage]
forall a. [a] -> [a] -> [a]
++ [CompileMessage]
es2)
mergeMessages CompileMessage
e1                      (CompileMessage [Char]
"" [CompileMessage]
es2) = [Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" ([CompileMessage
e1] [CompileMessage] -> [CompileMessage] -> [CompileMessage]
forall a. [a] -> [a] -> [a]
++ [CompileMessage]
es2)
mergeMessages (CompileMessage [Char]
"" [CompileMessage]
es1) CompileMessage
e2                      = [Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" ([CompileMessage]
es1 [CompileMessage] -> [CompileMessage] -> [CompileMessage]
forall a. [a] -> [a] -> [a]
++ [CompileMessage
e2])
mergeMessages CompileMessage
e1                      CompileMessage
e2                      = [Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
"" [CompileMessage
e1,CompileMessage
e2]

addBackground :: [String] -> CompileMessage -> CompileMessage
addBackground :: [[Char]] -> CompileMessage -> CompileMessage
addBackground [[Char]]
b (CompileMessage [Char]
e [CompileMessage]
es) = [Char] -> [CompileMessage] -> CompileMessage
CompileMessage [Char]
e ([CompileMessage]
es [CompileMessage] -> [CompileMessage] -> [CompileMessage]
forall a. [a] -> [a] -> [a]
++ ([Char] -> CompileMessage) -> [[Char]] -> [CompileMessage]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> [CompileMessage] -> CompileMessage)
-> [CompileMessage] -> [Char] -> CompileMessage
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [CompileMessage] -> CompileMessage
CompileMessage []) [[Char]]
b)

getWarnings :: CompileInfoState a -> CompileMessage
getWarnings :: CompileInfoState a -> CompileMessage
getWarnings (CompileFail CompileMessage
w CompileMessage
_)      = CompileMessage
w
getWarnings (CompileSuccess CompileMessage
w [[Char]]
_ a
_) = CompileMessage
w

includeWarnings :: CompileMessage -> CompileInfoState a -> CompileInfoState a
includeWarnings :: CompileMessage -> CompileInfoState a -> CompileInfoState a
includeWarnings = CompileMessage -> CompileInfoState a -> CompileInfoState a
forall a.
CompileMessage -> CompileInfoState a -> CompileInfoState a
update where
  update :: CompileMessage -> CompileInfoState a -> CompileInfoState a
update CompileMessage
w (CompileSuccess CompileMessage
w2 [[Char]]
b a
d) = CompileMessage -> [[Char]] -> a -> CompileInfoState a
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess (CompileMessage
w CompileMessage -> CompileMessage -> CompileMessage
`mergeMessages` CompileMessage
w2) [[Char]]
b a
d
  update CompileMessage
w (CompileFail CompileMessage
w2 CompileMessage
e)      = CompileMessage -> CompileMessage -> CompileInfoState a
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail (CompileMessage
w CompileMessage -> CompileMessage -> CompileMessage
`mergeMessages` CompileMessage
w2) CompileMessage
e

getBackground :: CompileInfoState a -> [String]
getBackground :: CompileInfoState a -> [[Char]]
getBackground (CompileSuccess CompileMessage
_ [[Char]]
b a
_) = [[Char]]
b
getBackground CompileInfoState a
_                      = []

includeBackground :: [String] -> CompileInfoState a -> CompileInfoState a
includeBackground :: [[Char]] -> CompileInfoState a -> CompileInfoState a
includeBackground [[Char]]
b  (CompileFail CompileMessage
w CompileMessage
e)       = CompileMessage -> CompileMessage -> CompileInfoState a
forall a. CompileMessage -> CompileMessage -> CompileInfoState a
CompileFail CompileMessage
w ([[Char]] -> CompileMessage -> CompileMessage
addBackground [[Char]]
b CompileMessage
e)
includeBackground [[Char]]
b1 (CompileSuccess CompileMessage
w [[Char]]
b2 a
d) = CompileMessage -> [[Char]] -> a -> CompileInfoState a
forall a. CompileMessage -> [[Char]] -> a -> CompileInfoState a
CompileSuccess CompileMessage
w ([[Char]]
b1 [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
b2) a
d

splitErrorsAndData :: Foldable f => f (CompileInfoState a) -> ([CompileMessage],[a],[String],[CompileMessage])
splitErrorsAndData :: f (CompileInfoState a)
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
splitErrorsAndData = (CompileInfoState a
 -> ([CompileMessage], [a], [[Char]], [CompileMessage])
 -> ([CompileMessage], [a], [[Char]], [CompileMessage]))
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
-> f (CompileInfoState a)
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CompileInfoState a
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
forall a.
CompileInfoState a
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
partition ([],[],[],[]) where
  partition :: CompileInfoState a
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
-> ([CompileMessage], [a], [[Char]], [CompileMessage])
partition (CompileFail CompileMessage
w CompileMessage
e)      ([CompileMessage]
es,[a]
ds,[[Char]]
bs,[CompileMessage]
ws) = (CompileMessage
eCompileMessage -> [CompileMessage] -> [CompileMessage]
forall a. a -> [a] -> [a]
:[CompileMessage]
es,[a]
ds,[[Char]]
bs,CompileMessage
wCompileMessage -> [CompileMessage] -> [CompileMessage]
forall a. a -> [a] -> [a]
:[CompileMessage]
ws)
  partition (CompileSuccess CompileMessage
w [[Char]]
b a
d) ([CompileMessage]
es,[a]
ds,[[Char]]
bs,[CompileMessage]
ws) = ([CompileMessage]
es,a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ds,[[Char]]
b[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++[[Char]]
bs,CompileMessage
wCompileMessage -> [CompileMessage] -> [CompileMessage]
forall a. a -> [a] -> [a]
:[CompileMessage]
ws)