{- -----------------------------------------------------------------------------
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 Safe #-}

module Base.CompilerMessage (
  CompilerMessage,
  compilerMessage,
  compilerMessages,
  prefixCompilerMessages,
  pushErrorScope,
  pushWarningScope,
) where

import Data.List (intercalate)
import Prelude hiding (foldr)

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


data CompilerMessage =
  CompilerMessage {
    CompilerMessage -> String
cmMessage :: String,
    CompilerMessage -> [CompilerMessage]
cmNested :: [CompilerMessage]
  }
  deriving (CompilerMessage -> CompilerMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilerMessage -> CompilerMessage -> Bool
$c/= :: CompilerMessage -> CompilerMessage -> Bool
== :: CompilerMessage -> CompilerMessage -> Bool
$c== :: CompilerMessage -> CompilerMessage -> Bool
Eq,Eq CompilerMessage
CompilerMessage -> CompilerMessage -> Bool
CompilerMessage -> CompilerMessage -> Ordering
CompilerMessage -> CompilerMessage -> CompilerMessage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompilerMessage -> CompilerMessage -> CompilerMessage
$cmin :: CompilerMessage -> CompilerMessage -> CompilerMessage
max :: CompilerMessage -> CompilerMessage -> CompilerMessage
$cmax :: CompilerMessage -> CompilerMessage -> CompilerMessage
>= :: CompilerMessage -> CompilerMessage -> Bool
$c>= :: CompilerMessage -> CompilerMessage -> Bool
> :: CompilerMessage -> CompilerMessage -> Bool
$c> :: CompilerMessage -> CompilerMessage -> Bool
<= :: CompilerMessage -> CompilerMessage -> Bool
$c<= :: CompilerMessage -> CompilerMessage -> Bool
< :: CompilerMessage -> CompilerMessage -> Bool
$c< :: CompilerMessage -> CompilerMessage -> Bool
compare :: CompilerMessage -> CompilerMessage -> Ordering
$ccompare :: CompilerMessage -> CompilerMessage -> Ordering
Ord)

compilerMessage :: String -> CompilerMessage
compilerMessage :: String -> CompilerMessage
compilerMessage = forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [CompilerMessage] -> CompilerMessage
CompilerMessage []

compilerMessages :: [CompilerMessage] -> CompilerMessage
compilerMessages :: [CompilerMessage] -> CompilerMessage
compilerMessages = String -> [CompilerMessage] -> CompilerMessage
CompilerMessage String
""

instance Semigroup CompilerMessage where
  (CompilerMessage String
"" [])  <> :: CompilerMessage -> CompilerMessage -> CompilerMessage
<> CompilerMessage
e2                       = CompilerMessage
e2
  CompilerMessage
e1                       <> (CompilerMessage String
"" [])  = CompilerMessage
e1
  (CompilerMessage String
"" [CompilerMessage]
es1) <> (CompilerMessage String
"" [CompilerMessage]
es2) = String -> [CompilerMessage] -> CompilerMessage
CompilerMessage String
"" ([CompilerMessage]
es1 forall a. [a] -> [a] -> [a]
++ [CompilerMessage]
es2)
  CompilerMessage
e1                       <> (CompilerMessage String
"" [CompilerMessage]
es2) = String -> [CompilerMessage] -> CompilerMessage
CompilerMessage String
"" ([CompilerMessage
e1] forall a. [a] -> [a] -> [a]
++ [CompilerMessage]
es2)
  (CompilerMessage String
"" [CompilerMessage]
es1) <> CompilerMessage
e2                       = String -> [CompilerMessage] -> CompilerMessage
CompilerMessage String
"" ([CompilerMessage]
es1 forall a. [a] -> [a] -> [a]
++ [CompilerMessage
e2])
  CompilerMessage
e1                       <> CompilerMessage
e2                       = String -> [CompilerMessage] -> CompilerMessage
CompilerMessage String
"" [CompilerMessage
e1,CompilerMessage
e2]

instance Monoid CompilerMessage where
  mempty :: CompilerMessage
mempty = String -> [CompilerMessage] -> CompilerMessage
CompilerMessage String
"" []
  mappend :: CompilerMessage -> CompilerMessage -> CompilerMessage
mappend = forall a. Semigroup a => a -> a -> a
(<>)

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

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

pushWarningScope :: String -> CompilerMessage -> CompilerMessage
pushWarningScope :: String -> CompilerMessage -> CompilerMessage
pushWarningScope String
e2 CompilerMessage
ea
  | CompilerMessage -> Bool
isEmpty CompilerMessage
ea = forall a. Monoid a => a
mempty  -- Skip the scope if there isn't already a warning.
  | Bool
otherwise  = String -> CompilerMessage -> CompilerMessage
pushErrorScope String
e2 CompilerMessage
ea

prefixCompilerMessages :: [String] -> CompilerMessage -> CompilerMessage
prefixCompilerMessages :: [String] -> CompilerMessage -> CompilerMessage
prefixCompilerMessages [String]
b (CompilerMessage String
e [CompilerMessage]
es) = String -> [CompilerMessage] -> CompilerMessage
CompilerMessage String
e ([CompilerMessage]
es forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [CompilerMessage] -> CompilerMessage
CompilerMessage []) [String]
b)

isEmpty :: CompilerMessage -> Bool
isEmpty :: CompilerMessage -> Bool
isEmpty (CompilerMessage String
"" [CompilerMessage]
ws) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CompilerMessage -> Bool
isEmpty [CompilerMessage]
ws
isEmpty CompilerMessage
_                       = Bool
False