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:
Griffin Smith 2020-06-28 16:43:20 -04:00 committed by glittershark
parent 20bc4aa10d
commit 6c7e14d2dc
7 changed files with 30 additions and 6 deletions

View file

@ -71,6 +71,7 @@ dependencies:
- text-zipper
- vector
- vty
- witherable
- yaml
- zlib

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 ($!)

View file

@ -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>"

View file

@ -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