ABitOfKnotTying.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Main where

import Dep.Has (Has(dep), asCall) -- from the "dep-t" package
import Control.Monad.IO.Class

newtype Foo m = Foo { foo :: Int -> m () }

mkFoo :: MonadIO m => Foo m 
mkFoo = Foo \i -> liftIO $ print i

newtype Bar m = Bar { bar :: Int -> m () }

mkBar :: Has Foo m e => e -> Bar m -- Notice no MonadIO constraint
mkBar (asCall -> call) = Bar \i -> do
   call foo (i + 1)

newtype Baz m = Baz { baz :: Int -> m () }

mkBaz :: Has Foo m e, Has Bar m e => e -> Baz m 
mkBaz (asCall -> call) = Baz \i -> do
    call foo (i + 3)
    call bar (i + 4)

data Env = Env { _foo :: Foo IO, _bar :: Bar IO, _baz :: Baz IO }
instance Has Foo IO Env where dep (Env {_foo}) = _foo
instance Has Bar IO Env where dep (Env {_bar}) = _bar
instance Has Baz IO Env where dep (Env {_baz}) = _baz

env :: Env
env = let e = Env mkFoo (mkBar e) (mkBaz e) in e

main :: IO ()
main = let (asCall -> call) = env in call baz 4