pretty-gist/src/Gist/Classless.hs at aedcfc3a8adbd0c658b1370cee25500451fe68a4 · ChickenProp/pretty-gist · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
module Gist.Classless
  ( Prec(..)
  , ConfigList(..)
  , defaultConfigList
  , gistList
  , ConfigMaybe(..)
  , defaultConfigMaybe
  , gistMaybe
  , gistPrintfily
  , gistShowily
  , parensIf
  , record
  ) where

import           Data.Maybe                     ( isJust )
import           GHC.Generics                   ( Generic )
import           Prettyprinter
import qualified Text.Printf                   as Printf

newtype Prec = Prec Int
  deriving newtype (Eq, Ord, Num)

data ConfigList = ConfigList
  { showFirst :: Maybe Int
  }
  deriving stock Generic

defaultConfigList :: ConfigList
defaultConfigList = ConfigList { showFirst = Nothing }

gistList :: ConfigList -> (Prec -> a -> Doc ann) -> Prec -> [a] -> Doc ann
gistList (ConfigList {..}) renderElem _ xs =
  let elems = case showFirst of
        Nothing -> renderElem 0 <$> xs
        Just n  -> case splitAt n xs of
          (start, []   ) -> renderElem 0 <$> start
          (start, _ : _) -> (renderElem 0 <$> start) ++ ["..."]
  in  align $ list elems

data ConfigMaybe = ConfigMaybe
  { showConstructors :: Bool
  }
  deriving stock Generic

defaultConfigMaybe :: ConfigMaybe
defaultConfigMaybe = ConfigMaybe { showConstructors = False }

gistMaybe
  :: ConfigMaybe -> (Prec -> a -> Doc ann) -> Prec -> Maybe a -> Doc ann
gistMaybe (ConfigMaybe {..}) renderElem prec = if showConstructors
  then \case
    Nothing -> "Nothing"
    Just a  -> parensIf (prec > 10) $ "Just" <+> renderElem 11 a
  else \case
    Nothing -> "_"
    Just a  -> renderElem prec a

data ConfigPrintf = ConfigPrintf
  { printfFmt :: String
  }
  deriving stock Generic

gistPrintfily :: Printf.PrintfArg a => ConfigPrintf -> Prec -> a -> Doc ann
gistPrintfily (ConfigPrintf {..}) _ a =
  pretty (Printf.printf printfFmt a :: String)

gistShowily :: Show a => Prec -> a -> Doc ann
gistShowily (Prec prec) a = pretty $ showsPrec prec a ""

parensIf :: Bool -> Doc ann -> Doc ann
parensIf cond = if cond then parens else id

record :: Prec -> Maybe (Doc ann) -> [(Doc ann, Doc ann)] -> Doc ann
record prec mConstr fields =
  parensIf (prec > 10 && isJust mConstr)
    $ maybe id (\constr contents -> constr <+> align contents) mConstr
    $ group
    $ encloseSep (flatAlt "{ " "{") (flatAlt "\n}" "}") ", "
    $ flip map fields
    $ \(key, val) -> key <+> "=" <+> val