feat(xan): Use Witherable in the prelude
Install the witherable library, expose it in the prelude, and update all call sites that are broken by that change. This is a really nice library, and basically the ideal abstraction layer for what it does. Change-Id: I640e099318c1ecce0ad483bc336c379698bdab88 Reviewed-on: https://cl.tvl.fyi/c/depot/+/725 Reviewed-by: glittershark <grfn@gws.fyi>
This commit is contained in:
parent
20bc4aa10d
commit
6c7e14d2dc
7 changed files with 30 additions and 6 deletions
|
@ -71,6 +71,7 @@ dependencies:
|
|||
- text-zipper
|
||||
- vector
|
||||
- vty
|
||||
- witherable
|
||||
- yaml
|
||||
- zlib
|
||||
|
||||
|
|
|
@ -387,8 +387,11 @@ data Neighbors a = Neighbors
|
|||
, _bottomRight :: a
|
||||
}
|
||||
deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
|
||||
deriving anyclass (NFData, CoArbitrary, Function)
|
||||
deriving anyclass (NFData, CoArbitrary, Function, MonoFoldable)
|
||||
deriving Arbitrary via GenericArbitrary (Neighbors a)
|
||||
|
||||
type instance Element (Neighbors a) = a
|
||||
|
||||
makeFieldsNoPrefix ''Neighbors
|
||||
|
||||
instance Applicative Neighbors where
|
||||
|
|
|
@ -35,6 +35,7 @@ newtype VectorBag a = VectorBag (Vector a)
|
|||
, Semigroup
|
||||
, Arbitrary
|
||||
, CoArbitrary
|
||||
, Filterable
|
||||
)
|
||||
makeWrapped ''VectorBag
|
||||
|
||||
|
@ -59,6 +60,11 @@ instance AsEmpty (VectorBag a) where
|
|||
(VectorBag Empty) -> Just ()
|
||||
_ -> Nothing
|
||||
|
||||
instance Witherable VectorBag where
|
||||
wither f (VectorBag v) = VectorBag <$> wither f v
|
||||
witherM f (VectorBag v) = VectorBag <$> witherM f v
|
||||
filterA p (VectorBag v) = VectorBag <$> filterA p v
|
||||
|
||||
{-
|
||||
TODO:
|
||||
, Ixed
|
||||
|
|
|
@ -28,7 +28,7 @@ module Xanthous.Messages.Template
|
|||
where
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Prelude hiding
|
||||
(many, concat, try, elements, some, parts)
|
||||
(many, concat, try, elements, some, parts, Filter)
|
||||
--------------------------------------------------------------------------------
|
||||
import Test.QuickCheck hiding (label)
|
||||
import Test.QuickCheck.Instances.Text ()
|
||||
|
@ -113,7 +113,7 @@ instance Eq Template where
|
|||
|
||||
instance Arbitrary Template where
|
||||
arbitrary = sized . fix $ \gen n ->
|
||||
let leaves = [ Literal . filter (`notElem` ['\\', '{']) <$> arbitrary
|
||||
let leaves = [ Literal . pack . filter (`notElem` ['\\', '{']) <$> arbitrary
|
||||
, Subst <$> arbitrary
|
||||
]
|
||||
subtree = gen $ n `div` 2
|
||||
|
|
|
@ -7,7 +7,9 @@ module Xanthous.Prelude
|
|||
, module Control.Lens
|
||||
, module Data.Void
|
||||
, module Control.Comonad
|
||||
, module Data.Witherable
|
||||
|
||||
, (&!)
|
||||
|
||||
-- * Classy-Prelude addons
|
||||
, ninsertSet
|
||||
|
@ -16,12 +18,15 @@ module Xanthous.Prelude
|
|||
) where
|
||||
--------------------------------------------------------------------------------
|
||||
import ClassyPrelude hiding
|
||||
(return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index, say)
|
||||
( return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index, say
|
||||
, catMaybes, filter, mapMaybe, hashNub, ordNub
|
||||
)
|
||||
import Data.Kind
|
||||
import GHC.TypeLits hiding (Text)
|
||||
import Control.Lens hiding (levels, Level)
|
||||
import Data.Void
|
||||
import Control.Comonad
|
||||
import Data.Witherable
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
ninsertSet
|
||||
|
@ -34,3 +39,7 @@ ndeleteSet x = deleteSet x . toNullable
|
|||
|
||||
toVector :: (MonoFoldable (f a), Element (f a) ~ a) => f a -> Vector a
|
||||
toVector = fromList . toList
|
||||
|
||||
infixl 1 &!
|
||||
(&!) :: a -> (a -> b) -> b
|
||||
(&!) = flip ($!)
|
||||
|
|
|
@ -62,7 +62,7 @@ test = testGroup "Xanthous.Messages.Template"
|
|||
]
|
||||
]
|
||||
where
|
||||
genLiteral = filter (`notElem` ['\\', '{']) <$> arbitrary
|
||||
genLiteral = pack . filter (`notElem` ['\\', '{']) <$> arbitrary
|
||||
parseCase name input expected =
|
||||
testCase name $ testParse template input @?= Right expected
|
||||
testParse p = over _Left errorBundlePretty . runParser p "<test>"
|
||||
|
|
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 0486cac7957fae1f9badffdd082f0c5eb5910eb8c066569123b0f57bc6fa0d8b
|
||||
-- hash: 88019942f93977e08b513ce6991401694c431b7b2b7b1b5d2afccb3f0afb26ed
|
||||
|
||||
name: xanthous
|
||||
version: 0.1.0.0
|
||||
|
@ -53,6 +53,7 @@ library
|
|||
Xanthous.Entities.Entities
|
||||
Xanthous.Entities.Environment
|
||||
Xanthous.Entities.Item
|
||||
Xanthous.Entities.Marker
|
||||
Xanthous.Entities.Raws
|
||||
Xanthous.Entities.RawTypes
|
||||
Xanthous.Game
|
||||
|
@ -143,6 +144,7 @@ library
|
|||
, tomland
|
||||
, vector
|
||||
, vty
|
||||
, witherable
|
||||
, yaml
|
||||
, zlib
|
||||
default-language: Haskell2010
|
||||
|
@ -174,6 +176,7 @@ executable xanthous
|
|||
Xanthous.Entities.Entities
|
||||
Xanthous.Entities.Environment
|
||||
Xanthous.Entities.Item
|
||||
Xanthous.Entities.Marker
|
||||
Xanthous.Entities.Raws
|
||||
Xanthous.Entities.RawTypes
|
||||
Xanthous.Game
|
||||
|
@ -263,6 +266,7 @@ executable xanthous
|
|||
, tomland
|
||||
, vector
|
||||
, vty
|
||||
, witherable
|
||||
, xanthous
|
||||
, yaml
|
||||
, zlib
|
||||
|
@ -355,6 +359,7 @@ test-suite test
|
|||
, tomland
|
||||
, vector
|
||||
, vty
|
||||
, witherable
|
||||
, xanthous
|
||||
, yaml
|
||||
, zlib
|
||||
|
|
Loading…
Reference in a new issue