-- | Convenience interface to enable defining edits at offsets with some
--   optional safety checks.

module BytePatch.Pretty
  (
  -- * Core types
    MultiPatches(..)
  , MultiPatch(..)
  , Offset(..)

  -- * Convenience functions
  , normalizeSimple

  -- * Low-level interface
  , applyBaseOffset
  , listAlgebraConcatEtc
  , normalize
  ) where

import           BytePatch.Core
import           BytePatch.Linear.Core
import           BytePatch.Pretty.PatchRep

import qualified Data.ByteString            as BS
import           Data.Maybe                 ( fromMaybe )
import           GHC.Generics               ( Generic )

type Bytes = BS.ByteString

-- | Normalize a set of 'MultiPatches', discarding everything on error.
normalizeSimple :: PatchRep a => [MultiPatches a] -> Maybe [Patch Bytes]
normalizeSimple :: [MultiPatches a] -> Maybe [Patch Bytes]
normalizeSimple [MultiPatches a]
mps =
    let ([MultiPatch a]
p, [(Offset a, Int)]
errs) = [(Int, [(MultiPatch a, [Offset a])])]
-> ([MultiPatch a], [(Offset a, Int)])
forall a b c. [(a, [(b, [c])])] -> ([b], [(c, a)])
listAlgebraConcatEtc ([(Int, [(MultiPatch a, [Offset a])])]
 -> ([MultiPatch a], [(Offset a, Int)]))
-> ([MultiPatches a] -> [(Int, [(MultiPatch a, [Offset a])])])
-> [MultiPatches a]
-> ([MultiPatch a], [(Offset a, Int)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiPatches a -> (Int, [(MultiPatch a, [Offset a])]))
-> [MultiPatches a] -> [(Int, [(MultiPatch a, [Offset a])])]
forall a b. (a -> b) -> [a] -> [b]
map MultiPatches a -> (Int, [(MultiPatch a, [Offset a])])
forall a. MultiPatches a -> (Int, [(MultiPatch a, [Offset a])])
applyBaseOffset ([MultiPatches a] -> ([MultiPatch a], [(Offset a, Int)]))
-> [MultiPatches a] -> ([MultiPatch a], [(Offset a, Int)])
forall a b. (a -> b) -> a -> b
$ [MultiPatches a]
mps
     in case [(Offset a, Int)]
errs of
          (Offset a, Int)
_:[(Offset a, Int)]
_ -> Maybe [Patch Bytes]
forall a. Maybe a
Nothing
          []  -> [MultiPatch a] -> Maybe [Patch Bytes]
forall a. PatchRep a => [MultiPatch a] -> Maybe [Patch Bytes]
normalize [MultiPatch a]
p

-- | A list of patches sharing a configuration, each applied at a list of
--   offsets, abstracted over patch type.
data MultiPatches a = MultiPatches
  { MultiPatches a -> Maybe Int
mpsBaseOffset :: Maybe Int
  -- ^ The base offset from which all offsets are located. Subtracted from each
  --   offset value to obtain the actual offset. Any offset located before the
  --   base offset (x where x < base) is discarded as erroneous.
  --
  -- This feature enables us to allow negative offsets. For example, say you set
  -- the base offset to @-10@. This is equivalent to stating that every offset
  -- in the list is to be shifted +10 bytes. Thus, all offsets x where x >= -10
  -- are now valid.
  --
  -- The original rationale behind this feature was to ease assembly patches on
  -- ELFs. Decompilers focus on virtual addresses, and apparently (in my
  -- experience) don't like to divulge physical file offsets. However, we can
  -- recover the physical offset of any virtual address via the following steps:
  --
  --   1. subtract the containing ELF segment's virtual address
  --   2.      add the containing ELF segment's physical offset
  --
  -- So we can prepare a base offset @elf_vaddr - elf_phys_offset@, which we can
  -- subtract from any virtual address inside that segment to retrieve its
  -- related byte offset in the ELF file. Thus, you need do that calculation
  -- manually once for every segment you patch, then you can use your
  -- decompiler's virtual addresses!
  --
  -- You can even specify absolute offsets, which are compared to the calculated
  -- actual offsets. So you get the best of both worlds!
  --
  -- Absolute offsets are only used for asserting correctness of calculated
  -- actual offsets. If you want to mix absolute and base-relative offsets...
  -- don't. I'm loath to support that, because I believe it would serve only to
  -- confuse the patch file interface. Instead, group patches into absolute
  -- (base offset = 0) and base-relative lists.

  , MultiPatches a -> [MultiPatch a]
mpsPatches :: [MultiPatch a]
  } deriving (MultiPatches a -> MultiPatches a -> Bool
(MultiPatches a -> MultiPatches a -> Bool)
-> (MultiPatches a -> MultiPatches a -> Bool)
-> Eq (MultiPatches a)
forall a. Eq a => MultiPatches a -> MultiPatches a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiPatches a -> MultiPatches a -> Bool
$c/= :: forall a. Eq a => MultiPatches a -> MultiPatches a -> Bool
== :: MultiPatches a -> MultiPatches a -> Bool
$c== :: forall a. Eq a => MultiPatches a -> MultiPatches a -> Bool
Eq, Int -> MultiPatches a -> ShowS
[MultiPatches a] -> ShowS
MultiPatches a -> String
(Int -> MultiPatches a -> ShowS)
-> (MultiPatches a -> String)
-> ([MultiPatches a] -> ShowS)
-> Show (MultiPatches a)
forall a. Show a => Int -> MultiPatches a -> ShowS
forall a. Show a => [MultiPatches a] -> ShowS
forall a. Show a => MultiPatches a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultiPatches a] -> ShowS
$cshowList :: forall a. Show a => [MultiPatches a] -> ShowS
show :: MultiPatches a -> String
$cshow :: forall a. Show a => MultiPatches a -> String
showsPrec :: Int -> MultiPatches a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MultiPatches a -> ShowS
Show, (forall x. MultiPatches a -> Rep (MultiPatches a) x)
-> (forall x. Rep (MultiPatches a) x -> MultiPatches a)
-> Generic (MultiPatches a)
forall x. Rep (MultiPatches a) x -> MultiPatches a
forall x. MultiPatches a -> Rep (MultiPatches a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MultiPatches a) x -> MultiPatches a
forall a x. MultiPatches a -> Rep (MultiPatches a) x
$cto :: forall a x. Rep (MultiPatches a) x -> MultiPatches a
$cfrom :: forall a x. MultiPatches a -> Rep (MultiPatches a) x
Generic)

