From 8b97683f6ef53605130542ea6de1e587b353aa5b Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 19 Jun 2021 10:42:32 -0400 Subject: feat(xanthous): Track the volume and density of item types Allow the itemType raw to have density and volume fields, both of which represent *intervals* of both density and volume (because both can hypothetically vary a bit). The idea here is that when we're making an *instance* of one of these items, we pick a random value in the range. Lots of stuff in this commit is datatype and typeclass instances to support things like intervals being fields on datatypes that get serialized to saved games - including a manual definition of Ord for Item since Ord isn't well-defined for intervals Change-Id: Ia088f2f75cdce9d00560297e5c269e3310b85bc3 Reviewed-on: https://cl.tvl.fyi/c/depot/+/3225 Reviewed-by: grfn Tested-by: BuildkiteCI --- users/grfn/xanthous/package.yaml | 1 + .../xanthous/src/Data/Aeson/Generic/DerivingVia.hs | 3 +- users/grfn/xanthous/src/Xanthous/App.hs | 3 +- .../grfn/xanthous/src/Xanthous/App/Autocommands.hs | 2 +- users/grfn/xanthous/src/Xanthous/Data.hs | 68 ++++++++++-- .../xanthous/src/Xanthous/Entities/RawTypes.hs | 21 +++- .../src/Xanthous/Entities/Raws/noodles.yaml | 2 + .../xanthous/src/Xanthous/Entities/Raws/stick.yaml | 4 + users/grfn/xanthous/src/Xanthous/Orphans.hs | 115 +++++++++++++++++++-- users/grfn/xanthous/test/Test/Prelude.hs | 29 ++++-- users/grfn/xanthous/test/Xanthous/OrphansSpec.hs | 34 +++++- users/grfn/xanthous/xanthous.cabal | 6 +- 12 files changed, 255 insertions(+), 33 deletions(-) (limited to 'users/grfn') diff --git a/users/grfn/xanthous/package.yaml b/users/grfn/xanthous/package.yaml index 3939d52a51e7..fa217f80dc59 100644 --- a/users/grfn/xanthous/package.yaml +++ b/users/grfn/xanthous/package.yaml @@ -94,6 +94,7 @@ default-extensions: - GADTSyntax - GeneralizedNewtypeDeriving - KindSignatures +- StandaloneKindSignatures - LambdaCase - MultiWayIf - NoImplicitPrelude diff --git a/users/grfn/xanthous/src/Data/Aeson/Generic/DerivingVia.hs b/users/grfn/xanthous/src/Data/Aeson/Generic/DerivingVia.hs index 34f2a9403892..e89fcd621157 100644 --- a/users/grfn/xanthous/src/Data/Aeson/Generic/DerivingVia.hs +++ b/users/grfn/xanthous/src/Data/Aeson/Generic/DerivingVia.hs @@ -89,7 +89,8 @@ type TagSingleConstructors = 'TagSingleConstructors class Demotable (a :: k) where demote :: proxy a -> Demoted k -type family All (p :: Type -> Constraint) (xs :: [k]) :: Constraint where +type All :: (Type -> Constraint) -> [Type] -> Constraint +type family All p xs where All p '[] = () All p (x ': xs) = (p x, All p xs) diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs index 1e915a03fe05..6ed545e3aa4f 100644 --- a/users/grfn/xanthous/src/Xanthous/App.hs +++ b/users/grfn/xanthous/src/Xanthous/App.hs @@ -32,6 +32,7 @@ import Xanthous.Data , position , Position , (|*|) + , Tiles(..) ) import Xanthous.Data.App (ResourceName, Panel(..), AppEvent(..)) import qualified Xanthous.Data.EntityMap as EntityMap @@ -127,7 +128,7 @@ handleCommand (Move dir) = do collisionAt newPos >>= \case Nothing -> do characterPosition .= newPos - stepGameBy =<< uses (character . speed) (|*| 1) + stepGameBy =<< uses (character . speed) (|*| Tiles 1) describeEntitiesAt newPos Just Combat -> attackAt newPos Just Stop -> pure () diff --git a/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs b/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs index 5892536137b0..5d4db1a47465 100644 --- a/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs +++ b/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs @@ -30,7 +30,7 @@ autoStep (AutoMove dir) = do collisionAt newPos >>= \case Nothing -> do characterPosition .= newPos - stepGameBy =<< uses (character . speed) (|*| 1) + stepGameBy =<< uses (character . speed) (|*| (1 :: Tiles)) describeEntitiesAt newPos cancelIfDanger Just _ -> cancelAutocommand diff --git a/users/grfn/xanthous/src/Xanthous/Data.hs b/users/grfn/xanthous/src/Xanthous/Data.hs index c9c11b553b67..89d0993b4e59 100644 --- a/users/grfn/xanthous/src/Xanthous/Data.hs +++ b/users/grfn/xanthous/src/Xanthous/Data.hs @@ -3,8 +3,6 @@ {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE NoTypeSynonymInstances #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -56,6 +54,10 @@ module Xanthous.Data , TicksPerTile , TilesPerTick , timesTiles + , Square(..) + , Cubic(..) + , Grams + , Meters -- * , Dimensions'(..) @@ -490,9 +492,9 @@ rotations orig@(Neighbors tl t tr l r bl b br) = V4 newtype Per a b = Rate Double deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) - deriving (Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON) via Double + deriving (Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON) + via Double deriving (Semigroup, Monoid) via Product Double -instance Arbitrary (Per a b) where arbitrary = genericArbitrary invertRate :: a `Per` b -> b `Per` a invertRate (Rate p) = Rate $ 1 / p @@ -500,9 +502,42 @@ invertRate (Rate p) = Rate $ 1 / p invertedRate :: Iso (a `Per` b) (b' `Per` a') (b `Per` a) (a' `Per` b') invertedRate = iso invertRate invertRate +type (:*:) :: Type -> Type -> Type +type family (:*:) a b where + (a `Per` b) :*: b = a + (Square a) :*: a = Cubic a + a :*: a = Square a + infixl 7 |*| -(|*|) :: (Scalar a, Scalar b) => a `Per` b -> b -> a -(|*|) (Rate rate) b = fromScalar $ rate * scalar b +class MulUnit a b where + (|*|) :: a -> b -> a :*: b + +instance (Scalar a, Scalar b) => MulUnit (a `Per` b) b where + (Rate rate) |*| b = fromScalar $ rate * scalar b + +instance forall a. (Scalar a, a :*: a ~ Square a) => MulUnit a a where + x' |*| y' = Square @a . fromScalar $ scalar x' * scalar y' + +instance forall a. (Scalar a) => MulUnit (Square a) a where + x' |*| y' = Cubic @a . fromScalar $ scalar x' * scalar y' + +newtype Square a = Square a + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving ( Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON + , Scalar + ) + via a + +newtype Cubic a = Cubic a + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving ( Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON + , Scalar + ) + via a + +-------------------------------------------------------------------------------- newtype Ticks = Ticks Word deriving stock (Show, Eq, Generic) @@ -510,14 +545,14 @@ newtype Ticks = Ticks Word deriving (Num, Ord, Bounded, Enum, Integral, Real, ToJSON, FromJSON) via Word deriving (Semigroup, Monoid) via (Sum Word) deriving Scalar via ScalarIntegral Ticks -instance Arbitrary Ticks where arbitrary = genericArbitrary + deriving Arbitrary via GenericArbitrary Ticks newtype Tiles = Tiles Double deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving (Num, Ord, Enum, Real, ToJSON, FromJSON, Scalar) via Double deriving (Semigroup, Monoid) via (Sum Double) -instance Arbitrary Tiles where arbitrary = genericArbitrary + deriving Arbitrary via GenericArbitrary Tiles type TicksPerTile = Ticks `Per` Tiles type TilesPerTick = Tiles `Per` Ticks @@ -534,6 +569,23 @@ newtype Hitpoints = Hitpoints Word via Word deriving (Semigroup, Monoid) via Sum Word +-------------------------------------------------------------------------------- + +-- | Grams, the fundamental measure of weight in Xanthous. +newtype Grams = Grams Double + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving ( Arbitrary, Num, Ord, Enum, Real, Floating, Fractional, RealFloat + , RealFrac, Scalar, ToJSON, FromJSON + ) + via Double + deriving (Semigroup, Monoid) via Sum Double + +-- | Every tile is 1 meter +type Meters = Tiles + + + -------------------------------------------------------------------------------- data Box a = Box diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs index b7c5fe31c995..88070ed7b8bd 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs @@ -51,11 +51,12 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Messages (Message(..)) -import Xanthous.Data (TicksPerTile, Hitpoints) +import Xanthous.Data (TicksPerTile, Hitpoints, Per, Grams, Cubic, Meters) import Xanthous.Data.EntityChar import Xanthous.Util.QuickCheck import Xanthous.Generators.Speech (Language, gormlak, english) import Xanthous.Orphans () +import Data.Interval (Interval, lowerBound', upperBound') -------------------------------------------------------------------------------- -- | Identifiers for languages that creatures can speak. @@ -153,10 +154,12 @@ data ItemType = ItemType , _description :: !Text , _longDescription :: !Text , _char :: !EntityChar + , _density :: !(Interval (Grams `Per` Cubic Meters)) + , _volume :: !(Interval (Cubic Meters)) , _edible :: !(Maybe EdibleItem) , _wieldable :: !(Maybe WieldableItem) } - deriving stock (Show, Eq, Ord, Generic) + deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving Arbitrary via GenericArbitrary ItemType deriving (ToJSON, FromJSON) @@ -164,6 +167,20 @@ data ItemType = ItemType ItemType makeFieldsNoPrefix ''ItemType +instance Ord ItemType where + compare x y + = compareOf name x y + <> compareOf description x y + <> compareOf longDescription x y + <> compareOf char x y + <> compareOf (density . to extractInterval) x y + <> compareOf (volume . to extractInterval) x y + <> compareOf edible x y + <> compareOf wieldable x y + where + compareOf l = comparing (view l) + extractInterval = lowerBound' &&& upperBound' + -- | Can this item be eaten? isEdible :: ItemType -> Bool isEdible = has $ edible . _Just diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml index c3f19dce91d1..c0501a18a8e0 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml @@ -10,3 +10,5 @@ Item: hitpointsHealed: 2 eatMessage: - You slurp up the noodles. Yumm! + density: 500000 + volume: 0.001 diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml index bc7fde4d8b02..4100808ca071 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml @@ -12,3 +12,7 @@ Item: - You bonk the {{creature.creatureType.name}} over the head with your stick. - You bash the {{creature.creatureType.name}} on the noggin with your stick. - You whack the {{creature.creatureType.name}} with your stick. + # https://www.sciencedirect.com/topics/agricultural-and-biological-sciences/wood-density + # it's a hard stick. so it's dense wood. + density: 890000 # g/m³ + volume: [ 0.003, 0.006 ] # ≈3.5 cm radius × ≈1m length diff --git a/users/grfn/xanthous/src/Xanthous/Orphans.hs b/users/grfn/xanthous/src/Xanthous/Orphans.hs index e6ea1310319b..0b282af44ca0 100644 --- a/users/grfn/xanthous/src/Xanthous/Orphans.hs +++ b/users/grfn/xanthous/src/Xanthous/Orphans.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE PackageImports #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE PackageImports #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-type-defaults #-} -------------------------------------------------------------------------------- -{-# OPTIONS_GHC -Wno-deferred-type-errors #-} module Xanthous.Orphans ( ppTemplate ) where @@ -28,11 +28,15 @@ import Text.Mustache import Text.Mustache.Type ( showKey ) import Control.Monad.State import Linear +import qualified Data.Interval as Interval +import Data.Interval ( Interval, Extended (..), Boundary (..) + , lowerBound', upperBound', (<=..<), (<=..<=) + , interval) +import Test.QuickCheck.Checkers (EqProp ((=-=))) -------------------------------------------------------------------------------- import Xanthous.Util.JSON import Xanthous.Util.QuickCheck -import qualified Data.Interval as Interval -import Data.Interval (Interval, Extended (..)) +import Xanthous.Util (EqEqProp(EqEqProp)) -------------------------------------------------------------------------------- instance forall s a. @@ -241,6 +245,8 @@ instance CoArbitrary a => CoArbitrary (MaybeDefault a) where instance (Eq a, Show a, Read a, Function a) => Function (MaybeDefault a) where function = functionShow +deriving via (EqEqProp Attr) instance EqProp Attr + instance Arbitrary Attr where arbitrary = do attrStyle <- arbitrary @@ -367,12 +373,46 @@ instance Function a => Function (V2 a) -------------------------------------------------------------------------------- -instance Arbitrary r => Arbitrary (Extended r) where +instance CoArbitrary Boundary +instance Function Boundary + +instance Arbitrary a => Arbitrary (Extended a) where arbitrary = oneof [ pure NegInf , pure PosInf , Finite <$> arbitrary ] +instance CoArbitrary a => CoArbitrary (Extended a) where + coarbitrary NegInf = variant 1 + coarbitrary PosInf = variant 2 + coarbitrary (Finite x) = variant 3 . coarbitrary x + +instance (Function a) => Function (Extended a) where + function = functionMap g h + where + g NegInf = Left True + g (Finite a) = Right a + g PosInf = Left False + h (Left False) = PosInf + h (Left True) = NegInf + h (Right a) = Finite a + +instance ToJSON a => ToJSON (Extended a) where + toJSON NegInf = String "NegInf" + toJSON PosInf = String "PosInf" + toJSON (Finite x) = toJSON x + +instance FromJSON a => FromJSON (Extended a) where + parseJSON (String "NegInf") = pure NegInf + parseJSON (String "PosInf") = pure PosInf + parseJSON val = Finite <$> parseJSON val + +instance (EqProp a, Show a) => EqProp (Extended a) where + NegInf =-= NegInf = property True + PosInf =-= PosInf = property True + (Finite x) =-= (Finite y) = x =-= y + x =-= y = counterexample (show x <> " /= " <> show y) False + instance Arbitrary Interval.Boundary where arbitrary = elements [ Interval.Open , Interval.Closed ] @@ -384,3 +424,60 @@ instance (Ord r, Arbitrary r) => Arbitrary (Interval r) where Interval.interval lower upper + +instance CoArbitrary a => CoArbitrary (Interval a) where + coarbitrary int = coarbitrary (lowerBound' int) . coarbitrary (upperBound' int) + +instance (Function a, Ord a) => Function (Interval a) where + function = functionMap g h + where + g = lowerBound' &&& upperBound' + h = uncurry interval + +deriving via (EqEqProp (Interval a)) instance Eq a => (EqProp (Interval a)) + +instance ToJSON a => ToJSON (Interval a) where + toJSON x = Array . fromList $ + [ object [ lowerKey .= lowerVal ] + , object [ upperKey .= upperVal ] + ] + where + (lowerVal, lowerBoundary) = lowerBound' x + (upperVal, upperBoundary) = upperBound' x + upperKey = boundaryToKey upperBoundary + lowerKey = boundaryToKey lowerBoundary + boundaryToKey Open = "Excluded" + boundaryToKey Closed = "Included" + +instance forall a. (FromJSON a, Ord a) => FromJSON (Interval a) where + parseJSON x = + boundPairWithBoundary x + <|> boundPairWithoutBoundary x + <|> singleVal x + where + boundPairWithBoundary = withArray "Bound pair" $ \arr -> do + checkLength arr + lower <- parseBound $ arr ^?! ix 0 + upper <- parseBound $ arr ^?! ix 1 + pure $ interval lower upper + parseBound = withObject "Bound" $ \obj -> do + when (length obj /= 1) $ fail "Expected an object with a single key" + let [(k, v)] = obj ^@.. ifolded + boundary <- case k of + "Excluded" -> pure Open + "Open" -> pure Open + "Included" -> pure Closed + "Closed" -> pure Closed + _ -> fail "Invalid boundary specification" + val <- parseJSON v + pure (val, boundary) + boundPairWithoutBoundary = withArray "Bound pair" $ \arr -> do + checkLength arr + lower <- parseJSON $ arr ^?! ix 0 + upper <- parseJSON $ arr ^?! ix 1 + pure $ lower <=..< upper + singleVal v = do + val <- parseJSON v + pure $ val <=..<= val + checkLength arr = + when (length arr /= 2) $ fail "Expected array of length 2" diff --git a/users/grfn/xanthous/test/Test/Prelude.hs b/users/grfn/xanthous/test/Test/Prelude.hs index c423796184f7..2df0a6290a02 100644 --- a/users/grfn/xanthous/test/Test/Prelude.hs +++ b/users/grfn/xanthous/test/Test/Prelude.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +-------------------------------------------------------------------------------- module Test.Prelude ( module Xanthous.Prelude , module Test.Tasty @@ -5,15 +7,26 @@ module Test.Prelude , module Test.Tasty.QuickCheck , module Test.QuickCheck.Classes , testBatch + , jsonRoundTrip ) where - -import Xanthous.Prelude hiding (assert, elements) -import Test.Tasty -import Test.Tasty.QuickCheck -import Test.Tasty.HUnit -import Test.QuickCheck.Classes -import Test.QuickCheck.Checkers (TestBatch) -import Test.QuickCheck.Instances.ByteString () +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (assert, elements) +-------------------------------------------------------------------------------- +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.QuickCheck.Classes +import Test.QuickCheck.Checkers (TestBatch, EqProp ((=-=))) +import Test.QuickCheck.Instances.ByteString () +-------------------------------------------------------------------------------- +import qualified Data.Aeson as JSON +import Data.Aeson (ToJSON, FromJSON) +-------------------------------------------------------------------------------- testBatch :: TestBatch -> TestTree testBatch (name, tests) = testGroup name $ uncurry testProperty <$> tests + +jsonRoundTrip + :: forall a. (ToJSON a, FromJSON a, EqProp a, Arbitrary a, Show a) => TestTree +jsonRoundTrip = testProperty "JSON round trip" $ \(x :: a) -> + JSON.decode (JSON.encode x) =-= Just x diff --git a/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs b/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs index 3740945877ef..0d800e8a91de 100644 --- a/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs +++ b/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedLists #-} -------------------------------------------------------------------------------- module Xanthous.OrphansSpec where -------------------------------------------------------------------------------- @@ -8,6 +9,10 @@ import Text.Mustache import Text.Megaparsec (errorBundlePretty) import Graphics.Vty.Attributes import qualified Data.Aeson as JSON +import Data.Interval (Interval, (<=..<=), (<=..<), (<..<=)) +import Data.Aeson ( ToJSON(toJSON), object, Value(Array) ) +import Data.Aeson.Types (fromJSON) +import Data.IntegerInterval (Extended(Finite)) -------------------------------------------------------------------------------- import Xanthous.Orphans -------------------------------------------------------------------------------- @@ -36,7 +41,32 @@ test = testGroup "Xanthous.Orphans" $ JSON.decode (JSON.encode tpl) === Just tpl ] , testGroup "Attr" - [ testProperty "JSON round trip" $ \(attr :: Attr) -> - JSON.decode (JSON.encode attr) === Just attr + [ jsonRoundTrip @Attr ] + , testGroup "Extended" + [ jsonRoundTrip @(Extended Int) ] + , testGroup "Interval" + [ testGroup "JSON" + [ jsonRoundTrip @(Interval Int) + , testCase "parses a single value as a length-1 interval" $ + getSuccess (fromJSON $ toJSON (1 :: Int)) + @?= Just (Finite (1 :: Int) <=..<= Finite 1) + , testCase "parses a pair of values as a single-ended interval" $ + getSuccess (fromJSON $ toJSON ([1, 2] :: [Int])) + @?= Just (Finite (1 :: Int) <=..< Finite (2 :: Int)) + , testCase "parses the full included/excluded syntax" $ + getSuccess (fromJSON $ Array [ object [ "Excluded" JSON..= (1 :: Int) ] + , object [ "Included" JSON..= (4 :: Int) ] + ]) + @?= Just (Finite (1 :: Int) <..<= Finite (4 :: Int)) + , testCase "parses open/closed as aliases" $ + getSuccess (fromJSON $ Array [ object [ "Open" JSON..= (1 :: Int) ] + , object [ "Closed" JSON..= (4 :: Int) ] + ]) + @?= Just (Finite (1 :: Int) <..<= Finite (4 :: Int)) + ] ] ] + where + getSuccess :: JSON.Result a -> Maybe a + getSuccess (JSON.Error _) = Nothing + getSuccess (JSON.Success r) = Just r diff --git a/users/grfn/xanthous/xanthous.cabal b/users/grfn/xanthous/xanthous.cabal index 4cbabdb58eba..baa09fab3e36 100644 --- a/users/grfn/xanthous/xanthous.cabal +++ b/users/grfn/xanthous/xanthous.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: b39d4dd906804ca42f8965c2dbe519434e80622fef7fafce1dca0d211a1c6663 +-- hash: fdfa821ad291b11a2d7a7ee9cc38d7980a9b1f494b77216b141d3424168d621d name: xanthous version: 0.1.0.0 @@ -104,6 +104,7 @@ library GADTSyntax GeneralizedNewtypeDeriving KindSignatures + StandaloneKindSignatures LambdaCase MultiWayIf NoImplicitPrelude @@ -261,6 +262,7 @@ executable xanthous GADTSyntax GeneralizedNewtypeDeriving KindSignatures + StandaloneKindSignatures LambdaCase MultiWayIf NoImplicitPrelude @@ -385,6 +387,7 @@ test-suite test GADTSyntax GeneralizedNewtypeDeriving KindSignatures + StandaloneKindSignatures LambdaCase MultiWayIf NoImplicitPrelude @@ -494,6 +497,7 @@ benchmark benchmark GADTSyntax GeneralizedNewtypeDeriving KindSignatures + StandaloneKindSignatures LambdaCase MultiWayIf NoImplicitPrelude -- cgit 1.4.1