{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Stack.Ls
  ( lsCmd
  , lsParser
  , listDependenciesCmd
  ) where

import Control.Exception (throw)
import Data.Aeson
import Data.Array.IArray ((//), elems)
import Stack.Prelude hiding (Snapshot (..))
import qualified Data.Aeson.Types as A
import qualified Data.List as L
import Data.Text hiding (pack, intercalate)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Vector as V
import Network.HTTP.StackClient (httpJSON, addRequestHeader, getResponseBody, parseRequest, hAccept)
import qualified Options.Applicative as OA
import Options.Applicative (idm)
import Options.Applicative.Builder.Extra (boolFlags)
import Path
import RIO.PrettyPrint (useColorL)
import RIO.PrettyPrint.DefaultStyles (defaultStyles)
import RIO.PrettyPrint.Types (StyleSpec)
import RIO.PrettyPrint.StylesUpdate (StylesUpdate (..), stylesUpdateL)
import Stack.Dot
import Stack.Runners
import Stack.Options.DotParser (listDepsOptsParser)
import Stack.Types.Config
import System.Console.ANSI.Codes (SGR (Reset), setSGRCode, sgrToCode)
import System.Process.Pager (pageText)
import System.Directory (listDirectory)

data LsView
    = Local
    | Remote
    deriving (Int -> LsView -> ShowS
[LsView] -> ShowS
LsView -> String
(Int -> LsView -> ShowS)
-> (LsView -> String) -> ([LsView] -> ShowS) -> Show LsView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LsView] -> ShowS
$cshowList :: [LsView] -> ShowS
show :: LsView -> String
$cshow :: LsView -> String
showsPrec :: Int -> LsView -> ShowS
$cshowsPrec :: Int -> LsView -> ShowS
Show, LsView -> LsView -> Bool
(LsView -> LsView -> Bool)
-> (LsView -> LsView -> Bool) -> Eq LsView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LsView -> LsView -> Bool
$c/= :: LsView -> LsView -> Bool
== :: LsView -> LsView -> Bool
$c== :: LsView -> LsView -> Bool
Eq, Eq LsView
Eq LsView =>
(LsView -> LsView -> Ordering)
-> (LsView -> LsView -> Bool)
-> (LsView -> LsView -> Bool)
-> (LsView -> LsView -> Bool)
-> (LsView -> LsView -> Bool)
-> (LsView -> LsView -> LsView)
-> (LsView -> LsView -> LsView)
-> Ord LsView
LsView -> LsView -> Bool
LsView -> LsView -> Ordering
LsView -> LsView -> LsView
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 :: LsView -> LsView -> LsView
$cmin :: LsView -> LsView -> LsView
max :: LsView -> LsView -> LsView
$cmax :: LsView -> LsView -> LsView
>= :: LsView -> LsView -> Bool
$c>= :: LsView -> LsView -> Bool
> :: LsView -> LsView -> Bool
$c> :: LsView -> LsView -> Bool
<= :: LsView -> LsView -> Bool
$c<= :: LsView -> LsView -> Bool
< :: LsView -> LsView -> Bool
$c< :: LsView -> LsView -> Bool
compare :: LsView -> LsView -> Ordering
$ccompare :: LsView -> LsView -> Ordering
$cp1Ord :: Eq LsView
Ord)

data SnapshotType
    = Lts
    | Nightly
    deriving (Int -> SnapshotType -> ShowS
[SnapshotType] -> ShowS
SnapshotType -> String
(Int -> SnapshotType -> ShowS)
-> (SnapshotType -> String)
-> ([SnapshotType] -> ShowS)
-> Show SnapshotType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotType] -> ShowS
$cshowList :: [SnapshotType] -> ShowS
show :: SnapshotType -> String
$cshow :: SnapshotType -> String
showsPrec :: Int -> SnapshotType -> ShowS
$cshowsPrec :: Int -> SnapshotType -> ShowS
Show, SnapshotType -> SnapshotType -> Bool
(SnapshotType -> SnapshotType -> Bool)
-> (SnapshotType -> SnapshotType -> Bool) -> Eq SnapshotType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotType -> SnapshotType -> Bool
$c/= :: SnapshotType -> SnapshotType -> Bool
== :: SnapshotType -> SnapshotType -> Bool
$c== :: SnapshotType -> SnapshotType -> Bool
Eq, Eq SnapshotType
Eq SnapshotType =>
(SnapshotType -> SnapshotType -> Ordering)
-> (SnapshotType -> SnapshotType -> Bool)
-> (SnapshotType -> SnapshotType -> Bool)
-> (SnapshotType -> SnapshotType -> Bool)
-> (SnapshotType -> SnapshotType -> Bool)
-> (SnapshotType -> SnapshotType -> SnapshotType)
-> (SnapshotType -> SnapshotType -> SnapshotType)
-> Ord SnapshotType
SnapshotType -> SnapshotType -> Bool
SnapshotType -> SnapshotType -> Ordering
SnapshotType -> SnapshotType -> SnapshotType
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 :: SnapshotType -> SnapshotType -> SnapshotType
$cmin :: SnapshotType -> SnapshotType -> SnapshotType
max :: SnapshotType -> SnapshotType -> SnapshotType
$cmax :: SnapshotType -> SnapshotType -> SnapshotType
>= :: SnapshotType -> SnapshotType -> Bool
$c>= :: SnapshotType -> SnapshotType -> Bool
> :: SnapshotType -> SnapshotType -> Bool
$c> :: SnapshotType -> SnapshotType -> Bool
<= :: SnapshotType -> SnapshotType -> Bool
$c<= :: SnapshotType -> SnapshotType -> Bool
< :: SnapshotType -> SnapshotType -> Bool
$c< :: SnapshotType -> SnapshotType -> Bool
compare :: SnapshotType -> SnapshotType -> Ordering
$ccompare :: SnapshotType -> SnapshotType -> Ordering
$cp1Ord :: Eq SnapshotType
Ord)

data LsCmds
    = LsSnapshot SnapshotOpts
    | LsDependencies ListDepsOpts
    | LsStyles ListStylesOpts

data SnapshotOpts = SnapshotOpts
    { SnapshotOpts -> LsView
soptViewType :: LsView
    , SnapshotOpts -> Bool
soptLtsSnapView :: Bool
    , SnapshotOpts -> Bool
soptNightlySnapView :: Bool
    } deriving (SnapshotOpts -> SnapshotOpts -> Bool
(SnapshotOpts -> SnapshotOpts -> Bool)
-> (SnapshotOpts -> SnapshotOpts -> Bool) -> Eq SnapshotOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotOpts -> SnapshotOpts -> Bool
$c/= :: SnapshotOpts -> SnapshotOpts -> Bool
== :: SnapshotOpts -> SnapshotOpts -> Bool
$c== :: SnapshotOpts -> SnapshotOpts -> Bool
Eq, Int -> SnapshotOpts -> ShowS
[SnapshotOpts] -> ShowS
SnapshotOpts -> String
(Int -> SnapshotOpts -> ShowS)
-> (SnapshotOpts -> String)
-> ([SnapshotOpts] -> ShowS)
-> Show SnapshotOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotOpts] -> ShowS
$cshowList :: [SnapshotOpts] -> ShowS
show :: SnapshotOpts -> String
$cshow :: SnapshotOpts -> String
showsPrec :: Int -> SnapshotOpts -> ShowS
$cshowsPrec :: Int -> SnapshotOpts -> ShowS
Show, Eq SnapshotOpts
Eq SnapshotOpts =>
(SnapshotOpts -> SnapshotOpts -> Ordering)
-> (SnapshotOpts -> SnapshotOpts -> Bool)
-> (SnapshotOpts -> SnapshotOpts -> Bool)
-> (SnapshotOpts -> SnapshotOpts -> Bool)
-> (SnapshotOpts -> SnapshotOpts -> Bool)
-> (SnapshotOpts -> SnapshotOpts -> SnapshotOpts)
-> (SnapshotOpts -> SnapshotOpts -> SnapshotOpts)
-> Ord SnapshotOpts
SnapshotOpts -> SnapshotOpts -> Bool
SnapshotOpts -> SnapshotOpts -> Ordering
SnapshotOpts -> SnapshotOpts -> SnapshotOpts
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 :: SnapshotOpts -> SnapshotOpts -> SnapshotOpts
$cmin :: SnapshotOpts -> SnapshotOpts -> SnapshotOpts
max :: SnapshotOpts -> SnapshotOpts -> SnapshotOpts
$cmax :: SnapshotOpts -> SnapshotOpts -> SnapshotOpts
>= :: SnapshotOpts -> SnapshotOpts -> Bool
$c>= :: SnapshotOpts -> SnapshotOpts -> Bool
> :: SnapshotOpts -> SnapshotOpts -> Bool
$c> :: SnapshotOpts -> SnapshotOpts -> Bool
<= :: SnapshotOpts -> SnapshotOpts -> Bool
$c<= :: SnapshotOpts -> SnapshotOpts -> Bool
< :: SnapshotOpts -> SnapshotOpts -> Bool
$c< :: SnapshotOpts -> SnapshotOpts -> Bool
compare :: SnapshotOpts -> SnapshotOpts -> Ordering
$ccompare :: SnapshotOpts -> SnapshotOpts -> Ordering
$cp1Ord :: Eq SnapshotOpts
Ord)

