module Stackctl.Spec.Discover
( forEachSpec_
, discoverSpecs
, buildSpecPath
) where
import Stackctl.Prelude
import Data.List.Extra (dropPrefix)
import qualified Data.List.NonEmpty as NE
import qualified Data.List.NonEmpty.Extra as NE
import Data.Text.Metrics (levenshtein)
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
Maybe (NonEmpty StackSpec)
mAllSpecs <- forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty 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
case Maybe (NonEmpty StackSpec)
mAllSpecs of
Maybe (NonEmpty StackSpec)
Nothing -> do
[]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarn
( Text
"Missing or empty specification directory"
Text -> [SeriesElem] -> Message
:# [ Key
"directory" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
dir
, Key
"hint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"Is this the correct directory?" :: Text)
]
)
Just NonEmpty StackSpec
allSpecs -> do
let
known :: NonEmpty StackName
known = StackSpec -> StackName
stackSpecStackName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty StackSpec
allSpecs
specs :: [StackSpec]
specs =
[StackSpec] -> [StackSpec]
sortStackSpecs
forall a b. (a -> b) -> a -> b
$ FilterOption -> [StackSpec] -> [StackSpec]
filterStackSpecs FilterOption
filterOption
forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty StackSpec
allSpecs
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *).
MonadLogger m =>
NonEmpty StackName -> StackSpec -> m ()
checkForUnknownDepends NonEmpty StackName
known) [StackSpec]
specs
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 matched filters"
[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
checkForUnknownDepends
:: MonadLogger m => NonEmpty StackName -> StackSpec -> m ()
checkForUnknownDepends :: forall (m :: * -> *).
MonadLogger m =>
NonEmpty StackName -> StackSpec -> m ()
checkForUnknownDepends NonEmpty StackName
known StackSpec
spec =
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ NonEmpty StackName -> m ()
reportUnknownDepends
forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` NonEmpty StackName
known)
forall a b. (a -> b) -> a -> b
$ StackSpec -> [StackName]
stackSpecDepends StackSpec
spec
where
reportUnknownDepends :: NonEmpty StackName -> m ()
reportUnknownDepends NonEmpty StackName
depends = do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NonEmpty StackName
depends forall a b. (a -> b) -> a -> b
$ \StackName
depend -> do
let (StackName
nearest, Int
_distance) =
forall a. (a -> a -> Ordering) -> NonEmpty a -> a
NE.minimumBy1 (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> b
snd)
forall a b. (a -> b) -> a -> b
$ (forall a. a -> a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& StackName -> StackName -> Int
getDistance StackName
depend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty StackName
known
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarn
forall a b. (a -> b) -> a -> b
$ Text
"Stack lists dependency that does not exist"
Text -> [SeriesElem] -> Message
:# [ Key
"dependency"
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ( StackName -> Text
unStackName (StackSpec -> StackName
stackSpecStackName StackSpec
spec)
forall a. Semigroup a => a -> a -> a
<> Text
" -> "
forall a. Semigroup a => a -> a -> a
<> StackName -> Text
unStackName StackName
depend
)
, Key
"hint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"Did you mean " forall a. Semigroup a => a -> a -> a
<> StackName -> Text
unStackName StackName
nearest forall a. Semigroup a => a -> a -> a
<> Text
"?")
]
getDistance :: StackName -> StackName -> Int
getDistance = Text -> Text -> Int
levenshtein forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` StackName -> Text
unStackName
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