Put separators between tools
This commit is contained in:
parent
34ceaa0823
commit
7afd262b1b
@ -1,10 +1,11 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE TypeApplications #-}
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
|
||||||
module BrickMain where
|
module BrickMain where
|
||||||
|
|
||||||
@ -20,7 +21,10 @@ import Brick
|
|||||||
import Brick.Widgets.Border
|
import Brick.Widgets.Border
|
||||||
import Brick.Widgets.Border.Style
|
import Brick.Widgets.Border.Style
|
||||||
import Brick.Widgets.Center
|
import Brick.Widgets.Center
|
||||||
import Brick.Widgets.List
|
import Brick.Widgets.List ( listSelectedFocusedAttr
|
||||||
|
, listSelectedAttr
|
||||||
|
, listAttr
|
||||||
|
)
|
||||||
#if !defined(TAR)
|
#if !defined(TAR)
|
||||||
import Codec.Archive
|
import Codec.Archive
|
||||||
#endif
|
#endif
|
||||||
@ -35,7 +39,9 @@ import Data.Maybe
|
|||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
import Data.String.Interpolate
|
import Data.String.Interpolate
|
||||||
import Data.Vector ( Vector )
|
import Data.Vector ( Vector
|
||||||
|
, (!?)
|
||||||
|
)
|
||||||
import Data.Versions hiding ( str )
|
import Data.Versions hiding ( str )
|
||||||
import Haskus.Utils.Variant.Excepts
|
import Haskus.Utils.Variant.Excepts
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
@ -46,25 +52,35 @@ import URI.ByteString
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Graphics.Vty as Vty
|
import qualified Graphics.Vty as Vty
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import qualified Brick.Widgets.List as L
|
|
||||||
|
import Lens.Micro ( (^.) )
|
||||||
|
|
||||||
|
|
||||||
data AppData = AppData {
|
|
||||||
lr :: LR
|
data AppData = AppData
|
||||||
, dls :: GHCupDownloads
|
{ lr :: [ListResult]
|
||||||
|
, dls :: GHCupDownloads
|
||||||
, pfreq :: PlatformRequest
|
, pfreq :: PlatformRequest
|
||||||
} deriving Show
|
}
|
||||||
|
deriving Show
|
||||||
|
|
||||||
data AppSettings = AppSettings {
|
data AppSettings = AppSettings
|
||||||
showAll :: Bool
|
{ showAll :: Bool
|
||||||
} deriving Show
|
}
|
||||||
|
deriving Show
|
||||||
|
|
||||||
data AppState = AppState {
|
data AppInternalState = AppInternalState
|
||||||
appData :: AppData
|
{ clr :: Vector ListResult
|
||||||
|
, ix :: Int
|
||||||
|
}
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
data AppState = AppState
|
||||||
|
{ appData :: AppData
|
||||||
, appSettings :: AppSettings
|
, appSettings :: AppSettings
|
||||||
} deriving Show
|
, appState :: AppInternalState
|
||||||
|
}
|
||||||
type LR = GenericList String Vector ListResult
|
deriving Show
|
||||||
|
|
||||||
|
|
||||||
keyHandlers :: [ ( Char
|
keyHandlers :: [ ( Char
|
||||||
@ -82,27 +98,22 @@ keyHandlers =
|
|||||||
, (\AppSettings {..} ->
|
, (\AppSettings {..} ->
|
||||||
if showAll then "Hide old versions" else "Show all versions"
|
if showAll then "Hide old versions" else "Show all versions"
|
||||||
)
|
)
|
||||||
, (\AppState {..} ->
|
, hideShowHandler
|
||||||
let newAppSettings =
|
|
||||||
appSettings { showAll = not . showAll $ appSettings }
|
|
||||||
in continue (AppState appData newAppSettings)
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|
where
|
||||||
|
hideShowHandler (AppState {..}) =
|
||||||
|
let newAppSettings = appSettings { showAll = not . showAll $ appSettings }
|
||||||
|
newInternalState = constructList appData newAppSettings (Just appState)
|
||||||
|
in continue (AppState appData newAppSettings newInternalState)
|
||||||
|
|
||||||
|
|
||||||
ui :: AppState -> Widget String
|
ui :: AppState -> Widget String
|
||||||
ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } =
|
ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}), ..}
|
||||||
( padBottom Max
|
= ( padBottom Max
|
||||||
$ ( withBorderStyle unicode
|
$ ( withBorderStyle unicode
|
||||||
$ borderWithLabel (str "GHCup")
|
$ borderWithLabel (str "GHCup")
|
||||||
$ ( center
|
$ (center $ (header <=> hBorder <=> renderList' appState))
|
||||||
$ (header <=> hBorder <=> renderList
|
|
||||||
renderItem
|
|
||||||
True
|
|
||||||
(L.listReverse lr)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<=> footer
|
<=> footer
|
||||||
@ -121,7 +132,8 @@ ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } =
|
|||||||
<+> (minHSize 15 $ str "Version")
|
<+> (minHSize 15 $ str "Version")
|
||||||
<+> (padLeft (Pad 1) $ minHSize 25 $ str "Tags")
|
<+> (padLeft (Pad 1) $ minHSize 25 $ str "Tags")
|
||||||
<+> (padLeft (Pad 5) $ str "Notes")
|
<+> (padLeft (Pad 5) $ str "Notes")
|
||||||
renderItem b listResult@(ListResult {..}) =
|
renderList' = withDefAttr listAttr . drawListElements renderItem True
|
||||||
|
renderItem _ b listResult@(ListResult {..}) =
|
||||||
let marks = if
|
let marks = if
|
||||||
| lSet -> (withAttr "set" $ str "✔✔")
|
| lSet -> (withAttr "set" $ str "✔✔")
|
||||||
| lInstalled -> (withAttr "installed" $ str "✓ ")
|
| lInstalled -> (withAttr "installed" $ str "✓ ")
|
||||||
@ -132,21 +144,19 @@ ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } =
|
|||||||
dim = if lNoBindist
|
dim = if lNoBindist
|
||||||
then updateAttrMap (const dimAttributes) . withAttr "no-bindist"
|
then updateAttrMap (const dimAttributes) . withAttr "no-bindist"
|
||||||
else id
|
else id
|
||||||
active = if b then withAttr "active" else id
|
active = if b then forceAttr "active" else id
|
||||||
in dim
|
in active $ dim
|
||||||
( marks
|
( marks
|
||||||
<+> (( padLeft (Pad 2)
|
<+> (( padLeft (Pad 2)
|
||||||
$ active
|
|
||||||
$ minHSize 6
|
$ minHSize 6
|
||||||
$ (str (fmap toLower . show $ lTool))
|
$ (printTool lTool)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<+> (minHSize 15 $ active $ (str ver))
|
<+> (minHSize 15 $ (str ver))
|
||||||
<+> (let l = catMaybes . fmap printTag $ sort lTag
|
<+> (let l = catMaybes . fmap printTag $ sort lTag
|
||||||
in padLeft (Pad 1) $ minHSize 25 $
|
in padLeft (Pad 1) $ minHSize 25 $ if null l
|
||||||
if null l
|
then emptyWidget
|
||||||
then emptyWidget
|
else foldr1 (\x y -> x <+> str "," <+> y) l
|
||||||
else foldr1 (\x y -> x <+> str "," <+> y) l
|
|
||||||
)
|
)
|
||||||
<+> ( padLeft (Pad 5)
|
<+> ( padLeft (Pad 5)
|
||||||
$ let notes = printNotes listResult
|
$ let notes = printNotes listResult
|
||||||
@ -156,12 +166,17 @@ ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } =
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
printTag Recommended = Just $ withAttr "recommended" $ str "recommended"
|
printTag Recommended = Just $ withAttr "recommended" $ str "recommended"
|
||||||
printTag Latest = Just $ withAttr "latest" $ str "latest"
|
printTag Latest = Just $ withAttr "latest" $ str "latest"
|
||||||
printTag Prerelease = Just $ withAttr "prerelease" $ str "prerelease"
|
printTag Prerelease = Just $ withAttr "prerelease" $ str "prerelease"
|
||||||
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
|
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
|
||||||
printTag Old = Nothing
|
printTag Old = Nothing
|
||||||
printTag (UnknownTag t ) = Just $ str t
|
printTag (UnknownTag t) = Just $ str t
|
||||||
|
|
||||||
|
printTool Cabal = str "cabal"
|
||||||
|
printTool GHC = str "GHC"
|
||||||
|
printTool GHCup = str "GHCup"
|
||||||
|
printTool HLS = str "HLS"
|
||||||
|
|
||||||
printNotes ListResult {..} =
|
printNotes ListResult {..} =
|
||||||
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
|
(if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
|
||||||
@ -169,7 +184,82 @@ ui AppState { appData = AppData {..}, appSettings = as@(AppSettings {..}) } =
|
|||||||
++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
|
++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
|
||||||
++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
|
++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
|
||||||
|
|
||||||
|
-- | Draws the list elements.
|
||||||
|
--
|
||||||
|
-- Evaluates the underlying container up to, and a bit beyond, the
|
||||||
|
-- selected element. The exact amount depends on available height
|
||||||
|
-- for drawing and 'listItemHeight'. At most, it will evaluate up to
|
||||||
|
-- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the
|
||||||
|
-- available height.
|
||||||
|
drawListElements :: (Int -> Bool -> ListResult -> Widget String)
|
||||||
|
-> Bool
|
||||||
|
-> AppInternalState
|
||||||
|
-> Widget String
|
||||||
|
drawListElements drawElem foc is@(AppInternalState clr ix) =
|
||||||
|
Widget Greedy Greedy $ do
|
||||||
|
c <- getContext
|
||||||
|
|
||||||
|
-- Take (numPerHeight * 2) elements, or whatever is left
|
||||||
|
let
|
||||||
|
es = slice start (numPerHeight * 2) clr
|
||||||
|
|
||||||
|
-- number of separators we insert between tools
|
||||||
|
seps =
|
||||||
|
let n = length . nub . fmap lTool . V.toList $ clr
|
||||||
|
in if n < 0 then 0 else n - 1
|
||||||
|
|
||||||
|
start = max 0 $ ix - numPerHeight + 1
|
||||||
|
|
||||||
|
listItemHeight = 1
|
||||||
|
listSelected = fmap fst $ listSelectedElement' is
|
||||||
|
|
||||||
|
-- The number of items to show is the available height
|
||||||
|
-- divided by the item height...
|
||||||
|
initialNumPerHeight = (c ^. availHeightL - seps) `div` listItemHeight
|
||||||
|
-- ... but if the available height leaves a remainder of
|
||||||
|
-- an item height then we need to ensure that we render an
|
||||||
|
-- extra item to show a partial item at the top or bottom to
|
||||||
|
-- give the expected result when an item is more than one
|
||||||
|
-- row high. (Example: 5 rows available with item height
|
||||||
|
-- of 3 yields two items: one fully rendered, the other
|
||||||
|
-- rendered with only its top 2 or bottom 2 rows visible,
|
||||||
|
-- depending on how the viewport state changes.)
|
||||||
|
numPerHeight =
|
||||||
|
initialNumPerHeight
|
||||||
|
+ if initialNumPerHeight * listItemHeight == c ^. availHeightL
|
||||||
|
then 0
|
||||||
|
else 1
|
||||||
|
|
||||||
|
off = start * listItemHeight
|
||||||
|
|
||||||
|
drawnElements = flip V.imap es $ \i' e ->
|
||||||
|
let j = i' + start
|
||||||
|
|
||||||
|
-- a separator between tool sections
|
||||||
|
addSeparator w = case es !? (i' - 1) of
|
||||||
|
Just e' | lTool e' /= lTool e ->
|
||||||
|
hBorder <=> w
|
||||||
|
_ -> w
|
||||||
|
|
||||||
|
isSelected = Just j == listSelected
|
||||||
|
elemWidget = drawElem j isSelected e
|
||||||
|
selItemAttr = if foc
|
||||||
|
then withDefAttr listSelectedFocusedAttr
|
||||||
|
else withDefAttr listSelectedAttr
|
||||||
|
makeVisible = if isSelected then visible . selItemAttr else id
|
||||||
|
in addSeparator $ makeVisible elemWidget
|
||||||
|
|
||||||
|
render
|
||||||
|
$ viewport "GHCup" Vertical
|
||||||
|
$ translateBy (Location (0, off))
|
||||||
|
$ vBox
|
||||||
|
$ V.toList drawnElements
|
||||||
|
|
||||||
|
slice :: Int {- ^ start index -}
|
||||||
|
-> Int {- ^ length -}
|
||||||
|
-> Vector a
|
||||||
|
-> Vector a
|
||||||
|
slice i' n = fst . V.splitAt n . snd . V.splitAt i'
|
||||||
|
|
||||||
minHSize :: Int -> Widget n -> Widget n
|
minHSize :: Int -> Widget n -> Widget n
|
||||||
minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
|
minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
|
||||||
@ -213,43 +303,23 @@ eventHandler :: AppState -> BrickEvent n e -> EventM n (Next AppState)
|
|||||||
eventHandler st (VtyEvent (Vty.EvResize _ _)) = continue st
|
eventHandler st (VtyEvent (Vty.EvResize _ _)) = continue st
|
||||||
eventHandler st (VtyEvent (Vty.EvKey (Vty.KChar 'q') _)) = halt st
|
eventHandler st (VtyEvent (Vty.EvKey (Vty.KChar 'q') _)) = halt st
|
||||||
eventHandler st (VtyEvent (Vty.EvKey Vty.KEsc _)) = halt st
|
eventHandler st (VtyEvent (Vty.EvKey Vty.KEsc _)) = halt st
|
||||||
eventHandler AppState { appData = AppData {..}, ..} (VtyEvent (Vty.EvKey (Vty.KUp) _))
|
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) =
|
||||||
= continue (AppState (AppData (listMoveUp lr) dls pfreq) appSettings)
|
continue (AppState { appState = (moveCursor appState Up), .. })
|
||||||
eventHandler AppState { appData = AppData {..}, ..} (VtyEvent (Vty.EvKey (Vty.KDown) _))
|
eventHandler AppState {..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) =
|
||||||
= continue (AppState (AppData (listMoveDown lr) dls pfreq) appSettings)
|
continue (AppState { appState = (moveCursor appState Down), .. })
|
||||||
eventHandler as@(AppState appD appS) (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
|
eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
|
||||||
case find (\(c', _, _) -> c' == c) keyHandlers of
|
case find (\(c', _, _) -> c' == c) keyHandlers of
|
||||||
Nothing -> continue as
|
Nothing -> continue as
|
||||||
Just ('a', _, handler) ->
|
|
||||||
if (not $ showAll appS) -- it's not swapped to `showAll` yet, but it will in the handler
|
|
||||||
then do
|
|
||||||
newAppData <- liftIO $ replaceLR (\_ -> True) appD
|
|
||||||
handler (AppState (selectLatest newAppData) appS)
|
|
||||||
else do -- hide old versions
|
|
||||||
newAppData <- liftIO $ replaceLR (filterVisible (not $ showAll appS)) appD
|
|
||||||
handler (AppState (selectLatest newAppData) appS)
|
|
||||||
Just (_, _, handler) -> handler as
|
Just (_, _, handler) -> handler as
|
||||||
eventHandler st _ = continue st
|
eventHandler st _ = continue st
|
||||||
|
|
||||||
|
|
||||||
replaceLR :: (ListResult -> Bool) -> AppData -> IO AppData
|
moveCursor :: AppInternalState -> Direction -> AppInternalState
|
||||||
replaceLR filterF (AppData {..}) = do
|
moveCursor ais@(AppInternalState {..}) direction =
|
||||||
settings <- liftIO $ readIORef settings'
|
let newIx = if direction == Down then ix + 1 else ix - 1
|
||||||
l <- liftIO $ readIORef logger'
|
in case clr !? newIx of
|
||||||
let runLogger = myLoggerT l
|
Just _ -> AppInternalState { ix = newIx, .. }
|
||||||
lV <- runLogger
|
Nothing -> ais
|
||||||
. flip runReaderT settings
|
|
||||||
. fmap (V.fromList . filter filterF)
|
|
||||||
. listVersions dls Nothing Nothing
|
|
||||||
$ pfreq
|
|
||||||
pure $ AppData { lr = L.listReplace lV Nothing $ lr, .. }
|
|
||||||
|
|
||||||
|
|
||||||
filterVisible :: Bool -> ListResult -> Bool
|
|
||||||
filterVisible showAll e
|
|
||||||
| lInstalled e = True
|
|
||||||
| showAll = True
|
|
||||||
| otherwise = not (elem Old (lTag e))
|
|
||||||
|
|
||||||
|
|
||||||
-- | Suspend the current UI and run an IO action in terminal. If the
|
-- | Suspend the current UI and run an IO action in terminal. If the
|
||||||
@ -257,56 +327,103 @@ filterVisible showAll e
|
|||||||
withIOAction :: (AppState -> (Int, ListResult) -> IO (Either String a))
|
withIOAction :: (AppState -> (Int, ListResult) -> IO (Either String a))
|
||||||
-> AppState
|
-> AppState
|
||||||
-> EventM n (Next AppState)
|
-> EventM n (Next AppState)
|
||||||
withIOAction action as = case listSelectedElement (lr . appData $ as) of
|
withIOAction action as = case listSelectedElement' (appState as) of
|
||||||
Nothing -> continue as
|
Nothing -> continue as
|
||||||
Just (ix, e) -> suspendAndResume $ do
|
Just (ix, e) -> suspendAndResume $ do
|
||||||
action as (ix, e) >>= \case
|
action as (ix, e) >>= \case
|
||||||
Left err -> putStrLn $ ("Error: " <> err)
|
Left err -> putStrLn $ ("Error: " <> err)
|
||||||
Right _ -> putStrLn "Success"
|
Right _ -> putStrLn "Success"
|
||||||
apps <-
|
getAppData Nothing (pfreq . appData $ as) >>= \case
|
||||||
(fmap . fmap)
|
Right data' -> do
|
||||||
(\AppData {..} -> AppState
|
|
||||||
{ appData = AppData { lr = listMoveTo ix lr, .. }
|
|
||||||
, appSettings = (appSettings as)
|
|
||||||
}
|
|
||||||
)
|
|
||||||
$ getAppData Nothing (pfreq . appData $ as)
|
|
||||||
case apps of
|
|
||||||
Right nas -> do
|
|
||||||
putStrLn "Press enter to continue"
|
putStrLn "Press enter to continue"
|
||||||
_ <- getLine
|
_ <- getLine
|
||||||
pure nas
|
pure (updateList data' as)
|
||||||
Left err -> throwIO $ userError err
|
Left err -> throwIO $ userError err
|
||||||
|
|
||||||
|
|
||||||
|
-- | Update app data and list internal state based on new evidence.
|
||||||
|
-- This synchronises @AppInternalState@ with @AppData@
|
||||||
|
-- and @AppSettings@.
|
||||||
|
updateList :: AppData -> AppState -> AppState
|
||||||
|
updateList appD (AppState {..}) =
|
||||||
|
let newInternalState = constructList appD appSettings (Just appState)
|
||||||
|
in AppState { appState = newInternalState
|
||||||
|
, appData = appD
|
||||||
|
, appSettings = appSettings
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
constructList :: AppData
|
||||||
|
-> AppSettings
|
||||||
|
-> Maybe AppInternalState
|
||||||
|
-> AppInternalState
|
||||||
|
constructList appD appSettings mapp =
|
||||||
|
replaceLR (filterVisible (showAll appSettings)) (lr appD) mapp
|
||||||
|
|
||||||
|
listSelectedElement' :: AppInternalState -> Maybe (Int, ListResult)
|
||||||
|
listSelectedElement' (AppInternalState {..}) = fmap (ix, ) $ clr !? ix
|
||||||
|
|
||||||
|
|
||||||
|
selectLatest :: Vector ListResult -> Int
|
||||||
|
selectLatest v =
|
||||||
|
case V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag) v of
|
||||||
|
Just ix -> ix
|
||||||
|
Nothing -> 0
|
||||||
|
|
||||||
|
|
||||||
|
-- | Replace the @appState@ or construct it based on a filter function
|
||||||
|
-- and a new @[ListResult]@ evidence.
|
||||||
|
-- When passed an existing @appState@, tries to keep the selected element.
|
||||||
|
replaceLR :: (ListResult -> Bool)
|
||||||
|
-> [ListResult]
|
||||||
|
-> Maybe AppInternalState
|
||||||
|
-> AppInternalState
|
||||||
|
replaceLR filterF lr s =
|
||||||
|
let oldElem = s >>= listSelectedElement'
|
||||||
|
newVec = V.fromList . filter filterF $ lr
|
||||||
|
newSelected =
|
||||||
|
case oldElem >>= \(_, oldE) -> V.findIndex (toolEqual oldE) newVec of
|
||||||
|
Just ix -> ix
|
||||||
|
Nothing -> selectLatest newVec
|
||||||
|
in AppInternalState newVec newSelected
|
||||||
|
where
|
||||||
|
toolEqual e1 e2 =
|
||||||
|
lTool e1 == lTool e2 && lVer e1 == lVer e2 && lCross e1 == lCross e2
|
||||||
|
|
||||||
|
|
||||||
|
filterVisible :: Bool -> ListResult -> Bool
|
||||||
|
filterVisible showAll e | lInstalled e = True
|
||||||
|
| showAll = True
|
||||||
|
| otherwise = not (elem Old (lTag e))
|
||||||
|
|
||||||
|
|
||||||
install' :: AppState -> (Int, ListResult) -> IO (Either String ())
|
install' :: AppState -> (Int, ListResult) -> IO (Either String ())
|
||||||
install' AppState { appData = AppData {..}} (_, ListResult {..}) = do
|
install' AppState { appData = AppData {..} } (_, ListResult {..}) = do
|
||||||
settings <- readIORef settings'
|
settings <- readIORef settings'
|
||||||
l <- readIORef logger'
|
l <- readIORef logger'
|
||||||
let runLogger = myLoggerT l
|
let runLogger = myLoggerT l
|
||||||
|
|
||||||
let
|
let run =
|
||||||
run =
|
runLogger
|
||||||
runLogger
|
. flip runReaderT settings
|
||||||
. flip runReaderT settings
|
. runResourceT
|
||||||
. runResourceT
|
. runE
|
||||||
. runE
|
@'[ AlreadyInstalled
|
||||||
@'[AlreadyInstalled
|
|
||||||
, UnknownArchive
|
|
||||||
#if !defined(TAR)
|
#if !defined(TAR)
|
||||||
, ArchiveResult
|
, ArchiveResult
|
||||||
#endif
|
#endif
|
||||||
, FileDoesNotExistError
|
, UnknownArchive
|
||||||
, CopyError
|
, FileDoesNotExistError
|
||||||
, NoDownload
|
, CopyError
|
||||||
, NotInstalled
|
, NoDownload
|
||||||
, BuildFailed
|
, NotInstalled
|
||||||
, TagNotFound
|
, BuildFailed
|
||||||
, DigestError
|
, TagNotFound
|
||||||
, DownloadFailed
|
, DigestError
|
||||||
, NoUpdate
|
, DownloadFailed
|
||||||
, TarDirDoesNotExist
|
, NoUpdate
|
||||||
]
|
, TarDirDoesNotExist
|
||||||
|
]
|
||||||
|
|
||||||
(run $ do
|
(run $ do
|
||||||
case lTool of
|
case lTool of
|
||||||
@ -336,7 +453,7 @@ set' _ (_, ListResult {..}) = do
|
|||||||
let run =
|
let run =
|
||||||
runLogger
|
runLogger
|
||||||
. flip runReaderT settings
|
. flip runReaderT settings
|
||||||
. runE @'[FileDoesNotExistError, NotInstalled, TagNotFound]
|
. runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
|
||||||
|
|
||||||
(run $ do
|
(run $ do
|
||||||
case lTool of
|
case lTool of
|
||||||
@ -371,15 +488,15 @@ del' _ (_, ListResult {..}) = do
|
|||||||
|
|
||||||
|
|
||||||
changelog' :: AppState -> (Int, ListResult) -> IO (Either String ())
|
changelog' :: AppState -> (Int, ListResult) -> IO (Either String ())
|
||||||
changelog' AppState { appData = AppData {..}} (_, ListResult {..}) = do
|
changelog' AppState { appData = AppData {..} } (_, ListResult {..}) = do
|
||||||
case getChangeLog dls lTool (Left lVer) of
|
case getChangeLog dls lTool (Left lVer) of
|
||||||
Nothing -> pure $ Left
|
Nothing -> pure $ Left
|
||||||
[i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
|
[i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
|
||||||
Just uri -> do
|
Just uri -> do
|
||||||
let cmd = case _rPlatform pfreq of
|
let cmd = case _rPlatform pfreq of
|
||||||
Darwin -> "open"
|
Darwin -> "open"
|
||||||
Linux _ -> "xdg-open"
|
Linux _ -> "xdg-open"
|
||||||
FreeBSD -> "xdg-open"
|
FreeBSD -> "xdg-open"
|
||||||
exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case
|
exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case
|
||||||
Right _ -> pure $ Right ()
|
Right _ -> pure $ Right ()
|
||||||
Left e -> pure $ Left [i|#{e}|]
|
Left e -> pure $ Left [i|#{e}|]
|
||||||
@ -395,12 +512,12 @@ settings' :: IORef Settings
|
|||||||
settings' = unsafePerformIO $ do
|
settings' = unsafePerformIO $ do
|
||||||
dirs <- getDirs
|
dirs <- getDirs
|
||||||
newIORef Settings { cache = True
|
newIORef Settings { cache = True
|
||||||
, noVerify = False
|
, noVerify = False
|
||||||
, keepDirs = Never
|
, keepDirs = Never
|
||||||
, downloader = Curl
|
, downloader = Curl
|
||||||
, verbose = False
|
, verbose = False
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
logger' :: IORef LoggerConfig
|
logger' :: IORef LoggerConfig
|
||||||
@ -413,7 +530,12 @@ logger' = unsafePerformIO
|
|||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
brickMain :: Settings -> Maybe URI -> LoggerConfig -> GHCupDownloads -> PlatformRequest -> IO ()
|
brickMain :: Settings
|
||||||
|
-> Maybe URI
|
||||||
|
-> LoggerConfig
|
||||||
|
-> GHCupDownloads
|
||||||
|
-> PlatformRequest
|
||||||
|
-> IO ()
|
||||||
brickMain s muri l av pfreq' = do
|
brickMain s muri l av pfreq' = do
|
||||||
writeIORef uri' muri
|
writeIORef uri' muri
|
||||||
writeIORef settings' s
|
writeIORef settings' s
|
||||||
@ -423,24 +545,21 @@ brickMain s muri l av pfreq' = do
|
|||||||
|
|
||||||
eAppData <- getAppData (Just av) pfreq'
|
eAppData <- getAppData (Just av) pfreq'
|
||||||
case eAppData of
|
case eAppData of
|
||||||
Right ad -> defaultMain app (AppState (selectLatest ad) defaultAppSettings) $> ()
|
Right ad ->
|
||||||
Left e -> do
|
defaultMain
|
||||||
|
app
|
||||||
|
(AppState ad
|
||||||
|
defaultAppSettings
|
||||||
|
(constructList ad defaultAppSettings Nothing)
|
||||||
|
)
|
||||||
|
$> ()
|
||||||
|
Left e -> do
|
||||||
runLogger ($(logError) [i|Error building app state: #{show e}|])
|
runLogger ($(logError) [i|Error building app state: #{show e}|])
|
||||||
exitWith $ ExitFailure 2
|
exitWith $ ExitFailure 2
|
||||||
|
|
||||||
|
|
||||||
selectLatest :: AppData -> AppData
|
|
||||||
selectLatest (AppData {..}) =
|
|
||||||
(\ix -> AppData { lr = listMoveTo ix lr, .. } )
|
|
||||||
. fromJust
|
|
||||||
. V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
|
|
||||||
$ (listElements lr)
|
|
||||||
|
|
||||||
|
|
||||||
defaultAppSettings :: AppSettings
|
defaultAppSettings :: AppSettings
|
||||||
defaultAppSettings = AppSettings {
|
defaultAppSettings = AppSettings { showAll = False }
|
||||||
showAll = False
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
getDownloads' :: IO (Either String GHCupDownloads)
|
getDownloads' :: IO (Either String GHCupDownloads)
|
||||||
@ -453,16 +572,19 @@ getDownloads' = do
|
|||||||
r <-
|
r <-
|
||||||
runLogger
|
runLogger
|
||||||
. flip runReaderT settings
|
. flip runReaderT settings
|
||||||
. runE
|
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
|
||||||
@'[JSONError, DownloadFailed, FileDoesNotExistError]
|
$ fmap _ghcupDownloads
|
||||||
$ fmap _ghcupDownloads $ liftE $ getDownloadsF (maybe GHCupURL OwnSource muri)
|
$ liftE
|
||||||
|
$ getDownloadsF (maybe GHCupURL OwnSource muri)
|
||||||
|
|
||||||
case r of
|
case r of
|
||||||
VRight a -> pure $ Right a
|
VRight a -> pure $ Right a
|
||||||
VLeft e -> pure $ Left [i|#{e}|]
|
VLeft e -> pure $ Left [i|#{e}|]
|
||||||
|
|
||||||
|
|
||||||
getAppData :: Maybe GHCupDownloads -> PlatformRequest -> IO (Either String AppData)
|
getAppData :: Maybe GHCupDownloads
|
||||||
|
-> PlatformRequest
|
||||||
|
-> IO (Either String AppData)
|
||||||
getAppData mg pfreq' = do
|
getAppData mg pfreq' = do
|
||||||
settings <- readIORef settings'
|
settings <- readIORef settings'
|
||||||
l <- readIORef logger'
|
l <- readIORef logger'
|
||||||
@ -470,12 +592,10 @@ getAppData mg pfreq' = do
|
|||||||
|
|
||||||
r <- maybe getDownloads' (pure . Right) mg
|
r <- maybe getDownloads' (pure . Right) mg
|
||||||
|
|
||||||
runLogger
|
runLogger . flip runReaderT settings $ do
|
||||||
. flip runReaderT settings
|
case r of
|
||||||
$ do
|
Right dls -> do
|
||||||
case r of
|
lV <- listVersions dls Nothing Nothing pfreq'
|
||||||
Right dls -> do
|
pure $ Right $ (AppData (reverse lV) dls pfreq')
|
||||||
lV <- listVersions dls Nothing Nothing pfreq'
|
Left e -> pure $ Left [i|#{e}|]
|
||||||
pure $ Right $ (AppData (list "Tool versions"
|
|
||||||
(V.fromList . filter (filterVisible (showAll defaultAppSettings)) $ lV) 1) dls pfreq')
|
|
||||||
Left e -> pure $ Left [i|#{e}|]
|
|
||||||
|
Loading…
Reference in New Issue
Block a user