Skip to content

Commit 121fdfd

Browse files
recursion-ninjarecursion-ninja
committed
Adding many MonoKeyed instances.
1 parent be1d58c commit 121fdfd

File tree

1 file changed

+118
-35
lines changed

1 file changed

+118
-35
lines changed

‎src/Data/MonoTraversable/Keys.hs

Lines changed: 118 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,7 @@ import Data.Int (Int, Int64)
5050
import GHC.Exts (build)
5151
import Prelude (Bool (..), Bounded(..), const, Char, Enum(..), flip, IO, Maybe (..), Either (..),
5252
(+), Integral, Ordering (..), compare, fromIntegral, Num, (>=),
53-
(==), seq, otherwise, Eq, Ord, (-), (*), uncurry, ($))
53+
(==), seq, otherwise, Eq, Ord, (-), (*), uncurry, ($), snd)
5454
import qualified Prelude
5555
import qualified Data.ByteString.Internal as Unsafe
5656
import qualified Foreign.ForeignPtr.Unsafe as Unsafe
@@ -73,7 +73,7 @@ import Data.HashMap.Strict (HashMap)
7373
import qualified Data.HashMap.Strict as HM
7474
import Data.Vector (Vector)
7575
import Control.Monad.Trans.Maybe (MaybeT (..))
76-
import Control.Monad.Trans.List (ListT)
76+
import Control.Monad.Trans.List (ListT(..))
7777
import Control.Monad.Trans.Writer (WriterT)
7878
import qualified Control.Monad.Trans.Writer.Strict as S (WriterT)
7979
import Control.Monad.Trans.State (StateT(..))
@@ -101,7 +101,7 @@ import Data.Void
101101
import Control.Monad.Trans.Identity (IdentityT)
102102
import GHC.Generics
103103
import Data.MonoTraversable (Element, MonoFunctor(..), MonoFoldable(..), MonoTraversable(..))
104-
104+
import Data.Vector.Instances
105105

