SmallExample.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE RecordWildCards     #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

{-
  This module tests the construction of some simple values
  using a registry
-}
module Test.Data.Registry.SmallExample where

import           Data.Registry
import           Data.Text             (splitOn)
import           Protolude             as P
import           Test.Tasty.Extensions hiding (run)

-- | Components of the application
--     - a Logger
--     - an interface to S3
--     - a lines counter
--     - the top level application
newtype Logger = Logger {
  info :: Text -> IO ()
} deriving Typeable

newLogger :: Logger
newLogger = Logger print

noLogging = Logger (const (pure ()))

newtype LinesCounter = LinesCounter {
  count :: Text -> Int
} deriving Typeable

newLinesCounter :: LinesCounter
newLinesCounter = LinesCounter $ \t -> length (splitOn "\n" t)

newtype S3 = S3 {
  store :: Text -> IO ()
} deriving Typeable

data S3Config = S3Config {
   bucket :: Text
,  key    :: Text
} deriving (Eq, Show, Typeable)

newS3 :: MonadIO m => S3Config -> Logger -> m S3
newS3 config logger = pure $ S3 $
  \t -> (logger & info) ("storing on S3 with config " <> P.show config) >>
        void (print t) -- send the text to s3

newtype Application = Application {
  run :: Text -> IO Int
} deriving Typeable

newApplication :: MonadIO m => Logger -> LinesCounter -> S3 -> m Application
newApplication Logger {..} LinesCounter {..} S3 {..} = pure . Application $ \t -> do
  info "count lines"
  let n = count t

  info "store the lines on s3"
  store ("counted " <> P.show n <> " lines")
  pure n

-- | Create a registry for all constructors
registry =
     funTo @IO (newS3 @IO)
  +: funTo @IO (newApplication @IO)
  +: funTo @IO noLogging
  +: funTo @IO newLinesCounter
  +: valTo @IO (S3Config "bucket" "key")
  +: end

-- | To create the application you call `make` for the `Application` type
--   with the registry above
--   Since the registry contains all functions and values necessary to create the application
--   Everything will work fine
createApplication :: IO Application
createApplication = make @(IO Application) (funTo @IO noLogging +: registry)

test_create = test "create the application" $ do
  app <- liftIO createApplication -- nothing should crash!
  r   <- liftIO $ (app & run) "hello\nworld"
  r === 2