How do I parameterize a function by module in Haskell?

Here's how to to it with module signatures and mixins (a.k.a. Backpack)

You would have to define a library (it could be an internal library) with a signature like:

-- file Mappy.hsig
signature Mappy where

class C k
data Map k v
empty :: Map k v
insert :: C k => k -> v -> Map k v -> Map k v 
size :: Map k v -> Int

in the same library or in another, write code that imports the signature as if it were a normal module:

module Stuff where

import qualified Mappy as M

type KVPairs k v = [(k,v)]

comp :: M.C k => KVPairs k v -> IO ()
comp kvpairs = do
  let init = M.empty
  let m = foldr ins init kvpairs where
        ins (k, v) t = M.insert k v t
  if M.size m /= length kvpairs
  then putStrLn $ "FAIL: " ++ show (M.size m) ++ ", " ++ show (length kvpairs)
  else pure ()

In another library (it must be a different one) write an "implementation" module that matches the signature:

-- file Mappy.hs
{-# language ConstraintKinds #-}
module Mappy (C,insert,empty,size,Map) where

import Data.Map.Lazy

type C = Ord

The "signature match" is performed based on names and types only, the implementation module doesn't need to know about the existence of the signature.

Then, in a library or executable in which you want to use the abstract code, pull both the library with the abstract code and the library with the implementation:

executable somexe
  main-is:             Main.hs
  build-depends:       base ^>=4.11.1.0,
                       indeflib,
                       lazyimpl
  default-language:    Haskell2010

library indeflib
  exposed-modules:     Stuff
  signatures:          Mappy
  build-depends:       base ^>=4.11.1.0
  hs-source-dirs:      src
  default-language:    Haskell2010

library lazyimpl
  exposed-modules:     Mappy
  build-depends:       base ^>=4.11.1.0,
                       containers >= 0.5
  hs-source-dirs:      impl1
  default-language:    Haskell2010

Sometimes the name of the signature and of the implementing module don't match, in that case one has to use the mixins section of the Cabal file.

Edit. Creating the HashMap implementation proved somewhat tricky, because insert required two constraints (Eq and Hashable) instead of one. I had to resort to the "class synonym" trick. Here's the code:

{-# language ConstraintKinds, FlexibleInstances, UndecidableInstances #-}
module Mappy (C,insert,HM.empty,HM.size,Map) where

import Data.Hashable
import qualified Data.HashMap.Strict as HM

type C = EqHash 

class (Eq q, Hashable q) => EqHash q -- class synonym trick
instance (Eq q, Hashable q) => EqHash q

insert :: EqHash k => k -> v -> Map k v -> Map k v
insert = HM.insert

type Map = HM.HashMap

The simplest is to parameterize by the operations you actually need, rather than the module. So:

mapComp ::
  m ->
  (K -> V -> m -> m) ->
  (m -> Int) ->
  KVPairs -> IO ()
mapComp empty insert size kvpairs = do
  let m = foldr ins empty kvpairs where
        ins (k, v) t = insert k v t
  if size m /= length kvpairs
  then putStrLn $ "FAIL: " ++ show (size m) ++ ", " ++ show (length kvpairs)
  else pure ()

You can then call it as, e.g. mapComp M.empty M.insert M.size or mapComp HM.empty HM.insert HM.size. As a small side benefit, callers may use this function even if the data structure they prefer doesn't offer a module with exactly the right names and types by writing small adapters and passing them in.

If you like, you can combine these into a single record to ease passing them around:

data MapOps m = MapOps
    { empty :: m
    , insert :: K -> V -> m -> m
    , size :: m -> Int
    }

mops = MapOps M.empty M.insert M.size
hmops = MapOps HM.empty HM.insert HM.size

mapComp :: MapOps m -> KVPairs -> IO ()
mapComp ops kvpairs = do
    let m = foldr ins (empty ops) kvpairs where
          ins (k, v) t = insert ops k v t
    if size ops m /= length kvpairs
    then putStrLn "Yikes!"
    else pure ()