blob: 5ec1b12f95ffbdf6ba8924b19abf42bb4d23a86d (
plain)
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
|
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Util
( mkProxy
, PrettyPrint(..)
, printPretty
, naiveEscapeHTML
, ellipsis
) where
import Universum
import Data.Aeson as Aeson
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Tiled (Layer, PropertyValue (..),
Tileset (tilesetName), layerName)
-- | helper function to create proxies
mkProxy :: a -> Proxy a
mkProxy = const Proxy
-- | a class to address all the string conversions necessary
-- when using Show to much that just uses Text instead
class PrettyPrint a where
prettyprint :: a -> Text
-- | let's see if this is a good idea or makes type inference bite us
instance PrettyPrint Text where
prettyprint text = "\"" <> text <> "\""
-- | same as show json, but without the "String" prefix for json strings
instance PrettyPrint Aeson.Value where
prettyprint = \case
Aeson.String s -> prettyprint s
v -> show v
instance PrettyPrint t => PrettyPrint (Set t) where
prettyprint = prettyprint . S.toList
instance PrettyPrint PropertyValue where
prettyprint = \case
StrProp str -> str
BoolProp bool -> if bool then "true" else "false"
IntProp int -> show int
FloatProp float -> show float
-- | here since Unit is sometimes used as dummy type
instance PrettyPrint () where
prettyprint _ = error "shouldn't pretty-print Unit"
instance PrettyPrint Layer where
prettyprint = (<>) "layer " . layerName
instance PrettyPrint Tileset where
prettyprint = (<>) "tileset " . tilesetName
instance PrettyPrint a => PrettyPrint [a] where
prettyprint = T.intercalate ", " . fmap prettyprint
printPretty :: PrettyPrint a => a -> IO ()
printPretty = putStr . toString . prettyprint
-- | for long lists which shouldn't be printed out in their entirety
ellipsis :: Int -> [Text] -> Text
ellipsis i texts
| i < l = prettyprint (take i texts) <> " ... (and " <> show (l-i) <> " more)"
| otherwise = prettyprint texts
where l = length texts
-- | naive escaping of html sequences, just to be sure that
-- | workadventure won't mess things up again …
naiveEscapeHTML :: Text -> Text
naiveEscapeHTML = T.replace "<" "<" . T.replace ">" ">"
|