-- | A single patch applied at a list of offsets, parameterized by patch type.
data MultiPatch a = MultiPatch
  { MultiPatch a -> a
mpContents    :: a
  -- ^ The value to patch in. Likely a bytestring or text for simple uses.
  , MultiPatch a -> [Offset a]
mpOffsets     :: [Offset a]
  } deriving (MultiPatch a -> MultiPatch a -> Bool
(MultiPatch a -> MultiPatch a -> Bool)
-> (MultiPatch a -> MultiPatch a -> Bool) -> Eq (MultiPatch a)
forall a. Eq a => MultiPatch a -> MultiPatch a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiPatch a -> MultiPatch a -> Bool
$c/= :: forall a. Eq a => MultiPatch a -> MultiPatch a -> Bool
== :: MultiPatch a -> MultiPatch a -> Bool
$c== :: forall a. Eq a => MultiPatch a -> MultiPatch a -> Bool
Eq, Int -> MultiPatch a -> ShowS
[MultiPatch a] -> ShowS
MultiPatch a -> String
(Int -> MultiPatch a -> ShowS)
-> (MultiPatch a -> String)
-> ([MultiPatch a] -> ShowS)
-> Show (MultiPatch a)
forall a. Show a => Int -> MultiPatch a -> ShowS
forall a. Show a => [MultiPatch a] -> ShowS
forall a. Show a => MultiPatch a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultiPatch a] -> ShowS
$cshowList :: forall a. Show a => [MultiPatch a] -> ShowS
show :: MultiPatch a -> String
$cshow :: forall a. Show a => MultiPatch a -> String
showsPrec :: Int -> MultiPatch a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MultiPatch a -> ShowS
Show, (forall x. MultiPatch a -> Rep (MultiPatch a) x)
-> (forall x. Rep (MultiPatch a) x -> MultiPatch a)
-> Generic (MultiPatch a)
forall x. Rep (MultiPatch a) x -> MultiPatch a
forall x. MultiPatch a -> Rep (MultiPatch a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MultiPatch a) x -> MultiPatch a
forall a x. MultiPatch a -> Rep (MultiPatch a) x
$cto :: forall a x. Rep (MultiPatch a) x -> MultiPatch a
$cfrom :: forall a x. MultiPatch a -> Rep (MultiPatch a) x
Generic)

