{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Development.Guardian.Graph.Adapter.Detection (
  detectAdapter,
  detectAdapterThrow,
  detectFromDir,
  detectFromDomainConfig,
  DetectionFailure (..),
) where

import Control.Monad.Trans.Except (ExceptT (..), catchE, runExceptT, throwE)
import Data.Aeson (Value)
import qualified Data.Aeson as J
import qualified Data.Aeson.KeyMap as AKM
import Development.Guardian.Graph.Adapter.Types
import Path (Path, relfile, (</>))
import Path.IO
import Path.Posix (Dir)
import RIO

data DetectionFailure
  = BothCabalAndStackSectionsPresentInConfigYaml
  | BothCabalProjectAndStackYamlFound
  | NeitherCabalProjectNorStackYamlFound
  | NoCustomConfigSpecified
  | MalformedConfigYaml Value
  deriving (Int -> DetectionFailure -> ShowS
[DetectionFailure] -> ShowS
DetectionFailure -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectionFailure] -> ShowS
$cshowList :: [DetectionFailure] -> ShowS
show :: DetectionFailure -> String
$cshow :: DetectionFailure -> String
showsPrec :: Int -> DetectionFailure -> ShowS
$cshowsPrec :: Int -> DetectionFailure -> ShowS
Show, DetectionFailure -> DetectionFailure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectionFailure -> DetectionFailure -> Bool
$c/= :: DetectionFailure -> DetectionFailure -> Bool
== :: DetectionFailure -> DetectionFailure -> Bool
$c== :: DetectionFailure -> DetectionFailure -> Bool
Eq, Eq DetectionFailure
DetectionFailure -> DetectionFailure -> Bool
DetectionFailure -> DetectionFailure -> Ordering
DetectionFailure -> DetectionFailure -> DetectionFailure
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DetectionFailure -> DetectionFailure -> DetectionFailure
$cmin :: DetectionFailure -> DetectionFailure -> DetectionFailure
max :: DetectionFailure -> DetectionFailure -> DetectionFailure
$cmax :: DetectionFailure -> DetectionFailure -> DetectionFailure
>= :: DetectionFailure -> DetectionFailure -> Bool
$c>= :: DetectionFailure -> DetectionFailure -> Bool
> :: DetectionFailure -> DetectionFailure -> Bool
$c> :: DetectionFailure -> DetectionFailure -> Bool
<= :: DetectionFailure -> DetectionFailure -> Bool
$c<= :: DetectionFailure -> DetectionFailure -> Bool
< :: DetectionFailure -> DetectionFailure -> Bool
$c< :: DetectionFailure -> DetectionFailure -> Bool
compare :: DetectionFailure -> DetectionFailure -> Ordering
$ccompare :: DetectionFailure -> DetectionFailure -> Ordering
Ord, forall x. Rep DetectionFailure x -> DetectionFailure
forall x. DetectionFailure -> Rep DetectionFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectionFailure x -> DetectionFailure
$cfrom :: forall x. DetectionFailure -> Rep DetectionFailure x
Generic)

instance Exception DetectionFailure where
  displayException :: DetectionFailure -> String
displayException DetectionFailure
BothCabalAndStackSectionsPresentInConfigYaml =
    String
"Could not determine adapter: dependency-domain.yml contains both cabal and stack configuration"
  displayException DetectionFailure
BothCabalProjectAndStackYamlFound =
    String
"Could not determine adapter: Both cabal.project and stack.yaml found"
  displayException DetectionFailure
NeitherCabalProjectNorStackYamlFound =
    String
"Could not determine adapter: Neither cabal.project nor stack.yaml found"
  displayException DetectionFailure
NoCustomConfigSpecified =
    String
"Could not determine adapter: config file doesn't include neither cabal or stack"
  displayException (MalformedConfigYaml Value
_va) =
    let kind :: String
kind = case Value
_va of
          J.Object {} -> String
"an object"
          J.Array {} -> String
"an array"
          J.String {} -> String
"a string"
          J.Number {} -> String