data ListStylesOpts = ListStylesOpts
    { ListStylesOpts -> Bool
coptBasic   :: Bool
    , ListStylesOpts -> Bool
coptSGR     :: Bool
    , ListStylesOpts -> Bool
coptExample :: Bool
    } deriving (ListStylesOpts -> ListStylesOpts -> Bool
(ListStylesOpts -> ListStylesOpts -> Bool)
-> (ListStylesOpts -> ListStylesOpts -> Bool) -> Eq ListStylesOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStylesOpts -> ListStylesOpts -> Bool
$c/= :: ListStylesOpts -> ListStylesOpts -> Bool
== :: ListStylesOpts -> ListStylesOpts -> Bool
$c== :: ListStylesOpts -> ListStylesOpts -> Bool
Eq, Eq ListStylesOpts
Eq ListStylesOpts =>
(ListStylesOpts -> ListStylesOpts -> Ordering)
-> (ListStylesOpts -> ListStylesOpts -> Bool)
-> (ListStylesOpts -> ListStylesOpts -> Bool)
-> (ListStylesOpts -> ListStylesOpts -> Bool)
-> (ListStylesOpts -> ListStylesOpts -> Bool)
-> (ListStylesOpts -> ListStylesOpts -> ListStylesOpts)
-> (ListStylesOpts -> ListStylesOpts -> ListStylesOpts)
-> Ord ListStylesOpts
ListStylesOpts -> ListStylesOpts -> Bool
ListStylesOpts -> ListStylesOpts -> Ordering
ListStylesOpts -> ListStylesOpts -> ListStylesOpts
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 :: ListStylesOpts -> ListStylesOpts -> ListStylesOpts
$cmin :: ListStylesOpts -> ListStylesOpts -> ListStylesOpts
max :: ListStylesOpts -> ListStylesOpts -> ListStylesOpts
$cmax :: ListStylesOpts -> ListStylesOpts -> ListStylesOpts
>= :: ListStylesOpts -> ListStylesOpts -> Bool
$c>= :: ListStylesOpts -> ListStylesOpts -> Bool
> :: ListStylesOpts -> ListStylesOpts -> Bool
$c> :: ListStylesOpts -> ListStylesOpts -> Bool
<= :: ListStylesOpts -> ListStylesOpts -> Bool
$c<= :: ListStylesOpts -> ListStylesOpts -> Bool
< :: ListStylesOpts -> ListStylesOpts -> Bool
$c< :: ListStylesOpts -> ListStylesOpts -> Bool
compare :: ListStylesOpts -> ListStylesOpts -> Ordering
$ccompare :: ListStylesOpts -> ListStylesOpts -> Ordering
$cp1Ord :: Eq ListStylesOpts
Ord, Int -> ListStylesOpts -> ShowS
[ListStylesOpts] -> ShowS
ListStylesOpts -> String
(Int -> ListStylesOpts -> ShowS)
-> (ListStylesOpts -> String)
-> ([ListStylesOpts] -> ShowS)
-> Show ListStylesOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStylesOpts] -> ShowS
$cshowList :: [ListStylesOpts] -> ShowS
show :: ListStylesOpts -> String
$cshow :: ListStylesOpts -> String
showsPrec :: Int -> ListStylesOpts -> ShowS
$cshowsPrec :: Int -> ListStylesOpts -> ShowS
Show)

