{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE ViewPatterns      #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PatternSynonyms #-}

{-
This module contains common values used across the library. Crucially it contains two important types for the brick app:

- Name: List all resources (widgets) used by the app. see https://github.com/jtdaugherty/brick/blob/master/docs/guide.rst#resource-names
- Mode: Use to dispatch events and drawings. see: https://github.com/jtdaugherty/brick/issues/476#issuecomment-1629151920

-}

module GHCup.Brick.Common  (
  installedSign,
  setSign,
  notInstalledSign,
  checkBoxSelectedSign,
  showKey,
  showMod,
  keyToWidget,
  separator,
  frontwardLayer,
  enableScreenReader,
  zoom,
  defaultAppSettings,
  lr,
  showAllVersions,
  Name(..),
  Mode(..),
  BrickData(..),
  BrickSettings(..),
  ResourceId (
      UrlEditBox, SetCheckBox, IsolateEditBox, ForceCheckBox, AdditionalEditBox
    , TargetGhcEditBox, BootstrapGhcEditBox, HadrianGhcEditBox, JobsEditBox, BuildConfigEditBox
    , PatchesEditBox, CrossTargetEditBox, AddConfArgsEditBox, OvewrwiteVerEditBox
    , BuildFlavourEditBox, BuildSystemEditBox, OkButton, AdvanceInstallButton
    , CompileGHCButton, CompileHLSButton, CabalProjectEditBox
    , CabalProjectLocalEditBox, UpdateCabalCheckBox, GitRefEditBox
    , BootstrapGhcSelectBox, HadrianGhcSelectBox, ToolVersionBox, GHCInstallTargets
  ) ) where

import           GHCup.List ( ListResult )
import           GHCup.Prelude ( isWindows )
import           GHCup.Types ( Tool, KeyCombination (KeyCombination) )
import Data.List (intercalate)
import           Prelude                 hiding ( appendFile )
import qualified Graphics.Vty                  as Vty
import           Optics.TH (makeLenses)
import           Optics.Lens (toLensVL)
import qualified Brick
import qualified Brick.Widgets.Border as Border
import Brick ((<+>))
import qualified Data.Text as T
import qualified Brick.Widgets.Center as Brick
import qualified Brick.Widgets.Border.Style as Border

-- We could use regular ADTs but different menus share the same options.
-- example: all of ghcup compile ghc, ghcup compile hls, ghcup install cabal, etc...
-- all have a --set, --force, etc... common arguments. If we went for the ADT we'd end up
-- with SetCompileHLSOption, SetCompileGHCOption, SetInstallCabalOption, etc...
-- which isn't terrible, but verbose enough to reject it.

-- | A newtype for labeling resources in menus. It is bundled along with pattern synonyms
newtype ResourceId = ResourceId Int deriving (ResourceId -> ResourceId -> Bool
(ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool) -> Eq ResourceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceId -> ResourceId -> Bool
== :: ResourceId -> ResourceId -> Bool
$c/= :: ResourceId -> ResourceId -> Bool
/= :: ResourceId -> ResourceId -> Bool
Eq, Eq ResourceId
Eq ResourceId =>
(ResourceId -> ResourceId -> Ordering)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> ResourceId)
-> (ResourceId -> ResourceId -> ResourceId)
-> Ord ResourceId
ResourceId -> ResourceId -> Bool
ResourceId -> ResourceId -> Ordering
ResourceId -> ResourceId -> ResourceId
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
$ccompare :: ResourceId -> ResourceId -> Ordering
compare :: ResourceId -> ResourceId -> Ordering
$c< :: ResourceId -> ResourceId -> Bool
< :: ResourceId -> ResourceId -> Bool
$c<= :: ResourceId -> ResourceId -> Bool
<= :: ResourceId -> ResourceId -> Bool
$c> :: ResourceId -> ResourceId -> Bool
> :: ResourceId -> ResourceId -> Bool
$c>= :: ResourceId -> ResourceId -> Bool
>= :: ResourceId -> ResourceId -> Bool
$cmax :: ResourceId -> ResourceId -> ResourceId
max :: ResourceId -> ResourceId -> ResourceId
$cmin :: ResourceId -> ResourceId -> ResourceId
min :: ResourceId -> ResourceId -> ResourceId
Ord, Int -> ResourceId -> ShowS
[ResourceId] -> ShowS
ResourceId -> String
(Int -> ResourceId -> ShowS)
-> (ResourceId -> String)
-> ([ResourceId] -> ShowS)
-> Show ResourceId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceId -> ShowS
showsPrec :: Int -> ResourceId -> ShowS
$cshow :: ResourceId -> String
show :: ResourceId -> String
$cshowList :: [ResourceId] -> ShowS
showList :: [ResourceId] -> ShowS
Show)

