Skip to content

Instantly share code, notes, and snippets.

@tonymorris
Last active December 20, 2015 09:40
Show Gist options
  • Save tonymorris/6109849 to your computer and use it in GitHub Desktop.
Save tonymorris/6109849 to your computer and use it in GitHub Desktop.
How to generalise this function?
-- zip is to liftA2 as zipAlign is to ???
data NonEmptyList a =
NonEmptyList a [a]
deriving (Eq, Show)
data ZipAlign a b =
Align [(a, b)]
| RestA (NonEmptyList a)
| RestB (NonEmptyList b)
deriving (Eq, Show)
-- how to generalise this function...
zipAlign ::
[a]
-> [b]
-> ZipAlign a b
zipAlign [] [] =
Align []
zipAlign (h:t) [] =
RestA (NonEmptyList h t)
zipAlign [] (h:t) =
RestB (NonEmptyList h t)
zipAlign (h:t) (h':t') =
case zipAlign t t' of
RestA r -> RestA r
RestB r -> RestB r
Align a -> Align ((h,h') : a)
data Ap f a =
Ap a (f a)
deriving (Eq, Show)
data ZipAlignG f a b =
AlignG (f (a, b))
| RestAG (Ap f a)
| RestBG (Ap f b)
-- ...to this function?
zipAlignG ::
f a
-> f b
-> ZipAlignG f a b
zipAlignG =
error "???"
@cheecheeo
Copy link

Something like this?

import Control.Applicative (Applicative, liftA2)
import Data.Foldable (Foldable)
import qualified Data.Foldable as F

data ZipAlignG f a b
  = AlignG (f (a, b))
  | RestAG (Ap f a)
  | RestBG (Ap f b)

data Ap f a
  = Ap a (f a)
  deriving (Eq, Show)

zipAlignG :: (Functor f, Applicative f, Foldable f) => f a -> f b -> ZipAlignG f a b
zipAlignG xs ys =
  case compare lenXs lenYs of
    EQ -> AlignG $ liftA2 (,) xs ys
    GT -> RestAG $ fDrop lenYs xs
    LT -> RestBG $ fDrop lenXs ys
  where lenXs = fLength xs
        lenYs = fLength ys

fLength :: (Functor f, Foldable f) => f a -> Integer
fLength xs = F.sum $ fmap (const 1) xs

fDrop :: (Foldable f) => Integer -> f a -> Ap f a
fDrop = undefined

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment