MakeApp.hs

{-# LANGUAGE BlockArguments #-}
{-|
Module      : Hasklepias.MakeApp
Description : Functions for creating a cohort application
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Hasklepias.MakeApp (
   makeCohortApp
) where

import Control.Monad                        ( Monad(return), Functor(fmap) )
import Control.Applicative                  ( Applicative )
import Data.Aeson                           ( encode, FromJSON, ToJSON(..) )
import Data.Bifunctor                       ( Bifunctor(second) )
import qualified Data.ByteString.Lazy as B
import Data.ByteString.Lazy.Char8 as C      ( putStrLn )
import Data.Function                        ( ($), (.) )
import Data.List                            ( (++) )
import Data.Monoid                          ( Monoid(mconcat) )
import Data.String                          ( String )
import Data.Text                            ( pack, Text )
import Data.Tuple                           ( fst, snd )
import GHC.Show                             ( Show(show) )
import GHC.IO                               ( IO )

import EventData                            ( Events )
import Hasklepias.Aeson                     ( parsePopulationLines, ParseError )
import Hasklepias.Cohort                    ( evalCohort, Cohort, CohortSpec )
import IntervalAlgebra                      ( IntervalSizeable )

import Control.Monad.IO.Class               (MonadIO, liftIO)
import Control.Monad.Reader                 (MonadReader (..), ReaderT (..))
import Colog                                ( Message
                                            , HasLog(..)
                                            , WithLog
                                            , LogAction(..)
                                            , richMessageAction
                                            , logInfo
                                            , logError
                                            , logStringStdout
                                            , logStringStderr
                                            , logText
                                            , withLog
                                            , logPrint
                                            , logPrintStderr 
                                            , (<&)
                                            , (>$)
                                            , log )
import System.Console.CmdArgs               ( Data, Typeable
                                            , cmdArgs, summary, help, (&=) )
import System.Environment                   (getArgs)

-- a stub to add more arguments to later
data MakeCohort = MakeCohort deriving (Show, Data, Typeable)

makeAppArgs ::
     String  -- ^ name of the application
  -> String  -- ^ version of the application 
  -> MakeCohort
makeAppArgs name version = MakeCohort
    {
    } &= help "Pass event data via stdin."
      &= summary (name ++ " " ++ version)

makeCohortBuilder :: (FromJSON a, Show a, IntervalSizeable a b, ToJSON d0, Monad m) =>
     [CohortSpec (Events a) d0]
  -> m (B.ByteString -> m ([ParseError], [Cohort d0]))
makeCohortBuilder specs =
  return (return . second (\pop -> fmap (`evalCohort` pop) specs) . parsePopulationLines)

-- logging based on example here:
-- https://github.com/kowainik/co-log/blob/main/co-log/tutorials/Main.hs
parseErrorL :: LogAction IO ParseError
parseErrorL = logPrintStderr

logParseErrors :: [ParseError] -> IO ()
logParseErrors x = mconcat $ fmap (parseErrorL <&) x

-- | Make a command line cohort building application.
makeCohortApp :: (FromJSON a, Show a, IntervalSizeable a b, ToJSON d0) =>
       String  -- ^ cohort name
    -> String  -- ^ app version
    -> [CohortSpec (Events a) d0]  -- ^ a list of cohort specifications
    -> IO ()
makeCohortApp name version spec =
    do
      args <- cmdArgs ( makeAppArgs name version )
      let logger = logStringStdout

      logger <& "Creating cohort builder..."
      app <- makeCohortBuilder spec

      logger <& "Reading data from stdin..."
      dat  <- B.getContents

      logger <& "Bulding cohort..."
      res <- app dat

      logParseErrors (fst res)

      logger <& "Encoding cohort(s) output and writing to stdout..."
      C.putStrLn (encode ( toJSON (snd res) ))

      logger <& "Cohort build complete!"