{-# 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 :: Name -> [(Name, Vector ListResult)] -> Int -> BrickInternalState
create = Name -> [(Name, Vector ListResult)] -> Int -> BrickInternalState
forall (t :: * -> *) n e.
Foldable t =>
n -> [(n, t e)] -> Int -> GenericSectionList n t e
SectionList.sectionList

-- | How the navigation handler handle events
handler :: BrickEvent Common.Name e -> EventM Common.Name BrickInternalState ()
handler :: forall e. BrickEvent Name e -> EventM Name BrickInternalState ()
handler = BrickEvent Name e -> EventM Name BrickInternalState ()
forall (t :: * -> *) n a e.
(Foldable t, Splittable t, Ord n, ListItemSectionNameIndex n) =>
BrickEvent n a -> EventM n (GenericSectionList n t e) ()
SectionList.handleGenericListEvent

-- | How to draw the navigation widget
draw :: AttrMap -> BrickInternalState -> Widget Common.Name
draw :: AttrMap -> BrickInternalState -> Widget Name
draw AttrMap
dimAttrs BrickInternalState
section_list
  = Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
Brick.padBottom Padding
Max
      ( BorderStyle -> Widget Name -> Widget Name
forall n. BorderStyle -> Widget n -> Widget n
Brick.withBorderStyle BorderStyle
unicode
        (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (String -> Widget Name
forall n. String -> Widget n
Brick.str String
"GHCup")
          (Widget Name -> Widget Name
forall n. Widget n -> Widget n
center (Widget Name
forall {n}. Widget n
header Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall {n}. Widget n
hBorder Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> BrickInternalState -> Widget Name
renderList' BrickInternalState
section_list))
      )
 where
  header :: Widget n
header =
    Int -> Widget n -> Widget n
forall {n}. Int -> Widget n -> Widget n
minHSize Int
2 Widget n
forall {n}. Widget n
Brick.emptyWidget
      Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Pad Int
2) (Int -> Widget n -> Widget n
forall {n}. Int -> Widget n -> Widget n
minHSize Int
6 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
"Tool")
      Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Int -> Widget n -> Widget n
forall {n}. Int -> Widget n -> Widget n
minHSize Int
15 (String -> Widget n
forall n. String -> Widget n
Brick.str String
"Version")
      Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Pad Int
1) (Int -> Widget n -> Widget n
forall {n}. Int -> Widget n -> Widget n
minHSize Int
25 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
"Tags")
      Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Pad Int
5) (String -> Widget n
forall n. String -> Widget n
Brick.str String
"Notes")
  renderList' :: BrickInternalState -> Widget Name
renderList' BrickInternalState
bis =
    let allElements :: Vector ListResult
allElements = (GenericList Name Vector ListResult -> Vector ListResult)
-> Vector (GenericList Name Vector ListResult) -> Vector ListResult
forall a b. (a -> Vector b) -> Vector a -> Vector b
V.concatMap GenericList Name Vector ListResult -> Vector ListResult
forall n (t :: * -> *) e. GenericList n t e -> t e
L.listElements (Vector (GenericList Name Vector ListResult) -> Vector ListResult)
-> Vector (GenericList Name Vector ListResult) -> Vector ListResult
forall a b. (a -> b) -> a -> b
$ BrickInternalState -> Vector (GenericList Name Vector ListResult)
forall n (t :: * -> *) e.
GenericSectionList n t e -> Vector (GenericList n t e)
SectionList.sectionListElements BrickInternalState
bis
        minTagSize :: Int
minTagSize = Vector Int -> Int
forall a. Ord a => Vector a -> a
V.maximum (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ (ListResult -> Int) -> Vector ListResult -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (ListResult -> String) -> ListResult -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String)
-> (ListResult -> [String]) -> ListResult -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag -> String) -> [Tag] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tag -> String
tagToString ([Tag] -> [String])
-> (ListResult -> [Tag]) -> ListResult -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListResult -> [Tag]
lTag) Vector ListResult
allElements
        minVerSize :: Int
minVerSize = Vector Int -> Int
forall a. Ord a => Vector a -> a
V.maximum (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ (ListResult -> Int) -> Vector ListResult -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\ListResult{Bool
[Tag]
Maybe Text
Maybe Day
Version
Tool
lTag :: ListResult -> [Tag]
lTool :: Tool
lVer :: Version
lCross :: Maybe Text
lTag :: [Tag]
lInstalled :: Bool
lSet :: Bool
lStray :: Bool
lNoBindist :: Bool
hlsPowered :: Bool
lReleaseDay :: Maybe Day
hlsPowered :: ListResult -> Bool
lCross :: ListResult -> Maybe Text
lInstalled :: ListResult -> Bool
lNoBindist :: ListResult -> Bool
lReleaseDay :: ListResult -> Maybe Day
lSet :: ListResult -> Bool
lStray :: ListResult -> Bool
lTool :: ListResult -> Tool
lVer :: ListResult -> Version
..} -> Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Text
tVerToText (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
lCross Version
lVer)) Vector ListResult
allElements
    in AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
