Something went wrong on our end
Select Git revision
Forked from
hub / hub
Source project has a limited visibility.
-
Andreas Hubel authoredAndreas Hubel authored
Util.hs 2.40 KiB
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-- | has (perhaps inevitably) morphed into a module that mostly
-- concerns itself with wrangling haskell's string types
module Util where
import Data.Aeson as Aeson
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Tiled (Layer (layerData), PropertyValue (..),
Tileset (tilesetName), layerName, mkTiledId)
-- | helper function to create proxies
mkProxy :: a -> Proxy a
mkProxy = const Proxy
-- | haskell's many string types are FUN …
showText :: Show a => a -> Text
showText = T.pack . show
-- | 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 -> (T.pack . 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 -> showText int
FloatProp float -> showText 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 . T.unpack . prettyprint
layerIsEmpty :: Layer -> Bool
layerIsEmpty layer = case layerData layer of
Nothing -> True
Just d -> all ((==) $ mkTiledId 0) d
-- | 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 ">" ">"