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