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…
	
	Add table
		Add a link
		
	
		Reference in a new issue