{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}

module Hercules.Secrets
  ( SecretContext (..),
    evalCondition,
    evalConditionTrace,
  )
where

import Control.Monad.Writer qualified
import Data.Binary (Binary)
import Data.Tagged
import Data.Text qualified as T
import Hercules.Formats.Secret
import Protolude

data SecretContext = SecretContext
  { ownerName :: Text,
    repoName :: Text,
    isDefaultBranch :: Bool,
    ref :: Text
  }
  deriving (Generic, Binary, Show, Eq)

evalCondition' :: (Monad m, MonadMiniWriter [Text] m) => SecretContext -> Condition -> m Bool
evalCondition' ctx = eval
  where
    eval (Or cs) = do
      tell ["or: Entering"]
      let go [] = do
            tell ["or: Leaving (false)"]
            pure False
          go (a : as) = do
            b <- eval a
            if b
              then do
                tell ["or: Leaving (true)"]
                pure True
              else do
                unless (null as) (tell ["or: Backtracking"])
                go as
      go cs
    eval (And cs) = do
      tell ["and: Entering"]
      let go [] = do
            tell ["and: Leaving (true)"]
            pure True
          go (a : as) = do
            b <- eval a
            if b
              then go as
              else do
                tell ["and: Leaving (false)"]
                pure False
      go cs
    eval IsDefaultBranch =
      if isDefaultBranch ctx
        then pure True
        else False <$ tell ["isDefaultBranch: ref " <> show (ref ctx) <> " is not the default branch"]
    eval IsTag =
      if "refs/tags/" `T.isPrefixOf` ref ctx
        then pure True
        else False <$ tell ["isTag: ref " <> show (ref ctx) <> " is not a tag"]
    eval (IsBranch b) = do
      let expect = "refs/heads/" <> b
          actual = ref ctx
      if expect == actual
        then pure True
        else False <$ tell ["isBranch: ref " <> show actual <> " is not the desired " <> show expect]
    eval (IsRepo expect) = do
      let actual = repoName ctx
      if actual == expect
        then pure True
        else False <$ tell ["isRepo: repo " <> show actual <> " is not the desired " <> show expect]
    eval (IsOwner expect) = do
      let actual = ownerName ctx
      if actual == expect
        then pure True
        else False <$ tell ["isOwner: owner " <> show actual <> " is not the desired " <> show expect]
    eval (Hercules.Formats.Secret.Const b) = do
      tell ["const: " <> show b]
      pure b

-- This uses tagless final to derive both an efficient and a tracing function.

evalCondition :: SecretContext -> Condition -> Bool
evalCondition ctx c = unTagged (evalCondition' ctx c :: Tagged [Text] Bool)

evalConditionTrace :: SecretContext -> Condition -> ([Text], Bool)
evalConditionTrace = evalCondition'

-- | Like 'Control.Monad.Class.Writer.MonadWriter' but simpler.
class MonadMiniWriter w m | m -> w where
  tell :: w -> m ()

instance (Monoid w) => MonadMiniWriter w ((,) w) where
  tell = Control.Monad.Writer.tell

instance MonadMiniWriter w (Tagged w) where
  tell _ = pure ()