ShellRC: remove brick functions

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.

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 ()