{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}

-- Proof of concept application, defines custom @Producer@ and FSM @Pipe@
-- components. Publishes a new number (in sequence) through ZMQ every second.
-- Throws an exception after a set number of pulses is reached.
module Main
  ( main
  )
where

import Control.Concurrent (threadDelay)
import Control.Exception.Safe (StringException, throwString)
import Control.Monad (forever)
import Control.Monad.Extra (whenM)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (asks)
import Control.Monad.State (get, gets, modify)
import Data.Aeson (FromJSON)
import Data.Function ((&))
import Data.Text (Text, pack)
import Effectful (IOE, runEff)
import Effectful.Log (Log, localDomain, logInfo_, logTrace_, runLog)
import Effectful.Reader.Static (Reader, runReader)
import Effectful.Resource (Resource, runResource)
import Effectful.State.Static.Local (State, evalState)
import GHC.Generics (Generic)
import Hsm.Core.App (launch)
import Hsm.Core.Fsm (FsmC, Method (Method), fsm)
import Hsm.Core.Pipes (Pipe, Producer, await, runEffect, yield, (>->))
import Hsm.Core.Zmq (server)

data Env = Env
  { name :: Text
  , pubEp :: Text
  , pulses :: Int
  }
  deriving (FromJSON, Generic)

type Effs = [Log, Reader Env, Resource, State Int, IOE]

type Pulser = Producer () Env Int Effs

type FsmMethodC es = (FsmC Env Int StringException es)

type FsmMethod es = Method () Int Env Int StringException es

type FsmPipe es = Pipe () Int Env Int es

pulser :: Pulser ()
pulser =
  localDomain "pulser" $
    forever $
      liftIO (threadDelay 1000000) >> logTrace_ "Tick" >> yield ()

stateRun :: FsmMethodC es => FsmMethod es
stateRun =
  Method "run" $ do
    check >> await >> modify succ >> report >> get >>= yield
    return stateRun
 where
  check :: FsmMethodC es => FsmPipe es ()
  check =
    asks pulses >>= \top ->
      whenM (gets (== top)) $
        throwString $
          "Reached " <> show top <> " pulses"

  report :: FsmMethodC es => FsmPipe es ()
  report = get >>= logInfo_ . mappend "Sending pulse #" . pack . show

stateError :: FsmMethodC es => FsmMethod es
stateError = Method "error" $ logInfo_ "Doing nothing" >> forever await

main :: IO ()
main =
  launch "dummy-pulser" $ \logger level e ->
    (pulser >-> fsm stateRun stateError >-> server)
      & runEffect
      & runLog e.name logger level
      & runReader e
      & runResource
      & evalState 0
      & runEff