{-# 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
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
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