pattern OkButton :: ResourceId
pattern $mOkButton :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bOkButton :: ResourceId
OkButton = ResourceId 0
pattern AdvanceInstallButton :: ResourceId
pattern $mAdvanceInstallButton :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bAdvanceInstallButton :: ResourceId
AdvanceInstallButton = ResourceId 100
pattern CompileGHCButton :: ResourceId
pattern $mCompileGHCButton :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bCompileGHCButton :: ResourceId
CompileGHCButton = ResourceId 101
pattern CompileHLSButton :: ResourceId
pattern $mCompileHLSButton :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bCompileHLSButton :: ResourceId
CompileHLSButton = ResourceId 102

pattern UrlEditBox :: ResourceId
pattern $mUrlEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bUrlEditBox :: ResourceId
UrlEditBox = ResourceId 1
pattern SetCheckBox :: ResourceId
pattern $mSetCheckBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bSetCheckBox :: ResourceId
SetCheckBox = ResourceId 2
pattern IsolateEditBox :: ResourceId
pattern $mIsolateEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bIsolateEditBox :: ResourceId
IsolateEditBox = ResourceId 3
pattern ForceCheckBox :: ResourceId
pattern $mForceCheckBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bForceCheckBox :: ResourceId
ForceCheckBox = ResourceId 4
pattern AdditionalEditBox :: ResourceId
pattern $mAdditionalEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bAdditionalEditBox :: ResourceId
AdditionalEditBox = ResourceId 5

pattern TargetGhcEditBox :: ResourceId
pattern $mTargetGhcEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bTargetGhcEditBox :: ResourceId
TargetGhcEditBox = ResourceId 6
pattern BootstrapGhcEditBox :: ResourceId
pattern $mBootstrapGhcEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bBootstrapGhcEditBox :: ResourceId
BootstrapGhcEditBox = ResourceId 7
pattern HadrianGhcEditBox :: ResourceId
pattern $mHadrianGhcEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bHadrianGhcEditBox :: ResourceId
HadrianGhcEditBox = ResourceId 20
pattern JobsEditBox :: ResourceId
pattern $mJobsEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bJobsEditBox :: ResourceId
JobsEditBox = ResourceId 8
pattern BuildConfigEditBox :: ResourceId
pattern $mBuildConfigEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bBuildConfigEditBox :: ResourceId
BuildConfigEditBox = ResourceId 9
pattern PatchesEditBox :: ResourceId
pattern $mPatchesEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bPatchesEditBox :: ResourceId
PatchesEditBox = ResourceId 10
pattern CrossTargetEditBox :: ResourceId
pattern $mCrossTargetEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bCrossTargetEditBox :: ResourceId
CrossTargetEditBox = ResourceId 11
pattern AddConfArgsEditBox :: ResourceId
pattern $mAddConfArgsEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bAddConfArgsEditBox :: ResourceId
AddConfArgsEditBox = ResourceId 12
pattern OvewrwiteVerEditBox :: ResourceId
pattern $mOvewrwiteVerEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bOvewrwiteVerEditBox :: ResourceId
OvewrwiteVerEditBox = ResourceId 13
pattern BuildFlavourEditBox :: ResourceId
pattern $mBuildFlavourEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bBuildFlavourEditBox :: ResourceId
BuildFlavourEditBox = ResourceId 14
pattern BuildSystemEditBox :: ResourceId
pattern $mBuildSystemEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bBuildSystemEditBox :: ResourceId
BuildSystemEditBox = ResourceId 15

