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 ()