diff options
Diffstat (limited to 'src/Xanthous/Data.hs')
-rw-r--r-- | src/Xanthous/Data.hs | 18 |
1 files changed, 15 insertions, 3 deletions
diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs index b0d865fa5d79..fdeb71beb5eb 100644 --- a/src/Xanthous/Data.hs +++ b/src/Xanthous/Data.hs @@ -64,14 +64,15 @@ module Xanthous.Data , Hitpoints(..) ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude hiding (Left, Down, Right) +import Xanthous.Prelude hiding (Left, Down, Right, (.=)) import Test.QuickCheck (Arbitrary, CoArbitrary, Function) import Test.QuickCheck.Arbitrary.Generic import Data.Group import Brick (Location(Location), Edges(..)) import Data.Monoid (Product(..), Sum(..)) import Data.Aeson.Generic.DerivingVia -import Data.Aeson (ToJSON, FromJSON) +import Data.Aeson + ( ToJSON(..), FromJSON(..), object, (.=), (.:), withObject) -------------------------------------------------------------------------------- import Xanthous.Util (EqEqProp(..), EqProp) import Xanthous.Orphans () @@ -116,6 +117,7 @@ instance Arbitrary a => Arbitrary (Position' a) where arbitrary = genericArbitrary shrink = genericShrink + instance Num a => Semigroup (Position' a) where (Position x₁ y₁) <> (Position x₂ y₂) = Position (x₁ + x₂) (y₁ + y₂) @@ -134,7 +136,7 @@ instance (Ord a, Num a, Scalar a) => Scalar (Position' a) where data Positioned a where Positioned :: Position -> a -> Positioned a deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) - deriving anyclass (CoArbitrary, Function) + deriving anyclass (NFData, CoArbitrary, Function) type role Positioned representational _Positioned :: Iso (Position, a) (Position, b) (Positioned a) (Positioned b) @@ -146,6 +148,16 @@ _Positioned = iso hither yon instance Arbitrary a => Arbitrary (Positioned a) where arbitrary = Positioned <$> arbitrary <*> arbitrary +instance ToJSON a => ToJSON (Positioned a) where + toJSON (Positioned pos val) = object + [ "position" .= pos + , "data" .= val + ] + +instance FromJSON a => FromJSON (Positioned a) where + parseJSON = withObject "Positioned" $ \obj -> + Positioned <$> obj .: "position" <*> obj .: "data" + position :: Lens' (Positioned a) Position position = lens (\(Positioned pos _) -> pos) |