Brick.withDefAttr AttrName
L.listAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Int -> Bool -> ListResult -> Widget Name)
-> Bool -> BrickInternalState -> Widget Name
forall n (t :: * -> *) e.
(Traversable t, Ord n, Show n, Eq n, Splittable t,
 Semigroup (t e)) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericSectionList n t e -> Widget n
SectionList.renderSectionList (Int -> Int -> Int -> Bool -> ListResult -> Widget Name
renderItem Int
minTagSize Int
minVerSize) Bool
True BrickInternalState
bis
  renderItem :: Int -> Int -> Int -> Bool -> ListResult -> Widget Name
renderItem Int
minTagSize Int
minVerSize Int
listIx Bool
b listResult :: ListResult
listResult@ListResult{lTag :: ListResult -> [Tag]
lTag = [Tag]
lTag', Bool
Maybe Text
Maybe Day
Version
Tool
hlsPowered :: ListResult -> Bool
lCross :: ListResult -> Maybe Text
lInstalled :: ListResult -> Bool
lNoBindist :: ListResult -> Bool
lReleaseDay :: ListResult -> Maybe Day
lSet :: ListResult -> Bool
lStray :: ListResult -> Bool
lTool :: ListResult -> Tool
lVer :: ListResult -> Version
lTool :: Tool
lVer :: Version
lCross :: Maybe Text
lInstalled :: Bool
lSet :: Bool
lStray :: Bool
lNoBindist :: Bool
hlsPowered :: Bool
lReleaseDay :: Maybe Day
..} =
    let marks :: Widget n
marks = if
          | Bool
lSet       -> (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.setAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
Common.setSign)
          | Bool
lInstalled -> (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.installedAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
Common.installedSign)
          | Bool
otherwise  -> (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.notInstalledAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
Common.notInstalledSign)
        ver :: String
ver = case Maybe Text
lCross of
          Maybe Text
Nothing -> Text -> String
T.unpack (Text -> String) -> (Version -> Text) -> Version -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> String) -> Version -> String
forall a b. (a -> b) -> a -> b
$ Version
lVer
          Just Text
c  -> Text -> String
T.unpack (Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
lVer)
        dim :: Widget n -> Widget n
dim
          | Bool
lNoBindist Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
lInstalled
            Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
b -- TODO: overloading dim and active ignores active
                       --       so we hack around it here
          = (AttrMap -> AttrMap) -> Widget n -> Widget n
forall n. (AttrMap -> AttrMap) -> Widget n -> Widget n
Brick.updateAttrMap (AttrMap -> AttrMap -> AttrMap
forall a b. a -> b -> a
const AttrMap
dimAttrs) (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr (String -> AttrName
Brick.attrName String
"no-bindist")
          | Bool
otherwise  = Widget n -> Widget n
forall a. a -> a
id
        hooray :: Widget n -> Widget n
hooray
          | Tag -> [Tag] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Tag
Latest [Tag]
lTag' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
lInstalled =
              AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.hoorayAttr
          | Bool
otherwise = Widget n -> Widget n
forall a. a -> a
id
        active :: Widget Name -> Widget Name
active = if Bool
b then Name -> Widget Name -> Widget Name
forall n. n -> Widget n -> Widget n
Common.enableScreenReader (Tool -> Int -> Name
Common.ListItem Tool
lTool Int
listIx) else Widget Name -> Widget Name
forall a. a -> a
id
    in Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
Brick.clickable (Tool -> Int -> Name
Common.ListItem Tool
lTool Int
listIx) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name
forall n. Widget n -> Widget n
hooray (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name
active (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name
forall n. Widget n -> Widget n
dim
          (   Widget Name
forall {n}. Widget n
marks
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Pad Int
2)
               ( Int -> Widget Name -> Widget Name
forall {n}. Int -> Widget n -> Widget n
minHSize Int
6
                 (Tool -> Widget Name
forall {n}. Tool -> Widget n
printTool Tool
lTool)
               )
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Int -> Widget Name -> Widget Name
forall {n}. Int -> Widget n -> Widget n
minHSize Int
minVerSize (String -> Widget Name
forall n. String -> Widget n
Brick.str String
ver)
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> (let l :: [Widget n]
l = (Tag -> Maybe (Widget n)) -> [Tag] -> [Widget n]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tag -> Maybe (Widget n)
forall {n}. Tag -> Maybe (Widget n)
printTag ([Tag] -> [Widget n]) -> [Tag] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ [Tag] -> [Tag]
forall a. Ord a => [a] -> [a]
sort [Tag]
lTag'
               in  Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall {n}. Int -> Widget n -> Widget n
minHSize Int
minTagSize (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ if [Widget Any] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Widget Any]
forall {n}. [Widget n]
l
                     then Widget Name
forall {n}. Widget n
Brick.emptyWidget
                     else (Widget Name -> Widget Name -> Widget Name)
-> [Widget Name] -> Widget Name
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Widget Name
x Widget Name
y -> Widget Name
x Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
Brick.str String
"," Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
y) [Widget Name]
forall {n}. [Widget n]
l
              )
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
Brick.padLeft (Int -> Padding
Pad Int
5)
              ( let notes :: [Widget n]
notes = ListResult -> [Widget n]
forall {n}. ListResult -> [Widget n]
printNotes ListResult
listResult
                in  if [Widget Any] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Widget Any]
forall {n}. [Widget n]
notes
                      then Widget Name
forall {n}. Widget n
Brick.emptyWidget
                      else (Widget Name -> Widget Name -> Widget Name)
-> [Widget Name] -> Widget Name
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Widget Name
x Widget Name
y -> Widget Name
x Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget Name
forall n. String -> Widget n
Brick.str String
"," Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
y) [Widget Name]
forall {n}. [Widget n]
notes
              )
          Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Int -> Widget Name -> Widget Name
