From 8c1ee3f4b6d82de69c7107c4b06949184d9c79ca Mon Sep 17 00:00:00 2001
From: Daniel Firth <dan.firth@homotopic.tech>
Date: Fri, 24 Feb 2023 20:21:51 +0000
Subject: [PATCH] ShellRC: remove brick functions
---
README.md | 22 ++++++
shell/ShellRC.hs | 175 +----------------------------------------------
2 files changed, 24 insertions(+), 173 deletions(-)
diff --git a/README.md b/README.md
index d67217bb..c38d49fd 100644
--- a/README.md
+++ b/README.md
@@ -33,6 +33,28 @@ If you need to do additional manual overrides to the nix code, such as
`addPkgconfigDepends`, edit the `configuration.nix` overlay, which is applied
afterwards.
+## Programmmatic Updates
+
+The package set will be automatically loaded under the variable `hz`.
+
+```
+import Horizon.Spec.Utils
+
+let f = L.at "lens" L..~ Just (callHackage "lens" "5.1")
+
+:t f
+f :: (L.IxValue t ~ HaskellPackage, L.At t,
+ IsString (L.Index t)) =>
+ t -> t
+
+let hz' = f hz
+
+H.writeHorizonFile hz'
+
+```
+
+Then remember to delete `pkgs/lens.nix` and re-run `nix run .#horizon-gen-nix`
+as usual.~
## Package Set Policy
This package set has the following policy.
diff --git a/shell/ShellRC.hs b/shell/ShellRC.hs
index d019bd7c..d86ff860 100644
--- a/shell/ShellRC.hs
+++ b/shell/ShellRC.hs
@@ -6,16 +6,12 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
module ShellRC where
-import Brick (BrickEvent(VtyEvent), txt, hBox, padLeftRight)
-import Brick (EventM, viewport, ViewportType(Vertical))
-import Brick (halt, attrMap, attrName, bg, on, fg)
import qualified Brick
import Brick.Widgets.Border
import qualified Brick.Widgets.List as Brick
@@ -53,8 +49,8 @@ import GHC.Exts
import Graphics.Vty.Attributes
import Graphics.Vty.Input.Events
import Horizon.Spec
-import qualified Horizon.Spec.Lens as L
-import qualified Horizon.Spec.Pretty as H
+import qualified Horizon.Spec.Lens as L
+import qualified Horizon.Spec.Pretty as H
import Network.HTTP.Simple
import Path
import Polysemy
@@ -90,172 +86,5 @@ runAllFeedback = do
let y = Map.keys . A.toMapText . L.view (L._Right . L._Object . L.ix "loops" . L._Object) $ x
mapM_ (captureLazyNoThrow . mq t "--command" "nix" "run" "github:NorfairKing/feedback" "--" . T.unpack) y
-renderUrl :: Url -> Brick.Widget n
-renderUrl (MkUrl x) = txt x
-
-renderRepo :: Repo -> Brick.Widget n
-renderRepo (MkRepo x) = renderUrl x
-
-renderRevision :: Revision -> Brick.Widget n
-renderRevision (MkRevision x) = txt x
-
-renderName :: Name -> Brick.Widget n
-renderName (MkName x) = txt x
-
-renderVersion :: Version -> Brick.Widget n
-renderVersion (MkVersion x) = txt x
-
-renderGitSource :: GitSource -> Brick.Widget n
-renderGitSource (MkGitSource u r s) = hBox (fmap (padLeftRight 1) [txt "Git", renderRepo u, renderRevision r])
-
-renderHackageSource :: HackageSource -> Brick.Widget n
-renderHackageSource (MkHackageSource n v) = hBox (fmap (padLeftRight 1) [txt "Hackage", renderName n, renderVersion v])
-
-renderHaskellSource :: HaskellSource -> Brick.Widget n
-renderHaskellSource (FromGit x) = renderGitSource x
-renderHaskellSource (FromHackage x) = renderHackageSource x
-
-type PackageListCursor :: Type
-type PackageListCursor = NonEmptyCursor (Name, HaskellPackage, Text) (Name, HaskellPackage, Text)
-
-type HorizonTUIState :: Type
-data HorizonTUIState where
- MkHorizonTUIState :: {
- packageListCursor :: PackageListCursor,
- lastChar :: Maybe Char
- } -> HorizonTUIState
-
-packageListToMatrix :: PackageListCursor -> [[Brick.Widget n]]
-packageListToMatrix (NonEmptyCursor xs y zs) = V.toList $ mconcat [
- fmap (\(k, v, _) -> [renderName k, renderHaskellSource $ source v]) $ V.fromList $ reverse $ Data.List.take 100 xs,
- pure $ (\(k, v, _) -> fmap (Brick.withAttr (Brick.attrName "highlight")) [Brick.visible (renderName k), renderHaskellSource $ source v]) $ y,
- fmap (\(k, v, _) -> [renderName k, renderHaskellSource $ source v]) $ V.fromList $ Data.List.take 100 zs
- ]
-
-renderCursorPackageInfo :: PackageListCursor -> Brick.Widget n
-renderCursorPackageInfo (NonEmptyCursor _ y _) = txt . L.view L._3 $ y
-
-packageListToTable :: PackageListCursor -> Table n
-packageListToTable = table . packageListToMatrix
-
-renderPackageList :: Text -> PackageListCursor -> Brick.Widget Text
-renderPackageList x = viewport x Vertical . renderTable . packageListToTable
-
-nonEmptyCursorSelectNextClamped :: (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
-nonEmptyCursorSelectNextClamped f g s = fromMaybe s $ nonEmptyCursorSelectNext f g s
-
-nonEmptyCursorSelectPrevClamped :: (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b
-nonEmptyCursorSelectPrevClamped f g s = fromMaybe s $ nonEmptyCursorSelectPrev f g s
-
-scrollDown :: Brick.EventM e HorizonTUIState ()
-scrollDown = Brick.modify (\(MkHorizonTUIState s c) -> MkHorizonTUIState (nonEmptyCursorSelectNextClamped id id s) c)
-
-scrollUp :: Brick.EventM e HorizonTUIState ()
-scrollUp = Brick.modify (\(MkHorizonTUIState s c) -> MkHorizonTUIState (nonEmptyCursorSelectPrevClamped id id s) c)
-
-endOfFile :: Brick.EventM e HorizonTUIState ()
-endOfFile = Brick.modify (\(MkHorizonTUIState s c) -> MkHorizonTUIState (nonEmptyCursorSelectLast id id s) c)
-
-startOfFile :: Brick.EventM e HorizonTUIState ()
-startOfFile = Brick.modify (\(MkHorizonTUIState s c) -> MkHorizonTUIState (nonEmptyCursorSelectFirst id id s) c)
-
-type Vim :: Type -> (Type -> Type) -> Type -> Type
-data Vim y m a where
- Del :: Vim y m ()
- Find :: Vim y m ()
- MoveDown :: Vim y m ()
- MoveEndOfFile :: Vim y m ()
- MoveLeft :: Vim y m ()
- MoveRight :: Vim y m ()
- MoveStartOfFile :: Vim y m ()
- MoveUp :: Vim y m ()
- Paste :: Vim y m ()
- Quit :: Vim y m ()
- Write :: Vim y m ()
- Yank :: Vim y m ()
-
-makeSem ''Vim
-
-interpretVim :: Member (Embed (Brick.EventM e HorizonTUIState)) r => Sem (Vim y ': r) a -> Sem r a
-interpretVim = interpret $ \case
- Del -> embed $ pure ()
- Find -> embed $ pure ()
- MoveDown -> embed $ scrollDown
- MoveEndOfFile -> embed $ endOfFile
- MoveLeft -> embed $ pure ()
- MoveRight -> embed $ pure ()
- MoveStartOfFile -> embed $ startOfFile
- MoveUp -> embed $ scrollUp
- Paste -> embed $ pure ()
- Quit -> embed $ halt
- Yank -> embed $ pure ()
-
-brickEventToVim :: Members '[Vim y, State (Maybe Char)] r => Brick.BrickEvent Text e -> Sem r ()
-brickEventToVim (VtyEvent (EvKey KDown [])) = moveDown
-brickEventToVim (VtyEvent (EvKey KUp [])) = moveUp
-brickEventToVim (VtyEvent (EvKey (KChar 'j') [])) = moveDown
-brickEventToVim (VtyEvent (EvKey (KChar 'k') [])) = moveUp
-brickEventToVim (VtyEvent (EvKey (KChar 'G') [])) = moveEndOfFile
-brickEventToVim (VtyEvent (EvKey (KChar 'g') [])) = do
- x <- get
- case x of
- Just 'g' -> do
- moveStartOfFile
- put Nothing
- _ -> put $ Just 'g'
-brickEventToVim (VtyEvent (EvKey (KChar 'q') [])) = quit
-brickEventToVim (VtyEvent (EvKey (KChar 'w') [])) = write
-
-
-semStateToBrickState :: Member (Embed (EventM e s)) r => L.Lens' s t -> Sem (State t ': r) a -> Sem r a
-semStateToBrickState f = interpret $ \case
- Put x -> embed $ Brick.put . L.set f x =<< Brick.get
- Get -> embed $ L.view f <$> Brick.get
-
-handleEvent :: Brick.BrickEvent Text e -> Brick.EventM Text HorizonTUIState ()
-handleEvent (VtyEvent (EvKey (KChar 'b') [])) = do
- (MkName x, _, _) <- Brick.gets (nonEmptyCursorCurrent . packageListCursor)
- _ <- liftIO $ captureLazyNoThrow $ mq
- "nix"
- "build"
- "-L"
- (T.unpack $ ".#" <> x)
- (pipeHOut 1 $ \_ stdout -> B.hGetContents stdout >>= (\_ -> pure ()))
- (pipeHOut 2 $ \_ stderr -> B.hGetContents stderr >>= (\_ -> pure ()))
- pure ()
-handleEvent x = do
- runM . semStateToBrickState (L.lens lastChar (\(MkHorizonTUIState s c) x -> MkHorizonTUIState s x )) . interpretVim . brickEventToVim $ x
-handleEvent _ = pure ()
-
-
-appAttrMap = attrMap defAttr [ (attrName "highlight", fg yellow)
- , (attrName "warning", bg magenta)
- , (attrName "good", white `on` green)
- ]
-
-packageListMain :: Brick.App HorizonTUIState e Text
-packageListMain = Brick.App ((\x -> pure $ hBox [renderPackageList "F" x, border $ renderCursorPackageInfo x]) . packageListCursor) (const $ const Nothing) handleEvent (pure ()) (const (appAttrMap))
-
-buildCursor :: HorizonExport -> IO PackageListCursor
-buildCursor (MakePackageSet (MkPackageSetExportSettings d _ (MkPackageSet _ (MkPackageList (Map.toList -> y:ys))))) = do
- (z : zs) <- forM (y:ys) $ \(x, k) -> do
- q <- readDerivation d x
- pure (x, k, q)
- pure $ makeNonEmptyCursor id (z :| zs)
-
-readDerivation :: PackagesDir -> Name -> IO Text
-readDerivation (MkPackagesDir d) (MkName x) = do
- f' <- parseRelFile $ T.unpack (x <> ".nix")
- let j = d </> f'
- q <- B.readFile $ toFilePath j
- pure $ T.decodeUtf8Lenient q
-
loadHorizon :: IO HorizonExport
loadHorizon = Dhall.inputFile @HorizonExport Dhall.auto "horizon.dhall"
-
-go :: IO ()
-go = do
- x <- loadHorizon
- k <- buildCursor x
- Brick.defaultMain packageListMain $ MkHorizonTUIState k Nothing
- pure ()
--
GitLab