{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Helpers for pretty printing
module Dino.Pretty where

import Prelude

import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.List (sortOn)
import Data.String (IsString)
import GHC.Generics (Generic)
import Text.PrettyPrint.ANSI.Leijen (Doc, Pretty (..), (<+>))
import qualified Text.PrettyPrint.ANSI.Leijen as PP

data Importance
  = Unimportant
  | Important
  deriving (Importance -> Importance -> Bool
(Importance -> Importance -> Bool)
-> (Importance -> Importance -> Bool) -> Eq Importance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Importance -> Importance -> Bool
$c/= :: Importance -> Importance -> Bool
== :: Importance -> Importance -> Bool
$c== :: Importance -> Importance -> Bool
Eq, Int -> Importance -> ShowS
[Importance] -> ShowS
Importance -> String
(Int -> Importance -> ShowS)
-> (Importance -> String)
-> ([Importance] -> ShowS)
-> Show Importance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Importance] -> ShowS
$cshowList :: [Importance] -> ShowS
show :: Importance -> String
$cshow :: Importance -> String
showsPrec :: Int -> Importance -> ShowS
$cshowsPrec :: Int -> Importance -> ShowS
Show, (forall x. Importance -> Rep Importance x)
-> (forall x. Rep Importance x -> Importance) -> Generic Importance
forall x. Rep Importance x -> Importance
forall x. Importance -> Rep Importance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Importance x -> Importance
$cfrom :: forall x. Importance -> Rep Importance x
Generic)

-- | Returns 'Important' iff. any argument is 'Important'.
instance Semigroup Importance where
  Importance
Unimportant <> :: Importance -> Importance -> Importance
<> Importance
Unimportant = Importance
Unimportant
  Importance
_ <> Importance
_ = Importance
Important

instance Hashable Importance

-- | Marks a part of a value that hasn't changed
unchanged :: Doc
unchanged :: Doc
unchanged = Doc -> Doc
PP.magenta (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text String
"*"

-- | Emphasize when 'Important'
emphasize :: Importance -> Doc -> Doc
emphasize :: Importance -> Doc -> Doc
emphasize Importance
Unimportant = Doc -> Doc
forall a. a -> a
id
emphasize Importance
Important = Doc -> Doc
PP.bold (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
PP.blue

-- | Place a document indented under a header:
--
-- > header
-- >   doc
-- >   doc
-- >   ...
underHeader ::
     Doc -- ^ Header
  -> Doc -- ^ Document to place under the header
  -> Doc
underHeader :: Doc -> Doc -> Doc
underHeader Doc
h Doc
d = Doc
h Doc -> Doc -> Doc
PP.<$> Doc
PP.space Doc -> Doc -> Doc
<+> Doc -> Doc
PP.align Doc
d

-- | Render a list of documents as follows:
--
-- > [ a
-- > , b
-- > , ...
-- > ]
--
-- where @'['@, @','@ and @']'@ are provided as the first three parameters.
verticalList :: Doc -> Doc -> Doc -> [Doc] -> Doc
verticalList :: Doc -> Doc -> Doc -> [Doc] -> Doc
verticalList Doc
l Doc
_ Doc
r [] = Doc
l Doc -> Doc -> Doc
<+> Doc
r
verticalList Doc
l Doc
sep Doc
r [Doc]
ds =
  [Doc] -> Doc
PP.vcat [Doc
c Doc -> Doc -> Doc
<+> Doc -> Doc
PP.align Doc
d | (Doc
c, Doc
d) <- [Doc] -> [Doc] -> [(Doc, Doc)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Doc
l Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat Doc
sep) [Doc]
ds] Doc -> Doc -> Doc
PP.<$> Doc
r

-- | A wrapper for 'String' with a 'Show' instance that omits quotes
--
-- Useful in situations where 'show' is (ab)used to provide conversion to
-- 'String' rather than for displaying values.
newtype Field = Field {Field -> String
unField :: String}
  deriving (Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, Eq Field
Eq Field
-> (Field -> Field -> Ordering)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Field)
-> (Field -> Field -> Field)
-> Ord Field
Field -> Field -> Bool
Field -> Field -> Ordering
Field -> Field -> Field
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 :: Field -> Field -> Field
$cmin :: Field -> Field -> Field
max :: Field -> Field -> Field
$cmax :: Field -> Field -> Field
>= :: Field -> Field -> Bool
$c>= :: Field -> Field -> Bool
> :: Field -> Field -> Bool
$c> :: Field -> Field -> Bool
<= :: Field -> Field -> Bool
$c<= :: Field -> Field -> Bool
< :: Field -> Field -> Bool
$c< :: Field -> Field -> Bool
compare :: Field -> Field -> Ordering
$ccompare :: Field -> Field -> Ordering
$cp1Ord :: Eq Field
Ord, String -> Field
(String -> Field) -> IsString Field
forall a. (String -> a) -> IsString a
fromString :: String -> Field
$cfromString :: String -> Field
IsString, Eq Field
Eq Field
-> (Int -> Field -> Int) -> (Field -> Int) -> Hashable Field
Int -> Field -> Int
Field -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Field -> Int
$chash :: Field -> Int
hashWithSalt :: Int -> Field -> Int
$chashWithSalt :: Int -> Field -> Int
$cp1Hashable :: Eq Field
Hashable)

instance Show Field where
  show :: Field -> String
show = Field -> String
unField

instance Pretty Field where
  pretty :: Field -> Doc
pretty = String -> Doc
PP.string (String -> Doc) -> (Field -> String) -> Field -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> String
unField

-- | Render a record as follows:
--
-- > { field1 =
-- >     value1
-- > , field2 =
-- >     value2
-- > ,  ...
-- > }
--
-- If @k@ is a 'String'-like type, it will be shown with quotes. Use 'Field' to
-- prevent this.
prettyRecord :: (Show k, Ord k) => Importance -> HashMap k Doc -> Doc
prettyRecord :: Importance -> HashMap k Doc -> Doc
prettyRecord Importance
imp =
  Doc -> Doc -> Doc -> [Doc] -> Doc
verticalList Doc
PP.lbrace Doc
PP.comma Doc
PP.rbrace ([Doc] -> Doc) -> (HashMap k Doc -> [Doc]) -> HashMap k Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ((k, Doc) -> Doc) -> [(k, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (k, Doc) -> Doc
prettyField ([(k, Doc)] -> [Doc])
-> (HashMap k Doc -> [(k, Doc)]) -> HashMap k Doc -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, Doc) -> k) -> [(k, Doc)] -> [(k, Doc)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (k, Doc) -> k
forall a b. (a, b) -> a
fst ([(k, Doc)] -> [(k, Doc)])
-> (HashMap k Doc -> [(k, Doc)]) -> HashMap k Doc -> [(k, Doc)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k Doc -> [(k, Doc)]
forall k v. HashMap k v -> [(k, v)]
HM.toList
  where
    prettyField :: (k, Doc) -> Doc
prettyField (k
f, Doc
v) =
      Doc -> Doc -> Doc
underHeader (Importance -> Doc -> Doc
emphasize Importance
imp (String -> Doc
PP.string (k -> String
forall a. Show a => a -> String
show k
f)) Doc -> Doc -> Doc
<+> String -> Doc
PP.string String
"=") Doc
v