{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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)
instance Semigroup Importance where
Importance
Unimportant <> :: Importance -> Importance -> Importance
<> Importance
Unimportant = Importance
Unimportant
Importance
_ <> Importance
_ = Importance
Important
instance Hashable Importance
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 :: 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
underHeader ::
Doc
-> Doc
-> Doc
Doc
h Doc
d = Doc
h Doc -> Doc -> Doc
PP.<$> Doc
PP.space Doc -> Doc -> Doc
<+> Doc -> Doc
PP.align Doc
d
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
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
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