{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.IDE
( OutputStream (..)
, ListPackagesCmd (..)
, idePackagesCmd
, ideTargetsCmd
, listPackages
, listTargets
) where
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import Stack.Prelude
import Stack.Runners
( ShouldReexec (..), withBuildConfig, withConfig )
import Stack.Types.BuildConfig
( BuildConfig (..), HasBuildConfig (..) )
import Stack.Types.NamedComponent
( NamedComponent, renderPkgComponent )
import Stack.Types.Runner ( Runner )
import Stack.Types.SourceMap
( ProjectPackage (..), SMWanted (..), ppComponents )
import System.IO ( putStrLn )
data OutputStream
= OutputLogInfo
| OutputStdout
data ListPackagesCmd
= ListPackageNames
| ListPackageCabalFiles
idePackagesCmd :: (OutputStream, ListPackagesCmd) -> RIO Runner ()
idePackagesCmd :: (OutputStream, ListPackagesCmd) -> RIO Runner ()
idePackagesCmd =
forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
NoReexec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RIO BuildConfig a -> RIO Config a
withBuildConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall env.
HasBuildConfig env =>
OutputStream -> ListPackagesCmd -> RIO env ()
listPackages
ideTargetsCmd :: OutputStream -> RIO Runner ()
ideTargetsCmd :: OutputStream -> RIO Runner ()
ideTargetsCmd = forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
NoReexec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RIO BuildConfig a -> RIO Config a
withBuildConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. HasBuildConfig env => OutputStream -> RIO env ()
listTargets
outputFunc :: HasTerm env => OutputStream -> String -> RIO env ()
outputFunc :: forall env. HasTerm env => OutputStream -> String -> RIO env ()
outputFunc OutputStream
OutputLogInfo = forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
outputFunc OutputStream
OutputStdout = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn
listPackages ::
HasBuildConfig env
=> OutputStream
-> ListPackagesCmd
-> RIO env ()
listPackages :: forall env.
HasBuildConfig env =>
OutputStream -> ListPackagesCmd -> RIO env ()
listPackages OutputStream
stream ListPackagesCmd
flag = do
Map PackageName ProjectPackage
packages <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (SMWanted -> Map PackageName ProjectPackage
smwProject forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> SMWanted
bcSMWanted)
let strs :: [String]
strs = case ListPackagesCmd
flag of
ListPackagesCmd
ListPackageNames ->
forall a b. (a -> b) -> [a] -> [b]
map PackageName -> String
packageNameString (forall k a. Map k a -> [k]
Map.keys Map PackageName ProjectPackage
packages)
ListPackagesCmd
ListPackageCabalFiles ->
forall a b. (a -> b) -> [a] -> [b]
map (forall b t. Path b t -> String
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectPackage -> Path Abs File
ppCabalFP) (forall k a. Map k a -> [a]
Map.elems Map PackageName ProjectPackage
packages)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall env. HasTerm env => OutputStream -> String -> RIO env ()
outputFunc OutputStream
stream) [String]
strs
listTargets :: forall env. HasBuildConfig env => OutputStream -> RIO env ()
listTargets :: forall env. HasBuildConfig env => OutputStream -> RIO env ()
listTargets OutputStream
stream = do
Map PackageName ProjectPackage
packages <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (SMWanted -> Map PackageName ProjectPackage
smwProject forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> SMWanted
bcSMWanted)
[(PackageName, NamedComponent)]
pairs <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey PackageName
-> ProjectPackage -> RIO env [(PackageName, NamedComponent)]
toNameAndComponent Map PackageName ProjectPackage
packages
forall env. HasTerm env => OutputStream -> String -> RIO env ()
outputFunc OutputStream
stream forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (PackageName, NamedComponent) -> Text
renderPkgComponent [(PackageName, NamedComponent)]
pairs
where
toNameAndComponent ::
PackageName
-> ProjectPackage
-> RIO env [(PackageName, NamedComponent)]
toNameAndComponent :: PackageName
-> ProjectPackage -> RIO env [(PackageName, NamedComponent)]
toNameAndComponent PackageName
pkgName' =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (PackageName
pkgName', ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m (Set NamedComponent)
ppComponents