-- | An offset in a stream, with metadata about it to use when preparing the
--   patch and at patch time.
data Offset a = Offset
  { Offset a -> Int
oOffset         :: Int
  -- ^ Stream offset to patch at.

  , Offset a -> Maybe Int
oAbsoluteOffset :: Maybe Int
  -- ^ Absolute stream offset to patch at. Compared with actual offset
  --   (calculated from offset and base offset).

  , Offset a -> Maybe Int
oMaxLength      :: Maybe Int
  -- ^ Maximum bytestring length allowed to patch in at this offset.
  -- TODO: use single range/span instead (default 0->x, also allow y->x)

  , Offset a -> Maybe (OverwriteMeta a)
oPatchMeta      :: Maybe (OverwriteMeta a)
  -- ^ Patch-time info for the overwrite at this offset.
  --
  -- Named "patch meta" instead of the more correct "overwrite meta" for more
  -- friendly JSON field naming. We wrap it in a 'Maybe' for similar reasons,
  -- plus it means the default can be inserted later on.
  } deriving (Offset a -> Offset a -> Bool
(Offset a -> Offset a -> Bool)
-> (Offset a -> Offset a -> Bool) -> Eq (Offset a)
forall a. Eq a => Offset a -> Offset a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Offset a -> Offset a -> Bool
$c/= :: forall a. Eq a => Offset a -> Offset a -> Bool
== :: Offset a -> Offset a -> Bool
$c== :: forall a. Eq a => Offset a -> Offset a -> Bool
Eq, Int -> Offset a -> ShowS
[Offset a] -> ShowS
Offset a -> String
(Int -> Offset a -> ShowS)
-> (Offset a -> String) -> ([Offset a] -> ShowS) -> Show (Offset a)
forall a. Show a => Int -> Offset a -> ShowS
forall a. Show a => [Offset a] -> ShowS
forall a. Show a => Offset a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Offset a] -> ShowS
$cshowList :: forall a. Show a => [Offset a] -> ShowS
show :: Offset a -> String
$cshow :: forall a. Show a => Offset a -> String
showsPrec :: Int -> Offset a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Offset a -> ShowS
Show, (forall x. Offset a -> Rep (Offset a) x)
-> (forall x. Rep (Offset a) x -> Offset a) -> Generic (Offset a)
forall x. Rep (Offset a) x -> Offset a
forall x. Offset a -> Rep (Offset a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Offset a) x -> Offset a
forall a x. Offset a -> Rep (Offset a) x
$cto :: forall a x. Rep (Offset a) x -> Offset a
$cfrom :: forall a x. Offset a -> Rep (Offset a) x
Generic)

-- Drops no info, not easy to consume.
applyBaseOffset :: MultiPatches a -> (Int, [(MultiPatch a, [Offset a])])
applyBaseOffset :: MultiPatches a -> (Int, [(MultiPatch a, [Offset a])])
applyBaseOffset MultiPatches a
mps =
    (Int
baseOffset, Int -> [MultiPatch a] -> [(MultiPatch a, [Offset a])]
forall a. Int -> [MultiPatch a] -> [(MultiPatch a, [Offset a])]
recalculateMultiPatchOffsets Int
baseOffset (MultiPatches a -> [MultiPatch a]
forall a. MultiPatches a -> [MultiPatch a]
mpsPatches MultiPatches a
mps))
      where baseOffset :: Int
baseOffset = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (MultiPatches a -> Maybe Int
forall a. MultiPatches a -> Maybe Int
mpsBaseOffset MultiPatches a
mps)

-- lmao this sucks. generalisation bad
listAlgebraConcatEtc :: [(a, [(b, [c])])] -> ([b], [(c, a)])
listAlgebraConcatEtc :: [(a, [(b, [c])])] -> ([b], [(c, a)])
listAlgebraConcatEtc = [([b], [(c, a)])] -> ([b], [(c, a)])
forall a. Monoid a => [a] -> a
mconcat ([([b], [(c, a)])] -> ([b], [(c, a)]))
-> ([(a, [(b, [c])])] -> [([b], [(c, a)])])
-> [(a, [(b, [c])])]
-> ([b], [(c, a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [(b, [c])]) -> ([b], [(c, a)]))
-> [(a, [(b, [c])])] -> [([b], [(c, a)])]
forall a b. (a -> b) -> [a] -> [b]
map (a, [(b, [c])]) -> ([b], [(c, a)])
forall a. (a, [(a, [c])]) -> ([a], [(c, a)])
go
  where
    go :: (a, [(a, [c])]) -> ([a], [(c, a)])
go (a
baseOffset, [(a, [c])]
inps) = [(a, [(c, a)])] -> ([a], [(c, a)])
forall a. [(a, [(c, a)])] -> ([a], [(c, a)])
tuplemconcat (((a, [c]) -> (a, [(c, a)])) -> [(a, [c])] -> [(a, [(c, a)])]
forall a b. (a -> b) -> [a] -> [b]
map (a -> (a, [c]) -> (a, [(c, a)])
forall b a a. b -> (a, [a]) -> (a, [(a, b)])
go' a
baseOffset) [(a, [c])]
inps)
    go' :: b -> (a, [a]) -> (a, [(a, b)])
go' b
x (a
mp, [a]
offs) = (a
mp, (a -> (a, b)) -> [a] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
o -> (a
o, b
x)) [a]
offs)
    tuplemconcat :: [(a, [(c, a)])] -> ([a], [(c, a)])
