Two implementations of a variadic `zipWith` function, based on inferring the type using either the argument or the return type

ZipWith.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}

module ZipWith where

import Control.Applicative (ZipList (..))
import Prelude hiding (zipWith)

class ZipWith target where
  type ZipWithArg target :: *
  fromZipList :: ZipList (ZipWithArg target) -> target

instance ZipWith [a] where
  type ZipWithArg [a] = a
  fromZipList = getZipList

instance ZipWith target => ZipWith ([a] -> target) where
  type ZipWithArg ([a] -> target) = a -> ZipWithArg target
  fromZipList fs as = fromZipList (fs <*> ZipList as)

zipWith :: ZipWith target => ZipWithArg target -> target
zipWith = fromZipList . pure

---

type family ZipWithTarget argument :: * where
  ZipWithTarget (a -> b) = [a] -> ZipWithTarget b
  ZipWithTarget other = [other]

class ZipWith' argument where
  fromZipList' :: ZipList argument -> ZipWithTarget argument

instance {-# OVERLAPPING #-} ZipWith' b => ZipWith' (a -> b) where
  fromZipList' fs as = fromZipList' (fs <*> ZipList as)

instance {-# OVERLAPPABLE #-} ZipWithTarget argument ~ [argument] => ZipWith' argument where
  fromZipList' = getZipList

zipWith' :: ZipWith' argument => argument -> ZipWithTarget argument
zipWith' = fromZipList' . pure

---

example0 :: a -> [a]
example0 = zipWith

example0a :: (a -> b) -> [a -> b]
example0a = zipWith

-- |
-- >>> :t example0'
-- example0' :: (ZipWith' a, ZipWithTarget a ~ [a]) => a -> [a]
example0' :: (ZipWith' a, _) => a -> [a]
example0' = zipWith'

example1 :: (a -> b) -> [a] -> [b]
example1 = zipWith

example1a :: (a -> b -> c) -> [a] -> [b -> c]
example1a = zipWith

-- |
-- >>> :t example1'
-- example1'
--   :: (ZipWith' b, ZipWithTarget b ~ [b]) => (a -> b) -> [a] -> [b]
example1' :: (ZipWith' b, _) => (a -> b) -> [a] -> [b]
example1' = zipWith'

example2 :: (a -> b -> c) -> [a] -> [b] -> [c]
example2 = zipWith

example2a :: (a -> b -> c -> d) -> [a] -> [b] -> [c -> d]
example2a = zipWith

-- |
-- >>> :t example2'
-- example2'
--   :: (ZipWith' c, ZipWithTarget c ~ [c]) =>
--      (a -> b -> c) -> [a] -> [b] -> [c]
example2' :: (ZipWith' c, _) => (a -> b -> c) -> [a] -> [b] -> [c]
example2' = zipWith'

---

-- |
-- >>> :t infer0
-- infer0 :: [[Char]]
infer0 :: [_]
infer0 = zipWith "ok"

-- |
-- >>> :t infer0'
-- infer0' :: [[Char]]
infer0' :: _
infer0' = zipWith' "ok"

-- |
-- >>> :t infer1
-- infer1 :: [[Char]] -> [[Char]]
infer1 :: [_] -> [_]
infer1 = zipWith ('a' :)

-- |
-- >>> :t infer1'
-- infer1' :: [[Char]] -> [[Char]]
infer1' :: _
infer1' = zipWith' ('a' :)

-- |
-- >>> :t infer2
-- infer2 :: [String] -> [String] -> [String]
infer2 :: [_] -> [_] -> [_]
infer2 = zipWith (\x y -> unwords [x, y])

-- |
-- >>> :t infer2'
-- infer2' :: [[Char]] -> [[Char]] -> [[Char]]
infer2' :: _
infer2' = zipWith' (\x y -> unwords [x, y])