skipRight.hs

skipRight ::  
  (a -> [a] -> ([a] -> b) -> b)
  -> b
  -> [a]
  -> b
skipRight _ z [] =
  z
skipRight f z (h:t) =
  f h t (skipRight f z)

skipRightIdentity ::
  [a]
  -> [a]    
skipRightIdentity =
  skipRight (\h t k -> h : k t) []

filterMaybe ::
  (a -> Bool)
  -> Maybe a
  -> Maybe a
filterMaybe _ Nothing =
  Nothing
filterMaybe f (Just a) =
  if f a then Just a else Nothing

-- |
--
-- >>> replace [] "12345abc6789"
-- "12345abc6789"
-- >>> replace [('x':|"yz", "X")] "12345abc6789"
-- "12345abc6789"
-- >>> replace [('a':|"bc", "ABC")] "12345abc6789"
-- "12345ABC6789"
-- >>> replace [('a':|"bc", "")] "12345abc6789"
-- "123456789"
-- >>> replace [('a':|"bc", "ABC"), ('x':|"yz", "XYZ")] "12345abc6789"
-- "12345ABC6789"
-- >>> replace [('a':|"bc", "ABC"), ('x':|"yz", "XYZ")] "12345abc678xyz9"
-- "12345ABC678XYZ9"
-- >>> replace [('a':|"bc", "ABC"), ('x':|"yz", "XYZ")] "12345678xyz9"
-- "12345678XYZ9"
-- >>> replace [('a':|"bc", "ABC"), ('x':|"yz", "XYZ")] "12345ab678xy9"
-- "12345ab678xy9"
-- >>> replace [('a':|"bc", "ABC"), ('x':|"yz", "XYZ")] "12345bc678yz9"
-- "12345bc678yz9"
-- >>> replace [('a':|"bc", "ABC"), ('x':|"yz", "XYZ")] "12345bc678xyz9xyzabc"
-- "12345bc678XYZ9XYZABC"
-- >>> replace [('a':|"bc", "ABC"), ('x':|"yz", "XYZ")] "abc12345678xyz9abc0xyz"
-- "ABC12345678XYZ9ABC0XYZ"
replace ::
  (Foldable f, Functor f, Eq a) =>
  f (NonEmpty a, [a])
  -> [a]
  -> [a]
replace rs =
  let doReplace ::
        (Foldable f, Functor f, Eq a) =>
        f (NonEmpty a, [a])
        -> a -> [a] -> ([a] -> [a]) -> [a]
      doReplace qr h t k =
        let replacement (q, r) =
              let al =
                    -- https://hackage.haskell.org/package/alignment
                    align q (h :| t)
                  rt =
                    preview allThoseBOr al
                  allEqual =
                    all (\(a1, a2) -> a1 == a2) (view these al)
              in  (r ,) <$> filterMaybe (pure allEqual) rt
        in  case asum (replacement <$> qr) of
              Nothing ->
                h : k t
              Just (x, y) ->
                x <> k y
  in  skipRight (doReplace rs) []