module Stackctl.Spec.Discover
  ( forEachSpec_
  , discoverSpecs
  , buildSpecPath
  ) where

import Stackctl.Prelude

import Data.List.Extra (dropPrefix)
import qualified Data.List.NonEmpty as NE
import Stackctl.AWS
import Stackctl.AWS.Scope
import Stackctl.Config (HasConfig)
import Stackctl.DirectoryOption (HasDirectoryOption (..), unDirectoryOption)
import Stackctl.FilterOption (HasFilterOption (..), filterStackSpecs)
import Stackctl.StackSpec
import Stackctl.StackSpecPath
import System.FilePath (isPathSeparator)
import System.FilePath.Glob

forEachSpec_
  :: ( MonadMask m
     , MonadResource m
     , MonadLogger m
     , MonadReader env m
     , HasAwsScope env
     , HasConfig env
     , HasDirectoryOption env
     , HasFilterOption env
     )
  => (StackSpec -> m ())
  -> m ()
forEachSpec_ :: forall (m :: * -> *) env.
(MonadMask m, MonadResource m, MonadLogger m, MonadReader env m,
 HasAwsScope env, HasConfig env, HasDirectoryOption env,
 HasFilterOption env) =>
(StackSpec -> m ()) -> m ()
forEachSpec_ StackSpec -> m ()
f = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ StackSpec -> m ()
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) env.
(MonadMask m, MonadResource m, MonadLogger m, MonadReader env m,
 HasAwsScope env, HasConfig env, HasDirectoryOption env,
 HasFilterOption env) =>
m [StackSpec]
discoverSpecs

discoverSpecs
  :: ( MonadMask m
     , MonadResource m
     , MonadLogger m
     , MonadReader env m
     , HasAwsScope env
     , HasConfig env
     , HasDirectoryOption env
     , HasFilterOption env
     )
  => m [StackSpec]
discoverSpecs :: forall (m :: * -> *) env.
(MonadMask m, MonadResource m, MonadLogger m, MonadReader env m,
 HasAwsScope env, HasConfig env, HasDirectoryOption env,
 HasFilterOption env) =>
m [StackSpec]
discoverSpecs = do
  FilePath
dir <- DirectoryOption -> FilePath
unDirectoryOption forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasDirectoryOption env => Lens' env DirectoryOption
directoryOptionL
  AwsScope
scope <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasAwsScope env => Lens' env AwsScope
awsScopeL
  [FilePath]
paths <- forall (m :: * -> *).
MonadIO m =>
FilePath -> [Pattern] -> m [FilePath]
globRelativeTo FilePath
dir forall a b. (a -> b) -> a -> b
$ AwsScope -> [Pattern]
awsScopeSpecPatterns AwsScope
scope
  FilterOption
filterOption <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasFilterOption env => Lens' env FilterOption
filterOptionL

  let
    toSpecPath :: FilePath -> Either FilePath StackSpecPath
toSpecPath = AwsScope -> FilePath -> Either FilePath StackSpecPath
stackSpecPathFromFilePath AwsScope
scope
    ([FilePath]
errs, [StackSpecPath]
specPaths) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Either FilePath StackSpecPath
toSpecPath [FilePath]
paths

    context :: [Pair]
context =
      [ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
dir
      , Key
"filters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilterOption
filterOption
      , Key
"paths" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
paths
      , Key
"errors" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
errs
      , Key
"specs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (t :: * -> *) a. Foldable t => t a -> Int
length [StackSpecPath]
specPaths
      ]

  forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Pair] -> m a -> m a
withThreadContext [Pair]
context forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
[StackSpecPath] -> m ()
checkForDuplicateStackNames [StackSpecPath]
specPaths

    [StackSpec]
specs <-
      [StackSpec] -> [StackSpec]
sortStackSpecs
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilterOption -> [StackSpec] -> [StackSpec]
filterStackSpecs FilterOption
filterOption
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasConfig env) =>
FilePath -> StackSpecPath -> m StackSpec
readStackSpec FilePath
dir) [StackSpecPath]
specPaths

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [StackSpec]
specs) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarn Message
"No specs found"
    [StackSpec]
specs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug (Text
"Discovered specs" Text -> [SeriesElem] -> Message
:# [Key
"matched" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (t :: * -> *) a. Foldable t => t a -> Int
length [StackSpec]
specs])

checkForDuplicateStackNames
  :: (MonadIO m, MonadLogger m) => [StackSpecPath] -> m ()
checkForDuplicateStackNames :: forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
[StackSpecPath] -> m ()
checkForDuplicateStackNames =
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
NonEmpty (NonEmpty StackSpecPath) -> m ()
reportCollisions
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
NE.groupAllWith StackSpecPath -> StackName
stackSpecPathStackName
 where
  reportCollisions
    :: (MonadIO m, MonadLogger m) => NonEmpty (NonEmpty StackSpecPath) -> m ()
  reportCollisions :: forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
NonEmpty (NonEmpty StackSpecPath) -> m ()
reportCollisions NonEmpty (NonEmpty StackSpecPath)
errs = do
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NonEmpty (NonEmpty StackSpecPath)
errs forall a b. (a -> b) -> a -> b
$ \NonEmpty StackSpecPath
specPaths -> do
      let collidingPaths :: NonEmpty FilePath
collidingPaths = StackSpecPath -> FilePath
stackSpecPathBasePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty StackSpecPath
specPaths

      forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError
        forall a b. (a -> b) -> a -> b
$ Text
"Multiple specifications produced the same Stack name"
        Text -> [SeriesElem] -> Message
:# [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StackSpecPath -> StackName
stackSpecPathStackName (forall a. NonEmpty a -> a
NE.head NonEmpty StackSpecPath
specPaths)
           , Key
"paths" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty FilePath
collidingPaths
           ]

    forall (m :: * -> *) a. MonadIO m => m a
exitFailure

buildSpecPath
  :: (MonadReader env m, HasAwsScope env)
  => StackName
  -> FilePath
  -> m StackSpecPath
buildSpecPath :: forall env (m :: * -> *).
(MonadReader env m, HasAwsScope env) =>
StackName -> FilePath -> m StackSpecPath
buildSpecPath StackName
stackName FilePath
stackPath = do
  AwsScope
scope <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasAwsScope env => Lens' env AwsScope
awsScopeL
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AwsScope -> StackName -> FilePath -> StackSpecPath
stackSpecPath AwsScope
scope StackName
stackName FilePath
stackPath

globRelativeTo :: MonadIO m => FilePath -> [Pattern] -> m [FilePath]
globRelativeTo :: forall (m :: * -> *).
MonadIO m =>
FilePath -> [Pattern] -> m [FilePath]
globRelativeTo FilePath
dir [Pattern]
ps = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [a]
dropPrefix FilePath
dir) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern] -> FilePath -> IO [[FilePath]]
globDir [Pattern]
ps FilePath
dir