"a number"
          J.Bool {} -> String
"a boolean value"
          J.Null {} -> String
"null"
     in String
"Could not determine adapter: malformed configuration; must be object, but got: " forall a. Semigroup a => a -> a -> a
<> String
kind

detectAdapterThrow :: MonadIO m => Value -> Path b Dir -> m StandardAdapters
detectAdapterThrow :: forall (m :: * -> *) b.
MonadIO m =>
Value -> Path b Dir -> m StandardAdapters
detectAdapterThrow Value
val = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) b.
MonadIO m =>
Value -> Path b Dir -> m (Either DetectionFailure StandardAdapters)
detectAdapter Value
val

detectAdapter :: MonadIO m => Value -> Path b Dir -> m (Either DetectionFailure StandardAdapters)
detectAdapter :: forall (m :: * -> *) b.
MonadIO m =>
Value -> Path b Dir -> m (Either DetectionFailure StandardAdapters)
detectAdapter Value
config Path b Dir
dir = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
  forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m (Either DetectionFailure StandardAdapters)
detectFromDir Path b Dir
dir) forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE` \case
    DetectionFailure
NeitherCabalProjectNorStackYamlFound ->
      forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Value -> Either DetectionFailure StandardAdapters
detectFromDomainConfig Value
config
    DetectionFailure
BothCabalProjectAndStackYamlFound ->
      forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Value -> Either DetectionFailure StandardAdapters
detectFromDomainConfig Value
config
    DetectionFailure
exc -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE DetectionFailure
exc

{- |
Searching for stack.yaml and cabal.project, chooses that one if exactly one of them is found.
-}
detectFromDir ::
  MonadIO m =>
  Path b Dir ->
  m (Either DetectionFailure StandardAdapters)
detectFromDir :: forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m (Either DetectionFailure StandardAdapters)
detectFromDir Path b Dir
dir0 = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
  Path Abs Dir
dir <- forall path (m :: * -> *).
(AnyPath path, MonadIO m) =>
path -> m (AbsPath path)
canonicalizePath Path b Dir
dir0
  Bool
stackThere <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist (Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|stack.yaml|])
  Bool
cabalThere <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist (Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|cabal.project|])
  if
      | Bool
stackThere Bool -> Bool -> Bool
&& Bool
cabalThere -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE DetectionFailure
BothCabalProjectAndStackYamlFound
      | Bool
stackThere -> forall (f :: * -> *) a. Applicative f => a -> f a
pure StandardAdapters
Stack
      | Bool
cabalThere -> forall (f :: * -> *) a. Applicative f => a -> f a
pure StandardAdapters
Cabal
      | Bool
otherwise -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE DetectionFailure
NeitherCabalProjectNorStackYamlFound

{- |
Detects backend from dependency-domains.yml.
If exactly one of `cabal' or `stack' section is present, prefer it.
-}
detectFromDomainConfig :: Value -> Either DetectionFailure StandardAdapters
detectFromDomainConfig :: Value -> Either DetectionFailure StandardAdapters
detectFromDomainConfig Value
val =
  case Value
val of
    J.Object Object
dic -> do
      let cabalPresent :: Bool
cabalPresent = forall a. Key -> KeyMap a -> Bool
AKM.member Key
"cabal" Object
dic
          stackPresent :: Bool
stackPresent = forall a. Key -> KeyMap a -> Bool
AKM.member Key
"stack" Object
dic
      if
          | Bool
cabalPresent Bool -> Bool -> Bool
&& Bool
stackPresent -> forall a b. a -> Either a b
Left DetectionFailure
BothCabalAndStackSectionsPresentInConfigYaml
          | Bool
cabalPresent -> forall a b. b -> Either a b
Right StandardAdapters
Cabal
          | Bool
stackPresent -> forall a b. b -> Either a b
Right StandardAdapters
Stack
          | Bool
otherwise -> forall a b. a -> Either a b
Left DetectionFailure
NoCustomConfigSpecified
    Value
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Value -> DetectionFailure
MalformedConfigYaml Value
val