newtype LsCmdOpts = LsCmdOpts
    { LsCmdOpts -> LsCmds
lsView :: LsCmds
    }

lsParser :: OA.Parser LsCmdOpts
lsParser :: Parser LsCmdOpts
lsParser = LsCmds -> LsCmdOpts
LsCmdOpts (LsCmds -> LsCmdOpts) -> Parser LsCmds -> Parser LsCmdOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod CommandFields LsCmds -> Parser LsCmds
forall a. Mod CommandFields a -> Parser a
OA.hsubparser (Mod CommandFields LsCmds
lsSnapCmd Mod CommandFields LsCmds
-> Mod CommandFields LsCmds -> Mod CommandFields LsCmds
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields LsCmds
lsDepsCmd Mod CommandFields LsCmds
-> Mod CommandFields LsCmds -> Mod CommandFields LsCmds
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields LsCmds
lsStylesCmd)

lsCmdOptsParser :: OA.Parser LsCmds
lsCmdOptsParser :: Parser LsCmds
lsCmdOptsParser = SnapshotOpts -> LsCmds
LsSnapshot (SnapshotOpts -> LsCmds) -> Parser SnapshotOpts -> Parser LsCmds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SnapshotOpts
lsViewSnapCmd

lsDepOptsParser :: OA.Parser LsCmds
lsDepOptsParser :: Parser LsCmds
lsDepOptsParser = ListDepsOpts -> LsCmds
LsDependencies (ListDepsOpts -> LsCmds) -> Parser ListDepsOpts -> Parser LsCmds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ListDepsOpts
listDepsOptsParser

lsStylesOptsParser :: OA.Parser LsCmds
lsStylesOptsParser :: Parser LsCmds
lsStylesOptsParser = ListStylesOpts -> LsCmds
LsStyles (ListStylesOpts -> LsCmds)
-> Parser ListStylesOpts -> Parser LsCmds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ListStylesOpts
listStylesOptsParser

listStylesOptsParser :: OA.Parser ListStylesOpts
listStylesOptsParser :: Parser ListStylesOpts
listStylesOptsParser = Bool -> Bool -> Bool -> ListStylesOpts
ListStylesOpts
    (Bool -> Bool -> Bool -> ListStylesOpts)