tuplemconcat = ((a, [(c, a)]) -> ([a], [(c, a)]) -> ([a], [(c, a)]))
-> ([a], [(c, a)]) -> [(a, [(c, a)])] -> ([a], [(c, a)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
a, [(c, a)]
bs) ([a]
as, [(c, a)]
bs') -> (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as, [(c, a)]
bs [(c, a)] -> [(c, a)] -> [(c, a)]
forall a. Semigroup a => a -> a -> a
<> [(c, a)]
bs')) ([], [(c, a)]
forall a. Monoid a => a
mempty)

recalculateMultiPatchOffsets :: Int -> [MultiPatch a] -> [(MultiPatch a, [Offset a])]
recalculateMultiPatchOffsets :: Int -> [MultiPatch a] -> [(MultiPatch a, [Offset a])]
recalculateMultiPatchOffsets Int
baseOffset = (MultiPatch a -> (MultiPatch a, [Offset a]))
-> [MultiPatch a] -> [(MultiPatch a, [Offset a])]
forall a b. (a -> b) -> [a] -> [b]
map MultiPatch a -> (MultiPatch a, [Offset a])
forall a. MultiPatch a -> (MultiPatch a, [Offset a])
go
  where
    go :: MultiPatch a -> (MultiPatch a, [Offset a])
    go :: MultiPatch a -> (MultiPatch a, [Offset a])
go MultiPatch a
mp =
        let ([Offset a]
osRecalculated, [Offset a]
osInvalid) = Int -> [Offset a] -> ([Offset a], [Offset a])
forall a. Int -> [Offset a] -> ([Offset a], [Offset a])
recalculateOffsets Int
baseOffset (MultiPatch a -> [Offset a]
forall a. MultiPatch a -> [Offset a]
mpOffsets MultiPatch a
mp)
         in (MultiPatch a
mp { mpOffsets :: [Offset a]
mpOffsets = [Offset a]
osRecalculated }, [Offset a]
osInvalid)

recalculateOffsets :: Int -> [Offset a] -> ([Offset a], [Offset a])
recalculateOffsets :: Int -> [Offset a] -> ([Offset a], [Offset a])
recalculateOffsets Int
baseOffset = (Offset a -> Maybe (Offset a))
-> [Offset a] -> ([Offset a], [Offset a])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
partitionMaybe Offset a -> Maybe (Offset a)
forall a. Offset a -> Maybe (Offset a)
go
  where
    go :: Offset a -> Maybe (Offset a)
go Offset a
o = if Int
actualOffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Offset a -> Maybe (Offset a)
forall a. a -> Maybe a
Just (Offset a
o { oOffset :: Int
oOffset = Int
actualOffset }) else Maybe (Offset a)
forall a. Maybe a
Nothing
      where actualOffset :: Int
actualOffset = Offset a -> Int
forall a. Offset a -> Int
oOffset Offset a
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
baseOffset

normalize :: PatchRep a => [MultiPatch a] -> Maybe [Patch Bytes]
normalize :: [MultiPatch a] -> Maybe [Patch Bytes]
normalize [MultiPatch a]
xs = [[Patch Bytes]] -> [Patch Bytes]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Patch Bytes]] -> [Patch Bytes])
-> Maybe [[Patch Bytes]] -> Maybe [Patch Bytes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MultiPatch a -> Maybe [Patch Bytes])
-> [MultiPatch a] -> Maybe [[Patch Bytes]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM MultiPatch a -> Maybe [Patch Bytes]
forall a. PatchRep a => MultiPatch a -> Maybe [Patch Bytes]
go [MultiPatch a]
xs
  where go :: MultiPatch a -> Maybe [Patch Bytes]
go (MultiPatch a
contents [Offset a]
os) = (Offset a -> Maybe (Patch Bytes))
-> [Offset a] -> Maybe [Patch Bytes]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (a -> Offset a -> Maybe (Patch Bytes)
forall a. PatchRep a => a -> Offset a -> Maybe (Patch Bytes)
tryMakeSingleReplace a
contents) [Offset a]
os

-- TODO now can error with "[expected] content has no valid patch rep"
tryMakeSingleReplace :: PatchRep a => a -> Offset a -> Maybe (Patch Bytes)
tryMakeSingleReplace :: a -> Offset a -> Maybe (Patch Bytes)
tryMakeSingleReplace a
contents (Offset Int
os Maybe Int
maos Maybe Int
maxLen Maybe (OverwriteMeta a)
mMeta) =
    case a -> Either String Bytes
forall a. PatchRep a => a -> Either String Bytes
toPatchRep a
contents of
      Left String
errStr -> String -> Maybe (Patch Bytes)
forall a. HasCallStack => String -> a
error String
errStr -- TODO
      Right Bytes
bs ->
        if   Bool
offsetIsCorrect
        then case Maybe Int
maxLen of
               Just Int
len -> if Bytes -> Int
BS.length Bytes
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len then Maybe (Patch Bytes)
forall a. Maybe a
Nothing else Bytes -> Maybe (Patch Bytes)
overwrite Bytes
bs
               Maybe Int
Nothing  -> Bytes -> Maybe (Patch Bytes)
overwrite Bytes
bs
        else Maybe (Patch Bytes)
forall a. Maybe a
Nothing
  where
    overwrite :: Bytes -> Maybe (Patch Bytes)
overwrite Bytes
bs = case (a -> Either String Bytes)
-> OverwriteMeta a -> Either String (OverwriteMeta Bytes)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Either String Bytes
forall a. PatchRep a => a -> Either String Bytes
toPatchRep OverwriteMeta a
meta of
                     Left String
errStr -> String -> Maybe (Patch Bytes)
forall a. HasCallStack => String -> a
error String
errStr -- TODO
                     Right OverwriteMeta Bytes
meta' -> Patch Bytes -> Maybe (Patch Bytes)
forall a. a -> Maybe a
Just (Patch Bytes -> Maybe (Patch Bytes))
-> Patch Bytes -> Maybe (Patch Bytes)
forall a b. (a -> b) -> a -> b
$ Patch :: forall a. a -> Int -> OverwriteMeta a -> Patch a
Patch { patchContents :: Bytes
patchContents = Bytes
bs
                                                 , patchOffset :: Int
patchOffset   = Int
os
                                                 , patchMeta :: OverwriteMeta Bytes
patchMeta     = OverwriteMeta Bytes
meta' }
    meta :: OverwriteMeta a
meta = OverwriteMeta a -> Maybe (OverwriteMeta a) -> OverwriteMeta a
forall a. a -> Maybe a -> a
fromMaybe (Maybe Int -> Maybe a -> OverwriteMeta a
forall a. Maybe Int -> Maybe a -> OverwriteMeta a
OverwriteMeta Maybe Int
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing) Maybe (OverwriteMeta a)
mMeta
    offsetIsCorrect :: Bool
offsetIsCorrect = case Maybe Int
maos of Maybe Int
Nothing  -> Bool
True
                                   Just Int
aos -> Int
os Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
aos

--------------------------------------------------------------------------------

-- | Map a failable function over a list, retaining "failed" 'Nothing' results.
partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
partitionMaybe a -> Maybe b
f =
    (a -> ([b], [a]) -> ([b], [a])) -> ([b], [a]) -> [a] -> ([b], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> (([b], [a]) -> ([b], [a]))
-> (b -> ([b], [a]) -> ([b], [a]))
-> Maybe b
-> ([b], [a])
-> ([b], [a])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([a] -> [a]) -> ([b], [a]) -> ([b], [a])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (\b
y -> ([b] -> [b]) -> ([b], [a]) -> ([b], [a])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (b
yb -> [b] -> [b]
forall a. a -> [a] -> [a]
:)) (a -> Maybe b
f a
x)) ([], [])

mapFst :: (a -> c) -> (a, b) -> (c, b)
mapFst :: (a -> c) -> (a, b) -> (c, b)
mapFst a -> c
f (a
a, b
b) = (a -> c
f a
a, b
b)

mapSnd :: (b -> c) -> (a, b) -> (a, c)
mapSnd :: (b -> c) -> (a, b) -> (a, c)
mapSnd b -> c
f (a
a, b
b) = (a
a, b -> c
f b
b)