forall {n}. Int -> Widget n -> Widget n
Brick.vLimit Int
1 (Char -> Widget Name
forall n. Char -> Widget n
Brick.fill Char
' ')
          )

  printTag :: Tag -> Maybe (Widget n)
printTag Tag
Recommended    = Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.recommendedAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
"recommended"
  printTag Tag
Latest         = Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.latestAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
"latest"
  printTag Tag
Prerelease     = Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.prereleaseAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
"prerelease"
  printTag Tag
Nightly        = Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.nightlyAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
"nightly"
  printTag (Base PVP
pvp'')   = Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str (String
"base-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (PVP -> Text
prettyPVP PVP
pvp''))
  printTag Tag
Old            = Maybe (Widget n)
forall a. Maybe a
Nothing
  printTag Tag
LatestPrerelease = Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.latestPrereleaseAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
"latest-prerelease"
  printTag Tag
LatestNightly    = Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.latestNightlyAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
"latest-nightly"
  printTag Tag
Experimental     = Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.latestNightlyAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
"experimental"
  printTag (UnknownTag String
t) = Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
t

  printTool :: Tool -> Widget n
printTool Tool
Cabal = String -> Widget n
forall n. String -> Widget n
Brick.str String
"cabal"
  printTool Tool
GHC = String -> Widget n
forall n. String -> Widget n
Brick.str String
"GHC"
  printTool Tool
GHCup = String -> Widget n
forall n. String -> Widget n
Brick.str String
"GHCup"
  printTool Tool
HLS = String -> Widget n
forall n. String -> Widget n
Brick.str String
"HLS"
  printTool Tool
Stack = String -> Widget n
forall n. String -> Widget n
Brick.str String
"Stack"

  printNotes :: ListResult -> [Widget n]
printNotes ListResult {Bool
[Tag]
Maybe Text
Maybe Day
Version
Tool
lTag :: ListResult -> [Tag]
hlsPowered :: ListResult -> Bool
lCross :: ListResult -> Maybe Text
lInstalled :: ListResult -> Bool
lNoBindist :: ListResult -> Bool
lReleaseDay :: ListResult -> Maybe Day
lSet :: ListResult -> Bool
lStray :: ListResult -> Bool
lTool :: ListResult -> Tool
lVer :: ListResult -> Version
lTool :: Tool
lVer :: Version
lCross :: Maybe Text
lTag :: [Tag]
lInstalled :: Bool
lSet :: Bool
lStray :: Bool
lNoBindist :: Bool
hlsPowered :: Bool
lReleaseDay :: Maybe Day
..} =
    (if Bool
hlsPowered then [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.hlsPoweredAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
"hls-powered"] else [Widget n]
forall a. Monoid a => a
mempty
      )
      [Widget n] -> [Widget n] -> [Widget n]
forall a. [a] -> [a] -> [a]
++ (if Bool
lStray then [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.strayAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str String
"stray"] else [Widget n]
forall a. Monoid a => a
mempty)
      [Widget n] -> [Widget n] -> [Widget n]
forall a. [a] -> [a] -> [a]
++ (case Maybe Day
lReleaseDay of
            Maybe Day
Nothing -> [Widget n]
forall a. Monoid a => a
mempty
            Just Day
d  -> [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
Brick.withAttr AttrName
Attributes.dayAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
Brick.str (Day -> String
forall a. Show a => a -> String
show Day
d)])

  minHSize :: Int -> Widget n -> Widget n
minHSize Int
s' = Int -> Widget n -> Widget n
forall {n}. Int -> Widget n -> Widget n
Brick.hLimit Int
s' (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget n -> Widget n
forall {n}. Int -> Widget n -> Widget n
Brick.vLimit Int
1 (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Char -> Widget n
forall n. Char -> Widget n
Brick.fill Char
' ')

instance SectionList.ListItemSectionNameIndex Common.Name where
  getListItemSectionNameIndex :: Name -> Maybe (Name, Int)
getListItemSectionNameIndex = \case
    Common.ListItem Tool
tool Int
ix -> (Name, Int) -> Maybe (Name, Int)
forall a. a -> Maybe a
Just (Tool -> Name
Common.Singular Tool
tool, Int
ix)
    Name
_ -> Maybe (Name, Int)
forall a. Maybe a
Nothing