summaryrefslogtreecommitdiff
path: root/walint/Util.hs
diff options
context:
space:
mode:
authorstuebinm2023-10-23 23:18:34 +0200
committerstuebinm2023-10-24 01:21:52 +0200
commit9110064fe62f98dd3ecc5fb4c3915a843492b8fb (patch)
tree6a8e3d54bef365bf1c6c4f72a7a75dd5d1f05d40 /walint/Util.hs
parenta4461ce5d73a617e614e259bfe30b4e895c38a19 (diff)
a year went byHEADmain
This does many meta-things, but changes no functionality: - get rid of stack, and use just cabal with a stackage snapshot instead (why did I ever think stack was a good idea?) - update the stackage snapshot to something halfway recent - thus making builds work on nixpkgs-23.05 (current stable) - separating out packages into their own cabal files - use the GHC2021 set of extensions as default - very slight code changes to make things build again - update readme accordingly - stylish-haskell run
Diffstat (limited to 'walint/Util.hs')
-rw-r--r--walint/Util.hs79
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 "<" "&lt;" . T.replace ">" "&gt;"