106106
-- |
107107
-- Type family for getting the type of the key of a monomorphic container.
@@ -423,34 +423,48 @@ instance (Traversable f, Traversable g) => MonoTraversableWithKey (Compose f g a
423423
instance (Traversable f, Traversable g) => MonoTraversableWithKey (Product f g a)
424424

425425

426-
instance MonoKeyed BS.ByteString where
426+
omapWithUnitKey f = omap (f ())
427427

428+
429+
instance MonoKeyed BS.ByteString where
428430
{-# INLINE omapWithKey #-}
429-
omapWithKey = BS.map
430431

432+
omapWithKey f = snd . BS.mapAccumL g 0
433+
where
434+
g k v = (succ k, f k v)
431435

432-
instance MonoKeyed BSL.ByteString where
433436

437+
instance MonoKeyed BSL.ByteString where
434438
{-# INLINE omapWithKey #-}
435-
omapWithKey = BSL.map
436439

440+
omapWithKey f = snd . BSL.mapAccumL g 0
441+
where
442+
g k v = (succ k, f k v)
437443

438-
instance MonoKeyed T.Text where
439444

445+
instance MonoKeyed T.Text where
440446
{-# INLINE omapWithKey #-}
441-
omapWithKey = T.map
442447

448+
omapWithKey f = snd . T.mapAccumL g 0
449+
where
450+
g k v = (succ k, f k v)
443451

444-
instance MonoKeyed TL.Text where
445452

453+
instance MonoKeyed TL.Text where
446454
{-# INLINE omapWithKey #-}
447-
omapWithKey = TL.map
455+
456+
omapWithKey f = snd . TL.mapAccumL g 0
457+
where
458+
g k v = (succ k, f k v)
448459

449460

450461
instance MonoKeyed [a]
451462

452463

453-
instance MonoKeyed (IO a)
464+
instance MonoKeyed (IO a) where
465+
{-# INLINE omapWithKey #-}
466+
467+
omapWithKey = omapWithUnitKey
454468

455469

456470
instance MonoKeyed (ZipList a)
@@ -465,16 +479,25 @@ instance MonoKeyed (Tree a)
465479
instance MonoKeyed (Seq a)
466480

467481

468-
instance MonoKeyed (ViewL a)
482+
instance MonoKeyed (ViewL a) where
483+
{-# INLINE omapWithKey #-}
484+
485+
omapWithKey = omapWithUnitKey
486+
469487

488+
instance MonoKeyed (ViewR a) where
489+
{-# INLINE omapWithKey #-}
470490

471-
instance MonoKeyed (ViewR a)
491+
omapWithKey = omapWithUnitKey
472492

473493

474494
instance MonoKeyed (IntMap a)
475495

476496

477-
instance MonoKeyed (Option a)
497+
instance MonoKeyed (Option a) where
498+
{-# INLINE omapWithKey #-}
499+
500+
omapWithKey = omapWithUnitKey
478501

479502

480503
instance MonoKeyed (NonEmpty a)
@@ -483,19 +506,34 @@ instance MonoKeyed (NonEmpty a)
483506
instance MonoKeyed (Identity a)
484507

485508

486-
instance MonoKeyed (r -> a)
509+
instance MonoKeyed (r -> a) where
510+
{-# INLINE omapWithKey #-}
487511

512+
omapWithKey = omapWithUnitKey
488513

489-
instance MonoKeyed (Either a b)
490514

515+
instance MonoKeyed (Either a b) where
516+
{-# INLINE omapWithKey #-}
491517

492-
instance MonoKeyed (a, b)
518+
omapWithKey = omapWithUnitKey
493519

494520

495-
instance MonoKeyed (Const m a)
521+
instance MonoKeyed (a, b) where
522+
{-# INLINE omapWithKey #-}
496523

524+
omapWithKey = omapWithUnitKey
497525

498-
instance Monad m => MonoKeyed (WrappedMonad m a)
526+
527+
instance MonoKeyed (Const m a) where
528+
{-# INLINE omapWithKey #-}
529+
530+
omapWithKey = omapWithUnitKey
531+
532+
533+
instance Monad m => MonoKeyed (WrappedMonad m a) where
534+
{-# INLINE omapWithKey #-}
535+
536+
omapWithKey = omapWithUnitKey
499537

500538

501539
instance MonoKeyed (Map k v)
@@ -507,49 +545,94 @@ instance MonoKeyed (HashMap k v)
507545
instance MonoKeyed (Vector a)
508546

509547

510-
instance MonoKeyed (Arg a b)
548+
instance MonoKeyed (Arg a b) where
549+
{-# INLINE omapWithKey #-}
511550

551+
omapWithKey = omapWithUnitKey
512552

513-
instance Arrow a => MonoKeyed (WrappedArrow a b c)
514553

554+
instance Arrow a => MonoKeyed (WrappedArrow a b c) where
555+
{-# INLINE omapWithKey #-}
515556

516-
instance Functor m => MonoKeyed (MaybeT m a)
557+
omapWithKey = omapWithUnitKey
517558

518559

519-
instance Functor m => MonoKeyed (ListT m a)
560+
instance Functor m => MonoKeyed (MaybeT m a) where
561+
{-# INLINE omapWithKey #-}
520562

563+
omapWithKey = omapWithUnitKey
521564

522-
instance Functor m => MonoKeyed (IdentityT m a)
523565

566+
instance Functor m => MonoKeyed (ListT m a) where
567+
{-# INLINE omapWithKey #-}
524568

525-
instance Functor m => MonoKeyed (WriterT w m a)
569+
omapWithKey f = ListT . fmap (omapWithKey f) . runListT
526570

527571

528-
instance Functor m => MonoKeyed (S.WriterT w m a)
572+
instance Functor m => MonoKeyed (IdentityT m a) where
573+
{-# INLINE omapWithKey #-}
529574

575+
omapWithKey = omapWithUnitKey
530576

531-
instance Functor m => MonoKeyed (StateT s m a)
532577

578+
instance Functor m => MonoKeyed (WriterT w m a) where
579+
{-# INLINE omapWithKey #-}
533580

534-
instance Functor m => MonoKeyed (S.StateT s m a)
581+
omapWithKey = omapWithUnitKey
535582

536583

537-
instance Functor m => MonoKeyed (RWST r w s m a)
584+
instance Functor m => MonoKeyed (S.WriterT w m a) where
585+
{-# INLINE omapWithKey #-}
538586

587+
omapWithKey = omapWithUnitKey
539588

540-
instance Functor m => MonoKeyed (S.RWST r w s m a)
541589

590+
instance Functor m => MonoKeyed (StateT s m a) where
591+
{-# INLINE omapWithKey #-}
542592

543-
instance Functor m => MonoKeyed (ReaderT r m a)
593+
omapWithKey = omapWithUnitKey
544594

545595

546-
instance Functor m => MonoKeyed (ContT r m a)
596+
instance Functor m => MonoKeyed (S.StateT s m a) where
597+
{-# INLINE omapWithKey #-}
547598

599+
omapWithKey = omapWithUnitKey
600+
601+
602+
instance Functor m => MonoKeyed (RWST r w s m a) where
603+
{-# INLINE omapWithKey #-}
604+
605+
omapWithKey = omapWithUnitKey
606+
607+
608+
instance Functor m => MonoKeyed (S.RWST r w s m a) where
609+
{-# INLINE omapWithKey #-}
548610

549-
instance (Functor f, Functor g) => MonoKeyed (Compose f g a)
611+
omapWithKey = omapWithUnitKey
550612

551613

552-
instance (Functor f, Functor g) => MonoKeyed (Product f g a)
614+
instance Functor m => MonoKeyed (ReaderT r m a) where
615+
{-# INLINE omapWithKey #-}
616+
617+
omapWithKey = omapWithUnitKey
618+
619+
620+
instance Functor m => MonoKeyed (ContT r m a) where
621+
{-# INLINE omapWithKey #-}
622+
623+
omapWithKey = omapWithUnitKey
624+
625+
626+
instance (Functor f, Functor g) => MonoKeyed (Compose f g a) where
627+
{-# INLINE omapWithKey #-}
628+
629+
omapWithKey = omapWithUnitKey
630+
631+
632+
instance (Functor f, Functor g) => MonoKeyed (Product f g a) where
633+
{-# INLINE omapWithKey #-}
634+
635+
omapWithKey = omapWithUnitKey
553636

554637

555638
instance U.Unbox a => MonoKeyed (U.Vector a) where

0 commit comments

Comments
 (0)