{-# LANGUAGE TypeSynonymInstances #-}

{-# LANGUAGE OverloadedStrings #-}


{-# LANGUAGE FlexibleInstances #-}


-- {-# LANGUAGE ConstrainedClassMethods #-}
-- for PrettyAnn'
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstrainedClassMethods #-}

{-# LANGUAGE CPP #-}






{-|

Copyright :  (c) Andreas Reuleaux 2015 - 2018
License   :  BSD2
Maintainer:  Andreas Reuleaux <rx@a-rx.info>
Stability :  experimental
Portability: non-portable


pretty printing: core functions/classes


 -}




module PrettyCore where


import Control.Monad.Reader.Class
import Control.Monad.Reader


import Data.Text.Prettyprint.Doc
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Terminal



import qualified Data.Set as S
import Data.Semigroup ((<>))
import Control.Monad.Identity




data Ann

  -- | Used for syntactic keywords
  = Keyword

    -- | Syntax punctuation such as commas, parenthesis, and braces     
  | Syntax

    -- | Record labels
  | Label

    -- | Literals such as integers and strings
  | Literal

    -- | Builtin types and values
  | Builtin

    -- | Operators
  | Operator


  | TypeA

  | Function


  | DataA


  | BoundV


  | Delim
  | StringA

{-

+------------------------+------------+----------+
|                        | orig       | used here|
+========================+============+==========+
| bound variable         | purple     | magenta  |
+------------------------+------------+----------+
| keyword                | bold       | underlined |
+------------------------+------------+----------+
| function               | green      | green    |
+------------------------+------------+----------+

-}




{-| 

Convert annotations to their corresponding color for syntax highlighting
purposes



maybe Connor colors, cf.
<http://docs.idris-lang.org/en/latest/reference/semantic-highlighting.html>

Bound Variable 	Purple 	Magenta 	 
Keyword 	Bold 	Underlined 	 
Function 	Green 	Green 	 
Type 	        Blue 	Blue 	 
Data 	        Red 	Red 	 
Implicit 	Italic Purple 	Italic Magenta 	 


-}

annToAnsiStyle :: Ann -> Terminal.AnsiStyle
annToAnsiStyle Label    = mempty
annToAnsiStyle Builtin  = Terminal.underlined
annToAnsiStyle Operator = Terminal.bold <> Terminal.colorDull Terminal.Green
annToAnsiStyle Keyword  = Terminal.colorDull Terminal.Yellow
annToAnsiStyle Syntax   = mempty
annToAnsiStyle Function   = Terminal.colorDull Terminal.Cyan
annToAnsiStyle Literal  = Terminal.bold <> Terminal.colorDull Terminal.Green
annToAnsiStyle TypeA = Terminal.colorDull Terminal.Blue
annToAnsiStyle DataA = Terminal.colorDull Terminal.Red
annToAnsiStyle BoundV  = Terminal.colorDull Terminal.Magenta
annToAnsiStyle Delim  = Terminal.colorDull Terminal.Yellow
annToAnsiStyle StringA = Terminal.colorDull Terminal.Green





label :: Doc Ann -> Doc Ann
label    = annotate Label

builtin :: Doc Ann -> Doc Ann
builtin  = annotate Builtin

operator :: Doc Ann -> Doc Ann
operator = annotate Operator

keyword :: Doc Ann -> Doc Ann
keyword  = annotate Keyword

syntax :: Doc Ann -> Doc Ann
syntax   = annotate Syntax

literal :: Doc Ann -> Doc Ann
literal  = annotate Literal

typeA :: Doc Ann -> Doc Ann
typeA    = annotate TypeA

function :: Doc Ann -> Doc Ann
function = annotate Function


dataA :: Doc Ann -> Doc Ann
dataA    = annotate DataA


boundV :: Doc Ann -> Doc Ann
boundV = annotate BoundV




delim :: Doc Ann -> Doc Ann
delim   = annotate Delim

_string :: Doc Ann -> Doc Ann
_string    = annotate StringA



data PrettyInfo = PI
  {
    -- should we show the annotations?
    showAnnots :: Bool

  , useVars  :: Bool

    -- names that have been used
    -- dispAvoid  :: S.Set AnyName 
    , dispAvoid  :: S.Set String


  }
  deriving Show




{-|
don't show type annotations
-}


initDI :: PrettyInfo
initDI = PI {
  showAnnots = False
  , useVars = False
  , dispAvoid = S.empty
  }



{-|
show annotations
-}

initDI' :: PrettyInfo
initDI' = PI {
  showAnnots = True
  , useVars = False
  , dispAvoid = S.empty
  }



initDI'' :: PrettyInfo
initDI'' = PI {
  showAnnots = False
  , useVars = True
  , dispAvoid = S.empty
  }




{-|

pretty printing flavors

-}

data Flavor
  =  Pretty
  | Code
  | Level Int
  deriving (Show)


inc (Level i) = Level (i+1)
inc x = x


dec (Level i) = Level (i-1)
dec x = x



class PrettyAnn a where
  prettyAnn :: (Control.Monad.Reader.Class.MonadReader PrettyInfo m) => a -> m (Doc Ann)



type M a = (ReaderT PrettyInfo Identity) a







{-|

pretty printing w/
capture avoiding substitution handled differently

here only the classes

-}

class Pretty2 a where
    pretty2 :: a -> Doc ann

class PrettyAnn2 a where
  prettyAnn2 :: a -> Doc Ann




class PrettyCode a where
    prettyCode :: a -> Doc Ann





{-

formerly PrettyBasic 

-}

-- | Pretty print parentheses
parensIf :: Bool -> (Doc ann) -> (Doc ann)
parensIf True  = parens
parensIf False = id




-- | similar: Pretty print brackets
bracketsIf :: Bool -> (Doc ann) -> (Doc ann)
bracketsIf True  = parens
bracketsIf False = id




quotes p = (syntax "\"") <> p <> (syntax "\"")

delimquotes p = (delim "\"") <> p <> (delim "\"")


-- -- string quotes
-- stringquotes p = (_string "\"") <> p <> (_string "\"")
stringquotes p = _string $ "\"" <> p <> "\""



_braces p = (delim "{") <> p <> (delim "}")

_brackets p = (delim "[") <> p <> (delim "]")