-> Parser Bool -> Parser (Bool -> Bool -> ListStylesOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
False
                  "basic"
                  "a basic report of the styles used. The default is a fuller \
                  \one"
                  Mod FlagFields Bool
forall m. Monoid m => m
idm
    Parser (Bool -> Bool -> ListStylesOpts)
-> Parser Bool -> Parser (Bool -> ListStylesOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
True
                  "sgr"
                  "the provision of the equivalent SGR instructions (provided \
                  \by default). Flag ignored for a basic report"
                  Mod FlagFields Bool
forall m. Monoid m => m
idm
    Parser (Bool -> ListStylesOpts)
-> Parser Bool -> Parser ListStylesOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
True
                  "example"
                  "the provision of an example of the applied style (provided \
                  \by default for colored output). Flag ignored for a basic \
                  \report"
                  Mod FlagFields Bool
forall m. Monoid m => m
idm

lsViewSnapCmd :: OA.Parser SnapshotOpts
lsViewSnapCmd :: Parser SnapshotOpts
lsViewSnapCmd =
    LsView -> Bool -> Bool -> SnapshotOpts
SnapshotOpts (LsView -> Bool -> Bool -> SnapshotOpts)
-> Parser LsView -> Parser (Bool -> Bool -> SnapshotOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Mod CommandFields LsView -> Parser LsView
forall a. Mod CommandFields a -> Parser a
OA.hsubparser (Mod CommandFields LsView
lsViewRemoteCmd Mod CommandFields LsView
-> Mod CommandFields LsView -> Mod CommandFields LsView
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields LsView
lsViewLocalCmd) Parser LsView -> Parser LsView -> Parser LsView
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LsView -> Parser LsView
forall (f :: * -> *) a. Applicative f => a -> f a
pure LsView
Local) Parser (Bool -> Bool -> SnapshotOpts)
-> Parser Bool -> Parser (Bool -> SnapshotOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Mod FlagFields Bool -> Parser Bool
OA.switch
        (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long "lts" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short 'l' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
OA.help "Only show lts snapshots") Parser (Bool -> SnapshotOpts) -> Parser Bool -> Parser SnapshotOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Mod FlagFields Bool -> Parser Bool
OA.switch
        (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long "nightly" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short 'n' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
         String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
OA.help "Only show nightly snapshots")

lsSnapCmd :: OA.Mod OA.CommandFields LsCmds
lsSnapCmd :: Mod CommandFields LsCmds
lsSnapCmd =
    String -> ParserInfo LsCmds -> Mod CommandFields LsCmds
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command
        "snapshots"
        (Parser LsCmds -> InfoMod LsCmds -> ParserInfo LsCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
             Parser LsCmds
lsCmdOptsParser
             (String -> InfoMod LsCmds
forall a. String -> InfoMod a
OA.progDesc "View local snapshot (default option)"))

lsDepsCmd :: OA.Mod OA.CommandFields LsCmds
lsDepsCmd :: Mod CommandFields LsCmds
lsDepsCmd =
    String -> ParserInfo LsCmds -> Mod CommandFields LsCmds
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command
        "dependencies"
        (Parser LsCmds -> InfoMod LsCmds -> ParserInfo LsCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info Parser LsCmds
lsDepOptsParser (String -> InfoMod LsCmds
forall a. String -> InfoMod a
OA.progDesc "View the dependencies"))

lsStylesCmd :: OA.Mod OA.CommandFields LsCmds
lsStylesCmd :: Mod CommandFields LsCmds
lsStylesCmd =
    String -> ParserInfo LsCmds -> Mod CommandFields LsCmds
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command
        "stack-colors"
        (Parser LsCmds -> InfoMod LsCmds -> ParserInfo LsCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info Parser LsCmds
lsStylesOptsParser
                 (String -> InfoMod LsCmds
forall a. String -> InfoMod a
OA.progDesc "View stack's output styles"))
    Mod CommandFields LsCmds
-> Mod CommandFields LsCmds -> Mod CommandFields LsCmds
forall a. Semigroup a => a -> a -> a
<>
    String -> ParserInfo LsCmds -> Mod CommandFields LsCmds
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command
        "stack-colours"
        (Parser LsCmds -> InfoMod LsCmds -> ParserInfo LsCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info Parser LsCmds
lsStylesOptsParser
                 (String -> InfoMod LsCmds
forall a. String -> InfoMod a
OA.progDesc "View stack's output styles (alias for \
                              \'stack-colors')"))

data Snapshot = Snapshot
    { Snapshot -> Text
snapId :: Text
    , Snapshot -> Text
snapTitle :: Text
    , Snapshot -> Text
snapTime :: Text
    } deriving (Int -> Snapshot -> ShowS
[Snapshot] -> ShowS
Snapshot -> String
(Int -> Snapshot -> ShowS)
-> (Snapshot -> String) -> ([Snapshot] -> ShowS) -> Show Snapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Snapshot] -> ShowS
$cshowList :: [Snapshot] -> ShowS
show :: Snapshot -> String
$cshow :: Snapshot -> String
showsPrec :: Int -> Snapshot -> ShowS
$cshowsPrec :: Int -> Snapshot -> ShowS
Show, Snapshot -> Snapshot -> Bool
(Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Bool) -> Eq Snapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Snapshot -> Snapshot -> Bool
$c/= :: Snapshot -> Snapshot -> Bool
== :: Snapshot -> Snapshot -> Bool
$c== :: Snapshot -> Snapshot -> Bool
Eq, Eq Snapshot
Eq Snapshot =>
(Snapshot -> Snapshot -> Ordering)
-> (Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Snapshot)
-> (Snapshot -> Snapshot -> Snapshot)
-> Ord Snapshot
Snapshot -> Snapshot -> Bool
Snapshot -> Snapshot -> Ordering
Snapshot -> Snapshot -> Snapshot
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 :: Snapshot -> Snapshot -> Snapshot
$cmin :: Snapshot -> Snapshot -> Snapshot
max :: Snapshot -> Snapshot -> Snapshot
$cmax :: Snapshot -> Snapshot -> Snapshot
>= :: Snapshot -> Snapshot -> Bool
$c>= :: Snapshot -> Snapshot -> Bool
> :: Snapshot -> Snapshot -> Bool
$c> :: Snapshot -> Snapshot -> Bool
<= :: Snapshot -> Snapshot -> Bool
$c<= :: Snapshot -> Snapshot -> Bool
< :: Snapshot -> Snapshot -> Bool
$c< :: Snapshot -> Snapshot -> Bool
compare :: Snapshot -> Snapshot -> Ordering
$ccompare :: Snapshot -> Snapshot -> Ordering
$cp1Ord :: Eq Snapshot
Ord)

data SnapshotData = SnapshotData
    { SnapshotData -> Integer
_snapTotalCounts :: Integer
    , SnapshotData -> [[Snapshot]]
snaps :: [[Snapshot]]
    } deriving (Int -> SnapshotData -> ShowS
[SnapshotData] -> ShowS
SnapshotData -> String
(Int -> SnapshotData -> ShowS)
-> (SnapshotData -> String)
-> ([SnapshotData] -> ShowS)
-> Show SnapshotData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotData] -> ShowS
$cshowList :: [SnapshotData] -> ShowS
show :: SnapshotData -> String
$cshow :: SnapshotData -> String
showsPrec :: Int -> SnapshotData -> ShowS
$cshowsPrec :: Int -> SnapshotData -> ShowS
Show, SnapshotData -> SnapshotData -> Bool
(SnapshotData -> SnapshotData -> Bool)
-> (SnapshotData -> SnapshotData -> Bool) -> Eq SnapshotData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotData -> SnapshotData -> Bool
$c/= :: SnapshotData -> SnapshotData -> Bool
== :: SnapshotData -> SnapshotData -> Bool
$c== :: SnapshotData -> SnapshotData -> Bool
Eq, Eq SnapshotData
Eq SnapshotData =>
(SnapshotData -> SnapshotData -> Ordering)
-> (SnapshotData -> SnapshotData -> Bool)
-> (SnapshotData -> SnapshotData -> Bool)
-> (SnapshotData -> SnapshotData -> Bool)
-> (SnapshotData -> SnapshotData -> Bool)
-> (SnapshotData -> SnapshotData -> SnapshotData)
-> (SnapshotData -> SnapshotData -> SnapshotData)
-> Ord SnapshotData
SnapshotData -> SnapshotData -> Bool
SnapshotData -> SnapshotData -> Ordering
SnapshotData -> SnapshotData -> SnapshotData
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 :: SnapshotData -> SnapshotData -> SnapshotData
$cmin :: SnapshotData -> SnapshotData -> SnapshotData
max :: SnapshotData -> SnapshotData -> SnapshotData
$cmax :: SnapshotData -> SnapshotData -> SnapshotData
>= :: SnapshotData -> SnapshotData -> Bool
$c>= :: SnapshotData -> SnapshotData -> Bool
> :: SnapshotData -> SnapshotData -> Bool
$c> :: SnapshotData -> SnapshotData -> Bool
<= :: SnapshotData -> SnapshotData -> Bool
$c<= :: SnapshotData -> SnapshotData -> Bool
< :: SnapshotData -> SnapshotData -> Bool
$c< :: SnapshotData -> SnapshotData -> Bool
compare :: SnapshotData -> SnapshotData -> Ordering
$ccompare :: SnapshotData -> SnapshotData -> Ordering
$cp1Ord :: Eq SnapshotData
Ord)

instance FromJSON Snapshot where
    parseJSON :: Value -> Parser Snapshot
parseJSON o :: Value
o@(Array _) = Value -> Parser Snapshot
parseSnapshot Value
o
    parseJSON _ = Parser Snapshot
forall m. Monoid m => m
mempty

instance FromJSON SnapshotData where
    parseJSON :: Value -> Parser SnapshotData
parseJSON (Object s :: Object
s) =
        Integer -> [[Snapshot]] -> SnapshotData
SnapshotData (Integer -> [[Snapshot]] -> SnapshotData)
-> Parser Integer -> Parser ([[Snapshot]] -> SnapshotData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
s Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: "totalCount" Parser ([[Snapshot]] -> SnapshotData)
-> Parser [[Snapshot]] -> Parser SnapshotData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
s Object -> Text -> Parser [[Snapshot]]
forall a. FromJSON a => Object -> Text -> Parser a
.: "snapshots"
    parseJSON _ = Parser SnapshotData
forall m. Monoid m => m
mempty

toSnapshot :: [Value] -> Snapshot
toSnapshot :: [Value] -> Snapshot
toSnapshot [String sid :: Text
sid, String stitle :: Text
stitle, String stime :: Text
stime] =
    Snapshot :: Text -> Text -> Text -> Snapshot
Snapshot
    { snapId :: Text
snapId = Text
sid
    , snapTitle :: Text
snapTitle = Text
stitle
    , snapTime :: Text
snapTime = Text
stime
    }
toSnapshot val :: [Value]
val = LsException -> Snapshot
forall a e. Exception e => e -> a
throw (LsException -> Snapshot) -> LsException -> Snapshot
forall a b. (a -> b) -> a -> b
$ [Value] -> LsException
ParseFailure [Value]
val

newtype LsException =
    ParseFailure [Value]
    deriving (Int -> LsException -> ShowS
[LsException] -> ShowS
LsException -> String
(Int -> LsException -> ShowS)
-> (LsException -> String)
-> ([LsException] -> ShowS)
-> Show LsException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LsException] -> ShowS
$cshowList :: [LsException] -> ShowS
show :: LsException -> String
$cshow :: LsException -> String
showsPrec :: Int -> LsException -> ShowS
$cshowsPrec :: Int -> LsException -> ShowS
Show, Typeable)

instance Exception LsException

parseSnapshot :: Value -> A.Parser Snapshot
parseSnapshot :: Value -> Parser Snapshot
parseSnapshot = String -> (Array -> Parser Snapshot) -> Value -> Parser Snapshot
forall a. String -> (Array -> Parser a) -> Value -> Parser a
A.withArray "array of snapshot" (Snapshot -> Parser Snapshot
forall (m :: * -> *) a. Monad m => a -> m a
return (Snapshot -> Parser Snapshot)
-> (Array -> Snapshot) -> Array -> Parser Snapshot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Snapshot
toSnapshot ([Value] -> Snapshot) -> (Array -> [Value]) -> Array -> Snapshot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall a. Vector a -> [a]
V.toList)

displayTime :: Snapshot -> [Text]
displayTime :: Snapshot -> [Text]
displayTime Snapshot {..} = [Text
snapTime]

displaySnap :: Snapshot -> [Text]
displaySnap :: Snapshot -> [Text]
displaySnap Snapshot {..} =
    ["Resolver name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
snapId, "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
snapTitle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n\n"]

displaySingleSnap :: [Snapshot] -> Text
displaySingleSnap :: [Snapshot] -> Text
displaySingleSnap snapshots :: [Snapshot]
snapshots =
    case [Snapshot]
snapshots of
        [] -> Text
forall m. Monoid m => m
mempty
        (x :: Snapshot
x:xs :: [Snapshot]
xs) ->
            let snaps :: [Text]
snaps =
                    Snapshot -> [Text]
displayTime Snapshot
x [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ["\n\n"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Snapshot -> [Text]
displaySnap Snapshot
x [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
                    (Snapshot -> [Text]) -> [Snapshot] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
L.concatMap Snapshot -> [Text]
displaySnap [Snapshot]
xs
            in [Text] -> Text
T.concat [Text]
snaps

renderData :: Bool -> Text -> IO ()
renderData :: Bool -> Text -> IO ()
renderData True content :: Text
content = Text -> IO ()
pageText Text
content
renderData False content :: Text
content = Text -> IO ()
T.putStr Text
content

displaySnapshotData :: Bool -> SnapshotData -> IO ()
displaySnapshotData :: Bool -> SnapshotData -> IO ()
displaySnapshotData term :: Bool
term sdata :: SnapshotData
sdata =
    case [[Snapshot]] -> [[Snapshot]]
forall a. [a] -> [a]
L.reverse ([[Snapshot]] -> [[Snapshot]]) -> [[Snapshot]] -> [[Snapshot]]
forall a b. (a -> b) -> a -> b
$ SnapshotData -> [[Snapshot]]
snaps SnapshotData
sdata of
        [] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        xs :: [[Snapshot]]
xs ->
            let snaps :: Text
snaps = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([Snapshot] -> Text) -> [[Snapshot]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
L.map [Snapshot] -> Text
displaySingleSnap [[Snapshot]]
xs
            in Bool -> Text -> IO ()
renderData Bool
term Text
snaps

filterSnapshotData :: SnapshotData -> SnapshotType -> SnapshotData
filterSnapshotData :: SnapshotData -> SnapshotType -> SnapshotData
filterSnapshotData sdata :: SnapshotData
sdata stype :: SnapshotType
stype =
    SnapshotData
sdata
    { snaps :: [[Snapshot]]
snaps = [[Snapshot]]
filterSnapData
    }
  where
    snapdata :: [[Snapshot]]
snapdata = SnapshotData -> [[Snapshot]]
snaps SnapshotData
sdata
    filterSnapData :: [[Snapshot]]
filterSnapData =
        case SnapshotType
stype of
            Lts -> ([Snapshot] -> [Snapshot]) -> [[Snapshot]] -> [[Snapshot]]
forall a b. (a -> b) -> [a] -> [b]
L.map ((Snapshot -> Bool) -> [Snapshot] -> [Snapshot]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\x :: Snapshot
x -> "lts" Text -> Text -> Bool
`isPrefixOf` Snapshot -> Text
snapId Snapshot
x)) [[Snapshot]]
snapdata
            Nightly ->
                ([Snapshot] -> [Snapshot]) -> [[Snapshot]] -> [[Snapshot]]
forall a b. (a -> b) -> [a] -> [b]
L.map ((Snapshot -> Bool) -> [Snapshot] -> [Snapshot]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\x :: Snapshot
x -> "nightly" Text -> Text -> Bool
`isPrefixOf` Snapshot -> Text
snapId Snapshot
x)) [[Snapshot]]
snapdata

displayLocalSnapshot :: Bool -> [String] -> IO ()
displayLocalSnapshot :: Bool -> [String] -> IO ()
displayLocalSnapshot term :: Bool
term xs :: [String]
xs = Bool -> Text -> IO ()
renderData Bool
term ([String] -> Text
localSnaptoText [String]
xs)

localSnaptoText :: [String] -> Text
localSnaptoText :: [String] -> Text
localSnaptoText xs :: [String]
xs = Text -> [Text] -> Text
T.intercalate "\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
L.map String -> Text
T.pack [String]
xs

handleLocal :: LsCmdOpts -> RIO Runner ()
handleLocal :: LsCmdOpts -> RIO Runner ()
handleLocal lsOpts :: LsCmdOpts
lsOpts = do
    (Path Abs Dir
instRoot :: Path Abs Dir) <- ShouldReexec
-> RIO Config (Path Abs Dir) -> RIO Runner (Path Abs Dir)
forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
YesReexec (RIO Config (Path Abs Dir) -> RIO Runner (Path Abs Dir))
-> RIO Config (Path Abs Dir) -> RIO Runner (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ RIO EnvConfig (Path Abs Dir) -> RIO Config (Path Abs Dir)
forall a. RIO EnvConfig a -> RIO Config a
withDefaultEnvConfig RIO EnvConfig (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps
    Bool
isStdoutTerminal <- Getting Bool Runner Bool -> RIO Runner Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Runner Bool
forall env. HasRunner env => Lens' env Bool
terminalL
    let snapRootDir :: Path Abs Dir
snapRootDir = Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs Dir -> Path Abs Dir) -> Path Abs Dir -> Path Abs Dir
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
instRoot
    [String]
snapData' <- IO [String] -> RIO Runner [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> RIO Runner [String])
-> IO [String] -> RIO Runner [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
listDirectory (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
snapRootDir
    let snapData :: [String]
snapData = [String] -> [String]
forall a. Ord a => [a] -> [a]
L.sort [String]
snapData'
    case LsCmdOpts -> LsCmds
lsView LsCmdOpts
lsOpts of
        LsSnapshot SnapshotOpts {..} ->
            case (Bool
soptLtsSnapView, Bool
soptNightlySnapView) of
                (True, False) ->
                    IO () -> RIO Runner ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Runner ()) -> IO () -> RIO Runner ()
forall a b. (a -> b) -> a -> b
$
                    Bool -> [String] -> IO ()
displayLocalSnapshot Bool
isStdoutTerminal ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
                    (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf "lts") [String]
snapData
                (False, True) ->
                    IO () -> RIO Runner ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Runner ()) -> IO () -> RIO Runner ()
forall a b. (a -> b) -> a -> b
$
                    Bool -> [String] -> IO ()
displayLocalSnapshot Bool
isStdoutTerminal ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
                    (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf "night") [String]
snapData
                _ -> IO () -> RIO Runner ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Runner ()) -> IO () -> RIO Runner ()
forall a b. (a -> b) -> a -> b
$ Bool -> [String] -> IO ()
displayLocalSnapshot Bool
isStdoutTerminal [String]
snapData
        LsDependencies _ -> () -> RIO Runner ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        LsStyles _ -> () -> RIO Runner ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

handleRemote
    :: HasRunner env
    => LsCmdOpts -> RIO env ()
handleRemote :: LsCmdOpts -> RIO env ()
handleRemote lsOpts :: LsCmdOpts
lsOpts = do
    Request
req <- IO Request -> RIO env Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> RIO env Request) -> IO Request -> RIO env Request
forall a b. (a -> b) -> a -> b
$ String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
urlInfo
    Bool
isStdoutTerminal <- Getting Bool env Bool -> RIO env Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool env Bool
forall env. HasRunner env => Lens' env Bool
terminalL
    let req' :: Request
req' = HeaderName -> ByteString -> Request -> Request
addRequestHeader HeaderName
hAccept "application/json" Request
req
    Response SnapshotData
result <- Request -> RIO env (Response SnapshotData)
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON Request
req'
    let snapData :: SnapshotData
snapData = Response SnapshotData -> SnapshotData
forall a. Response a -> a
getResponseBody Response SnapshotData
result
    case LsCmdOpts -> LsCmds
lsView LsCmdOpts
lsOpts of
        LsSnapshot SnapshotOpts {..} ->
            case (Bool
soptLtsSnapView, Bool
soptNightlySnapView) of
                (True, False) ->
                    IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
                    Bool -> SnapshotData -> IO ()
displaySnapshotData Bool
isStdoutTerminal (SnapshotData -> IO ()) -> SnapshotData -> IO ()
forall a b. (a -> b) -> a -> b
$
                    SnapshotData -> SnapshotType -> SnapshotData
filterSnapshotData SnapshotData
snapData SnapshotType
Lts
                (False, True) ->
                    IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
                    Bool -> SnapshotData -> IO ()
displaySnapshotData Bool
isStdoutTerminal (SnapshotData -> IO ()) -> SnapshotData -> IO ()
forall a b. (a -> b) -> a -> b
$
                    SnapshotData -> SnapshotType -> SnapshotData
filterSnapshotData SnapshotData
snapData SnapshotType
Nightly
                _ -> IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Bool -> SnapshotData -> IO ()
displaySnapshotData Bool
isStdoutTerminal SnapshotData
snapData
        LsDependencies _ -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        LsStyles _ -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    urlInfo :: String
urlInfo = "https://www.stackage.org/snapshots"

lsCmd :: LsCmdOpts -> RIO Runner ()
lsCmd :: LsCmdOpts -> RIO Runner ()
lsCmd lsOpts :: LsCmdOpts
lsOpts =
    case LsCmdOpts -> LsCmds
lsView LsCmdOpts
lsOpts of
        LsSnapshot SnapshotOpts {..} ->
            case LsView
soptViewType of
                Local -> LsCmdOpts -> RIO Runner ()
handleLocal LsCmdOpts
lsOpts
                Remote -> LsCmdOpts -> RIO Runner ()
forall env. HasRunner env => LsCmdOpts -> RIO env ()
handleRemote LsCmdOpts
lsOpts
        LsDependencies depOpts :: ListDepsOpts
depOpts -> Bool -> ListDepsOpts -> RIO Runner ()
listDependenciesCmd Bool
False ListDepsOpts
depOpts
        LsStyles stylesOpts :: ListStylesOpts
stylesOpts -> ShouldReexec -> RIO Config () -> RIO Runner ()
forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
NoReexec (RIO Config () -> RIO Runner ()) -> RIO Config () -> RIO Runner ()
forall a b. (a -> b) -> a -> b
$ ListStylesOpts -> RIO Config ()
listStylesCmd ListStylesOpts
stylesOpts

-- | List the dependencies
listDependenciesCmd :: Bool -> ListDepsOpts -> RIO Runner ()
listDependenciesCmd :: Bool -> ListDepsOpts -> RIO Runner ()
listDependenciesCmd deprecated :: Bool
deprecated opts :: ListDepsOpts
opts = do
    Bool -> RIO Runner () -> RIO Runner ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        Bool
deprecated
        (Utf8Builder -> RIO Runner ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn
             "DEPRECATED: Use ls dependencies instead. Will be removed in next major version.")
    ListDepsOpts -> RIO Runner ()
listDependencies ListDepsOpts
opts

lsViewLocalCmd :: OA.Mod OA.CommandFields LsView
lsViewLocalCmd :: Mod CommandFields LsView
lsViewLocalCmd =
    String -> ParserInfo LsView -> Mod CommandFields LsView
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command
        "local"
        (Parser LsView -> InfoMod LsView -> ParserInfo LsView
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info (LsView -> Parser LsView
forall (f :: * -> *) a. Applicative f => a -> f a
pure LsView
Local) (String -> InfoMod LsView
forall a. String -> InfoMod a
OA.progDesc "View local snapshot"))

lsViewRemoteCmd :: OA.Mod OA.CommandFields LsView
lsViewRemoteCmd :: Mod CommandFields LsView
lsViewRemoteCmd =
    String -> ParserInfo LsView -> Mod CommandFields LsView
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command
        "remote"
        (Parser LsView -> InfoMod LsView -> ParserInfo LsView
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info (LsView -> Parser LsView
forall (f :: * -> *) a. Applicative f => a -> f a
pure LsView
Remote) (String -> InfoMod LsView
forall a. String -> InfoMod a
OA.progDesc "View remote snapshot"))

-- | List stack's output styles
listStylesCmd :: ListStylesOpts -> RIO Config ()
listStylesCmd :: ListStylesOpts -> RIO Config ()
listStylesCmd opts :: ListStylesOpts
opts = do
    Config
lc <- RIO Config Config
forall r (m :: * -> *). MonadReader r m => m r
ask
    -- This is the same test as is used in Stack.Types.Runner.withRunner
    let useColor :: Bool
useColor = Getting Bool Config Bool -> Config -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Config Bool
forall env. HasTerm env => Lens' env Bool
useColorL Config
lc
        styles :: [StyleSpec]
styles = Array Style StyleSpec -> [StyleSpec]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems (Array Style StyleSpec -> [StyleSpec])
-> Array Style StyleSpec -> [StyleSpec]
forall a b. (a -> b) -> a -> b
$ Array Style StyleSpec
defaultStyles Array Style StyleSpec
-> [(Style, StyleSpec)] -> Array Style StyleSpec
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// StylesUpdate -> [(Style, StyleSpec)]
stylesUpdate (Getting StylesUpdate Config StylesUpdate -> Config -> StylesUpdate
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting StylesUpdate Config StylesUpdate
forall env. HasStylesUpdate env => Lens' env StylesUpdate
stylesUpdateL Config
lc)
        isComplex :: Bool
isComplex = Bool -> Bool
not (ListStylesOpts -> Bool
coptBasic ListStylesOpts
opts)
        showSGR :: Bool
showSGR = Bool
isComplex Bool -> Bool -> Bool
&& ListStylesOpts -> Bool
coptSGR ListStylesOpts
opts
        showExample :: Bool
showExample = Bool
isComplex Bool -> Bool -> Bool
&& ListStylesOpts -> Bool
coptExample ListStylesOpts
opts Bool -> Bool -> Bool
&& Bool
useColor
        styleReports :: [Text]
styleReports = (StyleSpec -> Text) -> [StyleSpec] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
L.map (Bool -> Bool -> StyleSpec -> Text
styleReport Bool
showSGR Bool
showExample) [StyleSpec]
styles
    IO () -> RIO Config ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO Config ()) -> IO () -> RIO Config ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate (if Bool
isComplex then "\n" else ":") [Text]
styleReports
  where
    styleReport :: Bool -> Bool -> StyleSpec -> Text
    styleReport :: Bool -> Bool -> StyleSpec -> Text
styleReport showSGR :: Bool
showSGR showExample :: Bool
showExample (k :: Text
k, sgrs :: [SGR]
sgrs) = Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
codes
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
showSGR then Text
sgrsList else Text
forall m. Monoid m => m
mempty)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
showExample then Text
example else Text
forall m. Monoid m => m
mempty)
      where
        codes :: Text
codes = Text -> [Text] -> Text
T.intercalate ";" ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
L.map (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) ([Int] -> [Text]) -> [Int] -> [Text]
forall a b. (a -> b) -> a -> b
$
                    (SGR -> [Int]) -> [SGR] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
L.concatMap SGR -> [Int]
sgrToCode [SGR]
sgrs)
        sgrsList :: Text
sgrsList = " [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate ", " ((SGR -> Text) -> [SGR] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
L.map (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (SGR -> String) -> SGR -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGR -> String
forall a. Show a => a -> String
show) [SGR]
sgrs)
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
        example :: Text
example = " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ansi Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "Example" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reset
        ansi :: Text
ansi = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [SGR] -> String
setSGRCode [SGR]
sgrs
        reset :: Text
reset = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [SGR] -> String
setSGRCode [SGR
Reset]