{-# 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 (..), SnapName (..))
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
                  String
"basic"
                  String
"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
                  String
"sgr"
                  String
"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
                  String
"example"
                  String
"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 String
"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 Char
'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 String
"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 String
"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 Char
'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 String
"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
        String
"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 String
"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
        String
"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 String
"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
        String
"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 String
"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
        String
"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 String
"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 Array
_) = Value -> Parser Snapshot
parseSnapshot Value
o
    parseJSON Value
_ = Parser Snapshot
forall m. Monoid m => m
mempty

instance FromJSON SnapshotData where
    parseJSON :: Value -> Parser SnapshotData
parseJSON (Object 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
.: Text
"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
.: Text
"snapshots"
    parseJSON Value
_ = Parser SnapshotData
forall m. Monoid m => m
mempty

toSnapshot :: [Value] -> Snapshot
toSnapshot :: [Value] -> Snapshot
toSnapshot [String Text
sid, String Text
stitle, String Text
stime] =
    Snapshot :: Text -> Text -> Text -> Snapshot
Snapshot
    { snapId :: Text
snapId = Text
sid
    , snapTitle :: Text
snapTitle = Text
stitle
    , snapTime :: Text
snapTime = Text
stime
    }
toSnapshot [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 String
"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 :: Text
snapTitle :: Text
snapId :: Text
snapTime :: Snapshot -> Text
snapTitle :: Snapshot -> Text
snapId :: Snapshot -> Text
..} = [Text
snapTime]

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

displaySingleSnap :: [Snapshot] -> Text
displaySingleSnap :: [Snapshot] -> Text
displaySingleSnap [Snapshot]
snapshots =
    case [Snapshot]
snapshots of
        [] -> Text
forall m. Monoid m => m
mempty
        (Snapshot
x:[Snapshot]
xs) ->
            let snaps :: [Text]
snaps =
                    Snapshot -> [Text]
displayTime Snapshot
x [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"\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 Bool
True Text
content = Text -> IO ()
pageText Text
content
renderData Bool
False Text
content = Text -> IO ()
T.putStr Text
content

displaySnapshotData :: Bool -> SnapshotData -> IO ()
displaySnapshotData :: Bool -> SnapshotData -> IO ()
displaySnapshotData Bool
term 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 ()
        [[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 SnapshotData
sdata 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
            SnapshotType
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 (\Snapshot
x -> Text
"lts" Text -> Text -> Bool
`isPrefixOf` Snapshot -> Text
snapId Snapshot
x)) [[Snapshot]]
snapdata
            SnapshotType
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 (\Snapshot
x -> Text
"nightly" Text -> Text -> Bool
`isPrefixOf` Snapshot -> Text
snapId Snapshot
x)) [[Snapshot]]
snapdata

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

localSnaptoText :: [String] -> Text
localSnaptoText :: [String] -> Text
localSnaptoText [String]
xs = Text -> [Text] -> Text
T.intercalate Text
"\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 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 {Bool
LsView
soptNightlySnapView :: Bool
soptLtsSnapView :: Bool
soptViewType :: LsView
soptNightlySnapView :: SnapshotOpts -> Bool
soptLtsSnapView :: SnapshotOpts -> Bool
soptViewType :: SnapshotOpts -> LsView
..} ->
            case (Bool
soptLtsSnapView, Bool
soptNightlySnapView) of
                (Bool
True, Bool
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 String
"lts") [String]
snapData
                (Bool
False, Bool
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 String
"night") [String]
snapData
                (Bool, Bool)
_ -> 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 ListDepsOpts
_ -> () -> RIO Runner ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        LsStyles ListStylesOpts
_ -> () -> RIO Runner ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

handleRemote
    :: HasRunner env
    => LsCmdOpts -> RIO env ()
handleRemote :: LsCmdOpts -> RIO env ()
handleRemote 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 ByteString
"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 {Bool
LsView
soptNightlySnapView :: Bool
soptLtsSnapView :: Bool
soptViewType :: LsView
soptNightlySnapView :: SnapshotOpts -> Bool
soptLtsSnapView :: SnapshotOpts -> Bool
soptViewType :: SnapshotOpts -> LsView
..} ->
            case (Bool
soptLtsSnapView, Bool
soptNightlySnapView) of
                (Bool
True, Bool
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
                (Bool
False, Bool
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
                (Bool, Bool)
_ -> 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 ListDepsOpts
_ -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        LsStyles ListStylesOpts
_ -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    urlInfo :: String
urlInfo = String
"https://www.stackage.org/snapshots"

lsCmd :: LsCmdOpts -> RIO Runner ()
lsCmd :: LsCmdOpts -> RIO Runner ()
lsCmd LsCmdOpts
lsOpts =
    case LsCmdOpts -> LsCmds
lsView LsCmdOpts
lsOpts of
        LsSnapshot SnapshotOpts {Bool
LsView
soptNightlySnapView :: Bool
soptLtsSnapView :: Bool
soptViewType :: LsView
soptNightlySnapView :: SnapshotOpts -> Bool
soptLtsSnapView :: SnapshotOpts -> Bool
soptViewType :: SnapshotOpts -> LsView
..} ->
            case LsView
soptViewType of
                LsView
Local -> LsCmdOpts -> RIO Runner ()
handleLocal LsCmdOpts
lsOpts
                LsView
Remote -> LsCmdOpts -> RIO Runner ()
forall env. HasRunner env => LsCmdOpts -> RIO env ()
handleRemote LsCmdOpts
lsOpts
        LsDependencies ListDepsOpts
depOpts -> Bool -> ListDepsOpts -> RIO Runner ()
listDependenciesCmd Bool
False ListDepsOpts
depOpts
        LsStyles 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 Bool
deprecated 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
             Utf8Builder
"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
        String
"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 String
"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
        String
"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 String
"View remote snapshot"))

-- | List stack's output styles
listStylesCmd :: ListStylesOpts -> RIO Config ()
listStylesCmd :: ListStylesOpts -> RIO Config ()
listStylesCmd 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 Text
"\n" else Text
":") [Text]
styleReports
  where
    styleReport :: Bool -> Bool -> StyleSpec -> Text
    styleReport :: Bool -> Bool -> StyleSpec -> Text
styleReport Bool
showSGR Bool
showExample (Text
k, [SGR]
sgrs) = Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" 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 Text
";" ((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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ((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
<> Text
"]"
        example :: Text
example = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ansi Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"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]