pattern CabalProjectEditBox  :: ResourceId
pattern $mCabalProjectEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bCabalProjectEditBox :: ResourceId
CabalProjectEditBox  = ResourceId 16
pattern CabalProjectLocalEditBox  :: ResourceId
pattern $mCabalProjectLocalEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bCabalProjectLocalEditBox :: ResourceId
CabalProjectLocalEditBox  = ResourceId 17
pattern UpdateCabalCheckBox  :: ResourceId
pattern $mUpdateCabalCheckBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bUpdateCabalCheckBox :: ResourceId
UpdateCabalCheckBox  = ResourceId 18

pattern GitRefEditBox  :: ResourceId
pattern $mGitRefEditBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bGitRefEditBox :: ResourceId
GitRefEditBox  = ResourceId 19

pattern BootstrapGhcSelectBox :: ResourceId
pattern $mBootstrapGhcSelectBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bBootstrapGhcSelectBox :: ResourceId
BootstrapGhcSelectBox = ResourceId 21
pattern HadrianGhcSelectBox :: ResourceId
pattern $mHadrianGhcSelectBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bHadrianGhcSelectBox :: ResourceId
HadrianGhcSelectBox = ResourceId 22

pattern ToolVersionBox :: ResourceId
pattern $mToolVersionBox :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bToolVersionBox :: ResourceId
ToolVersionBox = ResourceId 23

pattern GHCInstallTargets :: ResourceId
pattern $mGHCInstallTargets :: forall {r}. ResourceId -> ((# #) -> r) -> ((# #) -> r) -> r
$bGHCInstallTargets :: ResourceId
GHCInstallTargets = ResourceId 24

-- | Name data type. Uniquely identifies each widget in the TUI.
-- some constructors might end up unused, but still is a good practise
-- to have all of them defined, just in case
data Name = AllTools                   -- ^ The main list widget
          | Singular Tool              -- ^ The particular list for each tool
          | ListItem Tool Int          -- ^ An item in list
          | KeyInfoBox                 -- ^ The text box widget with action informacion
          | TutorialBox                -- ^ The tutorial widget
          | ContextBox                 -- ^ The resource for Context Menu
          | CompileGHCBox              -- ^ The resource for CompileGHC Menu
          | AdvanceInstallBox          -- ^ The resource for AdvanceInstall Menu
          | MenuElement ResourceId     -- ^ Each element in a Menu. Resources must not be share for visible
                                       --   Menus, but MenuA and MenuB can share resources if they both are
                                       --   invisible, or just one of them is visible.

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

-- | Mode type. It helps to dispatch events to different handlers.
data Mode = Navigation
          | KeyInfo
          | Tutorial
          | ContextPanel
          | AdvanceInstallPanel
          | CompileGHCPanel
          | CompileHLSPanel
          deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: Mode -> Mode -> Bool
Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mode -> ShowS
showsPrec :: Int -> Mode -> ShowS
$cshow :: Mode -> String
show :: Mode -> String
$cshowList :: [Mode] -> ShowS
showList :: [Mode] -> ShowS
Show, Eq Mode
Eq Mode =>
(Mode -> Mode -> Ordering)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Mode)
-> (Mode -> Mode -> Mode)
-> Ord Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
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
$ccompare :: Mode -> Mode -> Ordering
compare :: Mode -> Mode -> Ordering
$c< :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
>= :: Mode -> Mode -> Bool
$cmax :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
min :: Mode -> Mode -> Mode
Ord)

String
installedSign :: String
  | Bool
isWindows = String
"I "
  | Bool
otherwise = String
"✓ "

String
setSign :: String
  | Bool
isWindows = String
"IS"
  | Bool
otherwise = String
"✔✔"

String
notInstalledSign :: String
  | Bool
isWindows = String
"X "
  | Bool
otherwise = String
"✗ "

String
checkBoxSelectedSign :: String
  | Bool
isWindows = String
"Y "
  | Bool
otherwise = String
"✓ "


