148 lines
6.5 KiB
Haskell
148 lines
6.5 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
|
|
{-# OPTIONS_GHC -Wno-unused-matches #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
|
|
{- Brick's navigation widget:
|
|
It is a FocusRing over many list's. Each list contains the information for each tool. Each list has an internal name (for Brick's runtime)
|
|
and a label which we can use in rendering. This data-structure helps to reuse Brick.Widget.List and to navegate easily across
|
|
|
|
-}
|
|
|
|
|
|
module GHCup.Brick.Widgets.Navigation (BrickInternalState, create, handler, draw) where
|
|
|
|
import GHCup.List ( ListResult(..) )
|
|
import GHCup.Types
|
|
( GHCTargetVersion(GHCTargetVersion),
|
|
Tool(..),
|
|
Tag(..),
|
|
tVerToText,
|
|
tagToString )
|
|
import qualified GHCup.Brick.Common as Common
|
|
import qualified GHCup.Brick.Attributes as Attributes
|
|
import qualified GHCup.Brick.Widgets.SectionList as SectionList
|
|
import Brick
|
|
( BrickEvent(..),
|
|
Padding(Max, Pad),
|
|
AttrMap,
|
|
EventM,
|
|
Widget(..),
|
|
(<+>),
|
|
(<=>))
|
|
import qualified Brick
|
|
import Brick.Widgets.Border ( hBorder, borderWithLabel)
|
|
import Brick.Widgets.Border.Style ( unicode )
|
|
import Brick.Widgets.Center ( center )
|
|
import qualified Brick.Widgets.List as L
|
|
import Data.List ( intercalate, sort )
|
|
import Data.Maybe ( mapMaybe )
|
|
import Data.Vector ( Vector)
|
|
import Data.Versions ( prettyPVP, prettyVer )
|
|
import Prelude hiding ( appendFile )
|
|
import qualified Data.Text as T
|
|
import qualified Data.Vector as V
|
|
|
|
|
|
type BrickInternalState = SectionList.SectionList Common.Name ListResult
|
|
|
|
-- | How to create a navigation widget
|
|
create :: Common.Name -- The name of the section list
|
|
-> [(Common.Name, Vector ListResult)] -- a list of tuples (section name, collection of elements)
|
|
-> Int -- The height of each item in a list. Commonly 1
|
|
-> BrickInternalState
|
|
create = SectionList.sectionList
|
|
|
|
-- | How the navigation handler handle events
|
|
handler :: BrickEvent Common.Name e -> EventM Common.Name BrickInternalState ()
|
|
handler = SectionList.handleGenericListEvent
|
|
|
|
-- | How to draw the navigation widget
|
|
draw :: AttrMap -> BrickInternalState -> Widget Common.Name
|
|
draw dimAttrs section_list
|
|
= Brick.padBottom Max
|
|
( Brick.withBorderStyle unicode
|
|
$ borderWithLabel (Brick.str "GHCup")
|
|
(center (header <=> hBorder <=> renderList' section_list))
|
|
)
|
|
where
|
|
header =
|
|
minHSize 2 Brick.emptyWidget
|
|
<+> Brick.padLeft (Pad 2) (minHSize 6 $ Brick.str "Tool")
|
|
<+> minHSize 15 (Brick.str "Version")
|
|
<+> Brick.padLeft (Pad 1) (minHSize 25 $ Brick.str "Tags")
|
|
<+> Brick.padLeft (Pad 5) (Brick.str "Notes")
|
|
renderList' bis =
|
|
let allElements = V.concatMap L.listElements $ SectionList.sectionListElements bis
|
|
minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) allElements
|
|
minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) allElements
|
|
in Brick.withDefAttr L.listAttr $ SectionList.renderSectionList (renderItem minTagSize minVerSize) True bis
|
|
renderItem minTagSize minVerSize b listResult@ListResult{lTag = lTag', ..} =
|
|
let marks = if
|
|
| lSet -> (Brick.withAttr Attributes.setAttr $ Brick.str Common.setSign)
|
|
| lInstalled -> (Brick.withAttr Attributes.installedAttr $ Brick.str Common.installedSign)
|
|
| otherwise -> (Brick.withAttr Attributes.notInstalledAttr $ Brick.str Common.notInstalledSign)
|
|
ver = case lCross of
|
|
Nothing -> T.unpack . prettyVer $ lVer
|
|
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
|
|
dim
|
|
| lNoBindist && not lInstalled
|
|
&& not b -- TODO: overloading dim and active ignores active
|
|
-- so we hack around it here
|
|
= Brick.updateAttrMap (const dimAttrs) . Brick.withAttr (Brick.attrName "no-bindist")
|
|
| otherwise = id
|
|
hooray
|
|
| elem Latest lTag' && not lInstalled =
|
|
Brick.withAttr Attributes.hoorayAttr
|
|
| otherwise = id
|
|
in hooray $ dim
|
|
( marks
|
|
<+> Brick.padLeft (Pad 2)
|
|
( minHSize 6
|
|
(printTool lTool)
|
|
)
|
|
<+> minHSize minVerSize (Brick.str ver)
|
|
<+> (let l = mapMaybe printTag $ sort lTag'
|
|
in Brick.padLeft (Pad 1) $ minHSize minTagSize $ if null l
|
|
then Brick.emptyWidget
|
|
else foldr1 (\x y -> x <+> Brick.str "," <+> y) l
|
|
)
|
|
<+> Brick.padLeft (Pad 5)
|
|
( let notes = printNotes listResult
|
|
in if null notes
|
|
then Brick.emptyWidget
|
|
else foldr1 (\x y -> x <+> Brick.str "," <+> y) notes
|
|
)
|
|
<+> Brick.vLimit 1 (Brick.fill ' ')
|
|
)
|
|
|
|
printTag Recommended = Just $ Brick.withAttr Attributes.recommendedAttr $ Brick.str "recommended"
|
|
printTag Latest = Just $ Brick.withAttr Attributes.latestAttr $ Brick.str "latest"
|
|
printTag Prerelease = Just $ Brick.withAttr Attributes.prereleaseAttr $ Brick.str "prerelease"
|
|
printTag Nightly = Just $ Brick.withAttr Attributes.nightlyAttr $ Brick.str "nightly"
|
|
printTag (Base pvp'') = Just $ Brick.str ("base-" ++ T.unpack (prettyPVP pvp''))
|
|
printTag Old = Nothing
|
|
printTag LatestPrerelease = Just $ Brick.withAttr Attributes.latestPrereleaseAttr $ Brick.str "latest-prerelease"
|
|
printTag LatestNightly = Just $ Brick.withAttr Attributes.latestNightlyAttr $ Brick.str "latest-nightly"
|
|
printTag (UnknownTag t) = Just $ Brick.str t
|
|
|
|
printTool Cabal = Brick.str "cabal"
|
|
printTool GHC = Brick.str "GHC"
|
|
printTool GHCup = Brick.str "GHCup"
|
|
printTool HLS = Brick.str "HLS"
|
|
printTool Stack = Brick.str "Stack"
|
|
|
|
printNotes ListResult {..} =
|
|
(if hlsPowered then [Brick.withAttr Attributes.hlsPoweredAttr $ Brick.str "hls-powered"] else mempty
|
|
)
|
|
++ (if lStray then [Brick.withAttr Attributes.strayAttr $ Brick.str "stray"] else mempty)
|
|
++ (case lReleaseDay of
|
|
Nothing -> mempty
|
|
Just d -> [Brick.withAttr Attributes.dayAttr $ Brick.str (show d)])
|
|
|
|
minHSize s' = Brick.hLimit s' . Brick.vLimit 1 . (<+> Brick.fill ' ') |