monad-classes.hs

-- | Use 'MonadLogger' from 'monad-logger' or something else already there in
-- the real-world application
class Monad m => MonadLog m where
   log :: Text -> m ()

class Monad m => MonadProgress m where
    reportProgress
        :: Int  -- ^ done
        -> Int  -- ^ all work
        -> m ()

-- Trivial instances for the classes
-- IO case could be more clever, so logging and progress reporting don't infer

instance MonadLog IO where
    log = Text.hPutStrLn stderr

instance MonadProgress IO where
    -- Using stuff from terminal-progress-bar
    reportProgress x y =
        progressBar noLabel noLabel 72 (fromIntegral x) (fromIntegral y)


-- Instances for testing
instance MonadLog Identity where
   log _ = pure ()

instance MonadProgress Identity where
   reportProgress _ _ = pure ()

-- The beef

data Input
data Output

work
    :: (MonadLog m, MonadProgress m)
    => Input
    -> m Output

-- for tests:

pureWork :: Input -> Output
pureWork = runIdentity . work

-- for cli

ioWork :: Input -> IO Output
ioWork = work