Skip to content
Snippets Groups Projects
Select Git revision
  • d8fc586c3cda7c44c4b0b6993c7f2e2aee6f69ac
  • master default protected
  • ldap_user_conn_test
3 results

utils.py

Blame
  • Forked from uffd / uffd
    Source project has a limited visibility.
    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 "<" "&lt;" . T.replace ">" "&gt;"