diff options
Diffstat (limited to 'walint/Util.hs')
-rw-r--r-- | walint/Util.hs | 79 |
1 files changed, 79 insertions, 0 deletions
diff --git a/walint/Util.hs b/walint/Util.hs new file mode 100644 index 0000000..ef35139 --- /dev/null +++ b/walint/Util.hs @@ -0,0 +1,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 ">" ">" |