showKey :: Vty.Key -> String
showKey :: Key -> String
showKey (Vty.KChar Char
c) = [Char
c]
showKey Key
Vty.KUp = String
"↑"
showKey Key
Vty.KDown = String
"↓"
showKey Key
key = ShowS
forall a. HasCallStack => [a] -> [a]
tail (Key -> String
forall a. Show a => a -> String
show Key
key)

showMod :: Vty.Modifier -> String
showMod :: Modifier -> String
showMod = ShowS
forall a. HasCallStack => [a] -> [a]
tail ShowS -> (Modifier -> String) -> Modifier -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modifier -> String
forall a. Show a => a -> String
show

-- | Given a KeyComb, produces a string widget with and user friendly text
keyToWidget :: KeyCombination -> Brick.Widget n
keyToWidget :: forall n. KeyCombination -> Widget n
keyToWidget (KeyCombination Key
key [Modifier]
mods) = String -> Widget n
forall n. String -> Widget n
Brick.str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"+" (Key -> String
showKey Key
key String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Modifier -> String
showMod (Modifier -> String) -> [Modifier] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Modifier]
mods))

-- | A section separator with max width. Looks like this:    -------- o --------
separator :: Brick.Widget n
separator :: forall n. Widget n
separator = Widget n
forall n. Widget n
Border.hBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
Brick.str String
" o " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
Border.hBorder

-- | Used to create a layer on top of the main navigation widget (tutorial, info, menus...)
frontwardLayer :: T.Text -> Brick.Widget n -> Brick.Widget n
frontwardLayer :: forall n. Text -> Widget n -> Widget n
frontwardLayer Text
layer_name =
    Widget n -> Widget n
forall n. Widget n -> Widget n
Brick.centerLayer
      (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.hLimitPercent Int
80
      (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.vLimitPercent Int
75
      (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BorderStyle -> Widget n -> Widget n
forall n. BorderStyle -> Widget n -> Widget n
Brick.withBorderStyle BorderStyle
Border.unicode
      (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
Border.borderWithLabel (Text -> Widget n
forall n. Text -> Widget n
Brick.txt Text
layer_name)

-- | puts a cursor at the line beginning so It can be read by screen readers
enableScreenReader :: n -> Brick.Widget n -> Brick.Widget n
enableScreenReader :: forall n. n -> Widget n -> Widget n
enableScreenReader n
n = n -> Location -> Widget n -> Widget n
forall n. n -> Location -> Widget n -> Widget n
Brick.putCursor n
n ((Int, Int) -> Location
Brick.Location (Int
0,Int
0))
--                     |- tip: when debugging, use Brick.showCursor instead

-- I refuse to give this a type signature.
-- | Given a lens, zoom on it. It is needed because Brick uses microlens but GHCup uses optics.
zoom :: Optic k is t t s s -> m c -> n c
zoom Optic k is t t s s
l = LensLike' (Zoomed m c) t s -> m c -> n c
forall c. LensLike' (Zoomed m c) t s -> m c -> n c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Optic k is t t s s -> LensVL t t s s
forall k (is :: IxList) s t a b.
Is k A_Lens =>
Optic k is s t a b -> LensVL s t a b
toLensVL Optic k is t t s s
l)

data BrickData = BrickData
  { BrickData -> [ListResult]
_lr    :: [ListResult]
  }
  deriving Int -> BrickData -> ShowS
[BrickData] -> ShowS
BrickData -> String
(Int -> BrickData -> ShowS)
-> (BrickData -> String)
-> ([BrickData] -> ShowS)
-> Show BrickData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BrickData -> ShowS
showsPrec :: Int -> BrickData -> ShowS
$cshow :: BrickData -> String
show :: BrickData -> String
$cshowList :: [BrickData] -> ShowS
showList :: [BrickData] -> ShowS
Show

makeLenses ''BrickData

data BrickSettings = BrickSettings { BrickSettings -> Bool
_showAllVersions :: Bool}
  --deriving Show

makeLenses ''BrickSettings

defaultAppSettings :: BrickSettings
defaultAppSettings :: BrickSettings
defaultAppSettings = Bool -> BrickSettings
BrickSettings Bool
False