packages feed

tricorder-0.2.0.0: src/Tricorder/CLI/App.hs

module Tricorder.CLI.App (run) where

import Atelier.Effects.Clock (Clock)
import Atelier.Effects.Conc (Conc)
import Atelier.Effects.Console (Console)
import Atelier.Effects.Delay (Delay)
import Atelier.Effects.Exit (Exit)
import Atelier.Effects.File (File)
import Atelier.Effects.FileSystem (FileSystem)
import Atelier.Effects.Posix.Daemons (Daemons)
import Atelier.Effects.Process (Process)
import Atelier.Effects.Timeout (Timeout)
import Effectful (IOE)
import Effectful.Concurrent (Concurrent)
import Effectful.Reader.Static (Reader, ask, asks)
import Prelude hiding (force)

import Atelier.Effects.Console qualified as Console
import Data.Text qualified as T

import Tricorder.Build (BuildState (..))
import Tricorder.CLI.Arguments (Command (..), LogMode (..))
import Tricorder.CLI.Daemon
    ( restartDaemon
    , startDaemon
    , stopDaemon
    , waitForDaemon
    )
import Tricorder.CLI.Operations
    ( showEvalComments
    , showLog
    , showSource
    , showStatus
    , showTests
    )
import Tricorder.CLI.UI (viewUi)
import Tricorder.CLI.UI.Brick (Brick)
import Tricorder.CLI.UI.BrickChan (BrickChan)
import Tricorder.Daemon.DaemonInfo (DaemonInfo (..))
import Tricorder.Runtime (LogPath (..), PidFile (..), SocketPath (..))
import Tricorder.Socket.Client (isDaemonRunning, queryStatus)
import Tricorder.Socket.UnixSocket (UnixSocket)

import Tricorder.CLI.UI.Keys qualified as Keys


run
    :: ( Brick :> es
       , BrickChan :> es
       , Clock :> es
       , Conc :> es
       , Concurrent :> es
       , Console :> es
       , Daemons :> es
       , Delay :> es
       , Exit :> es
       , File :> es
       , FileSystem :> es
       , IOE :> es
       , Process :> es
       , Reader Command :> es
       , Reader Keys.Config :> es
       , Reader LogPath :> es
       , Reader PidFile :> es
       , Reader SocketPath :> es
       , Timeout :> es
       , UnixSocket :> es
       )
    => Eff es ()
run =
    ask >>= \case
        Start -> do
            running <- isDaemonRunning
            if running then
                Console.putStrLn "Daemon already running."
            else do
                startDaemon
                ready <- waitForDaemon
                if ready then
                    Console.putStrLn "Daemon started."
                else
                    Console.putStrLn "Daemon started, but the socket is not responding yet."
        Stop force -> do
            running <- isDaemonRunning
            when running
                $ stopDaemon force >>= \case
                    Left reasons ->
                        Console.putTextLn
                            $ T.intercalate "\n"
                            $ "Was unable to stop the daemon:" : reasons
                    Right result -> do
                        Console.putTextLn result
        Status opts -> do
            running <- isDaemonRunning
            if not running then
                Console.putStrLn "Stopped."
            else
                showStatus opts
        Test opts -> do
            running <- isDaemonRunning
            if not running then
                Console.putStrLn "Stopped."
            else
                showTests opts
        Log logMode -> do
            running <- isDaemonRunning
            logFile <-
                if running then do
                    SocketPath sp <- ask
                    result <- queryStatus sp
                    LogPath fallback <- ask
                    pure $ case result of
                        Right state -> state.daemonInfo.logFile
                        Left _ -> fallback
                else
                    asks @LogPath (.getLogPath)
            case logMode of
                ShowLog followMode -> showLog logFile followMode
                ShowLogPath -> Console.putTextLn (toText logFile)
        UI -> do
            running <- isDaemonRunning
            unless running do
                startDaemon
                void waitForDaemon
            viewUi
        Source moduleNames -> do
            running <- isDaemonRunning
            unless running $ do
                startDaemon
                void waitForDaemon
            showSource moduleNames
        Restart force ->
            restartDaemon force >>= \case
                Just (Left reasons) -> traverse_ Console.putTextLn reasons
                _ -> pass
        EvalComments opts -> do
            running <- isDaemonRunning
            unless running do
                startDaemon
                void waitForDaemon
            showEvalComments opts