diff options
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs')
-rw-r--r-- | users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs | 56 |
1 files changed, 0 insertions, 56 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs deleted file mode 100644 index 855a3462daee..000000000000 --- a/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE TemplateHaskell #-} --------------------------------------------------------------------------------- -module Xanthous.Data.EntityChar - ( EntityChar(..) - , HasChar(..) - , HasStyle(..) - ) where --------------------------------------------------------------------------------- -import Xanthous.Prelude hiding ((.=)) --------------------------------------------------------------------------------- -import qualified Graphics.Vty.Attributes as Vty -import Test.QuickCheck -import Data.Aeson --------------------------------------------------------------------------------- -import Xanthous.Orphans () -import Xanthous.Util.QuickCheck (GenericArbitrary(..)) --------------------------------------------------------------------------------- - - -class HasChar s a | s -> a where - char :: Lens' s a - {-# MINIMAL char #-} - -data EntityChar = EntityChar - { _char :: Char - , _style :: Vty.Attr - } - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData, CoArbitrary, Function) - deriving Arbitrary via GenericArbitrary EntityChar -makeFieldsNoPrefix ''EntityChar - -instance FromJSON EntityChar where - parseJSON (String (chr :< Empty)) = pure $ EntityChar chr Vty.defAttr - parseJSON (Object o) = do - (EntityChar _char _) <- o .: "char" - _style <- o .:? "style" .!= Vty.defAttr - pure EntityChar {..} - parseJSON _ = fail "Invalid type, expected string or object" - -instance ToJSON EntityChar where - toJSON (EntityChar chr styl) - | styl == Vty.defAttr = String $ chr <| Empty - | otherwise = object - [ "char" .= chr - , "style" .= styl - ] - -instance IsString EntityChar where - fromString [ch] = EntityChar ch Vty.defAttr - fromString _ = error "Entity char must only be a single character" |