{- -----------------------------------------------------------------------------
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
(CompilerMessage -> CompilerMessage -> Bool)
-> (CompilerMessage -> CompilerMessage -> Bool)
-> Eq CompilerMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompilerMessage -> CompilerMessage -> Bool
== :: CompilerMessage -> CompilerMessage -> Bool
$c/= :: CompilerMessage -> CompilerMessage -> Bool
/= :: CompilerMessage -> CompilerMessage -> Bool
Eq,Eq CompilerMessage
Eq CompilerMessage =>
(CompilerMessage -> CompilerMessage -> Ordering)
-> (CompilerMessage -> CompilerMessage -> Bool)
-> (CompilerMessage -> CompilerMessage -> Bool)
-> (CompilerMessage -> CompilerMessage -> Bool)
-> (CompilerMessage -> CompilerMessage -> Bool)
-> (CompilerMessage -> CompilerMessage -> CompilerMessage)
-> (CompilerMessage -> CompilerMessage -> CompilerMessage)
-> Ord 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
$ccompare :: CompilerMessage -> CompilerMessage -> Ordering
compare :: CompilerMessage -> CompilerMessage -> Ordering
$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
>= :: CompilerMessage -> CompilerMessage -> Bool
$cmax :: CompilerMessage -> CompilerMessage -> CompilerMessage
max :: CompilerMessage -> CompilerMessage -> CompilerMessage
$cmin :: CompilerMessage -> CompilerMessage -> CompilerMessage
min :: CompilerMessage -> CompilerMessage -> CompilerMessage
Ord)

compilerMessage :: String -> CompilerMessage
compilerMessage :: String -> CompilerMessage
compilerMessage = (String -> [CompilerMessage] -> CompilerMessage)
-> [CompilerMessage] -> String -> 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 [CompilerMessage] -> [CompilerMessage] -> [CompilerMessage]
forall a. [a] -> [a] -> [a]
++ [CompilerMessage]
es2)
  CompilerMessage
e1                       <> (CompilerMessage String
"" [CompilerMessage]
es2) = String -> [CompilerMessage] -> CompilerMessage
CompilerMessage String
"" ([CompilerMessage
e1] [CompilerMessage] -> [CompilerMessage] -> [CompilerMessage]
forall a. [a] -> [a] -> [a]
++ [CompilerMessage]
es2)
  (CompilerMessage String
"" [CompilerMessage]
es1) <> CompilerMessage
e2                       = String -> [CompilerMessage] -> CompilerMessage
CompilerMessage String
"" ([CompilerMessage]
es1 [CompilerMessage] -> [CompilerMessage] -> [CompilerMessage]
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 = CompilerMessage -> CompilerMessage -> CompilerMessage
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) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((CompilerMessage -> String) -> [CompilerMessage] -> [String]
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) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((CompilerMessage -> String) -> [CompilerMessage] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> CompilerMessage -> String
format (String -> CompilerMessage -> String)
-> String -> CompilerMessage -> String
forall a b. (a -> b) -> a -> b
$ String
indent String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"  ") [CompilerMessage]
ms)
    doIndent :: String -> ShowS
doIndent String
indent String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
indent String -> ShowS
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
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)
  | String -> Bool
forall a. [a] -> Bool
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 = CompilerMessage
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 [CompilerMessage] -> [CompilerMessage] -> [CompilerMessage]
forall a. [a] -> [a] -> [a]
++ (String -> CompilerMessage) -> [String] -> [CompilerMessage]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [CompilerMessage] -> CompilerMessage)
-> [CompilerMessage] -> String -> CompilerMessage
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) = (CompilerMessage -> Bool) -> [CompilerMessage] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CompilerMessage -> Bool
isEmpty [CompilerMessage]
ws
isEmpty CompilerMessage
_                       = Bool
False