sensei-0.8.0: src/Config.hs

{-# LANGUAGE CPP #-}
module Config (
  Config(..)
, Hook
, HookResult(..)
, defaultConfig
, loadConfig
#ifdef TEST
, ConfigFile(..)
, readConfigFilesFrom
#endif
) where

import Imports

import GHC.Generics
import Data.ByteString qualified as ByteString
import System.Directory
import System.Process
import Text.Casing
import Data.Aeson
import Data.Yaml

import Util

configFilename :: FilePath
configFilename = "sensei.yaml"

data ConfigFile = ConfigFile {
  -- | Shell command to run after a file has changed, but before reloading. Cancels the current
  -- trigger cycle when exiting with non-zero exit code.
  beforeReload :: Maybe String
  -- | Shell command to run after a successful reload, but before running the tests. Cancels the
  -- current trigger cycle when exiting with non-zero exit code.
, afterReload :: Maybe String
  -- | Shell command to run after the trigger cycle completed with failure. Has access to the result
  -- via seito.
, onFailure :: Maybe String
  -- | Shell command to run after the trigger cycle successfully completed. Has access to the result
  -- via seito.
, onSuccess :: Maybe String
} deriving (Generic, Show, Eq)

instance Semigroup ConfigFile where
  a <> b = ConfigFile {
    beforeReload = a.beforeReload <|> b.beforeReload
  , afterReload = a.afterReload <|> b.afterReload
  , onFailure = a.onFailure <|> b.onFailure
  , onSuccess = a.onSuccess <|> b.onSuccess
  }

instance Monoid ConfigFile where
  mempty = ConfigFile Nothing Nothing Nothing Nothing

instance FromJSON ConfigFile where
  parseJSON = \ case
    Null -> return mempty
    value -> genericParseJSON defaultOptions {
        fieldLabelModifier = kebab
      , rejectUnknownFields = True
      } value

type Hook = IO HookResult

data HookResult = HookSuccess | HookFailure String

data Config = Config {
  senseiHooksBeforeReload :: Hook
, senseiHooksAfterReload :: Hook
, senseiHooksOnSuccess :: Hook
, senseiHooksOnFailure :: Hook
}

tryReadFile :: FilePath -> IO (Maybe ByteString)
tryReadFile = fmap (either (const Nothing) Just) . tryJust (guard . isDoesNotExistError) . ByteString.readFile

readConfigFile :: FilePath -> IO (Either String ConfigFile)
readConfigFile path = tryReadFile path >>= \ case
  Just input -> return $ first displayException . decodeEither' $ input
  Nothing -> return $ Right mempty

readConfigFiles :: IO (Either String ConfigFile)
readConfigFiles = do
  configDir <- getXdgDirectory XdgConfig "sensei"
  readConfigFilesFrom (configDir </> configFilename) configFilename

readConfigFilesFrom :: FilePath -> FilePath -> IO (Either String ConfigFile)
readConfigFilesFrom global local = fmap mconcat . sequence <$> sequence [
    readConfigFile local
  , readConfigFile global
  ]

toConfig :: ConfigFile -> Config
toConfig ConfigFile{..} = Config {
  senseiHooksBeforeReload = maybeToHook "before-reload" beforeReload
, senseiHooksAfterReload = maybeToHook "after-reload" afterReload
, senseiHooksOnSuccess = maybeToHook "on-success" onSuccess
, senseiHooksOnFailure = maybeToHook "on-failure" onFailure
} where
    maybeToHook :: String -> Maybe String -> Hook
    maybeToHook name = maybe (return HookSuccess) (toHook name)

    toHook :: String -> String -> Hook
    toHook name command = system command >>= \ case
      ExitSuccess -> return HookSuccess
      ExitFailure code -> do
        let message = withColor Red $ name <> ": " <> command <> "  # failed with status " <> show code
        return $ HookFailure message

defaultConfig :: Config
defaultConfig = toConfig mempty

loadConfig :: IO Config
loadConfig = readConfigFiles >>= either (throwIO . ErrorCall) (return . toConfig)