urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-19 00:13:12 +03:00
Code Issues Packages Projects Releases Wiki Activity

kh: improve code style

Browse Source 
Removes superfluous parens, makes better use of pattern matching, and
respects project-wide capitalization style.
This commit is contained in:
fang 2021-06-17 20:34:14 +02:00
parent b3964c97a6
commit addcf42468
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
4 changed files with 19 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
View File

@ -389,19 +389,16 @@ instance FromNoun Ev where
getSpinnerNameForEvent :: Ev -> Maybe Text getSpinnerNameForEvent :: Ev -> Maybe Text
getSpinnerNameForEvent = \case getSpinnerNameForEvent = \case
EvBlip b -> case b of EvBlip b -> case b of
BlipEvAmes _ -> Just "ames" BlipEvAmes _ -> Just "ames"
BlipEvArvo _ -> Just "arvo" BlipEvArvo _ -> Just "arvo"
BlipEvBehn _ -> Just "behn" BlipEvBehn _ -> Just "behn"
BlipEvBoat _ -> Just "boat" BlipEvBoat _ -> Just "boat"
BlipEvHttpClient _ -> Just "iris" BlipEvHttpClient _ -> Just "iris"
BlipEvHttpServer _ -> Just "eyre" BlipEvHttpServer _ -> Just "eyre"
BlipEvNewt _ -> Just "newt" BlipEvNewt _ -> Just "newt"
BlipEvSync _ -> Just "clay" BlipEvSync _ -> Just "clay"
BlipEvTerm t | isUser t -> Nothing BlipEvTerm (TermEvBelt _ _) -> Nothing
BlipEvTerm t -> Just "term" BlipEvTerm t -> Just "term"
where
isUser (TermEvBelt _ _) = True
isUser _ = False
summarizeEvent :: Ev -> Text summarizeEvent :: Ev -> Text
summarizeEvent ev = summarizeEvent ev =

4
pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs
View File

@ -313,9 +313,9 @@ localClient doneSignal = fst <$> mkRAcquire start stop
-- TODO: Ignoring priority for now. Priority changes the color of, -- TODO: Ignoring priority for now. Priority changes the color of,
-- and adds a prefix of '>' to, the output. -- and adds a prefix of '>' to, the output.
let lines = fmap unTape $ wash (WashCfg 0 width) $ tankTree $ snd slog let lines = fmap unTape $ wash (WashCfg 0 width) $ tankTree $ snd slog
T.putCSI 'm' [90] --NOTE print slogs in grey T.putCsi 'm' [90] --NOTE print slogs in grey
forM (intersperse "\n" lines) $ \line -> putStr line forM (intersperse "\n" lines) $ \line -> putStr line
T.putCSI 'm' [0] T.putCsi 'm' [0]
T.lojack T.lojack
pure ls pure ls

2
pkg/hs/urbit-king/lib/Urbit/Vere/Term/Logic.hs
View File

@ -92,7 +92,7 @@ step st@St{..} = \case
st { sLine = "", sCurPos = (0, 0) } st { sLine = "", sCurPos = (0, 0) }
& recordText (sLine <> "\n") & recordText (sLine <> "\n")
| otherwise -> | otherwise ->
st { sCurPos = (((fst sCurPos) - 1), 0) } st { sCurPos = (fst sCurPos - 1, 0) }
where where
recordText :: Text -> St -> St recordText :: Text -> St -> St
recordText !t st@St{..} = st { recordText !t st@St{..} = st {

12
pkg/hs/urbit-king/lib/Urbit/Vere/Term/Render.hs
View File

@ -8,7 +8,7 @@ module Urbit.Vere.Term.Render
, cursorMove , cursorMove
, cursorSave , cursorSave
, cursorRestore , cursorRestore
, putCSI , putCsi
, hijack , hijack
, lojack , lojack
) where ) where
@ -39,19 +39,19 @@ cursorSave = liftIO ANSI.saveCursor
cursorRestore :: MonadIO m => m () cursorRestore :: MonadIO m => m ()
cursorRestore = liftIO ANSI.restoreCursor cursorRestore = liftIO ANSI.restoreCursor
putCSI :: MonadIO m => Char -> [Int] -> m () putCsi :: MonadIO m => Char -> [Int] -> m ()
putCSI c a = liftIO do putCsi c a = liftIO do
putStr "\x1b[" putStr "\x1b["
putStr $ pack $ mconcat $ intersperse ";" (fmap show a) putStr $ pack $ mconcat $ intersperse ";" (fmap show a)
putStr $ pack [c] putStr $ pack [c]
hijack :: MonadIO m => Int -> m () hijack :: MonadIO m => Int -> m ()
hijack h = liftIO do hijack h = liftIO do
putCSI 'r' [1, h-1] -- set scroll region to exclude bottom line putCsi 'r' [1, h-1] -- set scroll region to exclude bottom line
putCSI 'S' [1] -- scroll up one line putCsi 'S' [1] -- scroll up one line
cursorMove (h-2) 0 -- move cursor to empty space cursorMove (h-2) 0 -- move cursor to empty space
lojack :: MonadIO m => m () lojack :: MonadIO m => m ()
lojack = liftIO do lojack = liftIO do
putCSI 'r' [] -- reset scroll region putCsi 'r' [] -- reset scroll region
cursorRestore -- restory cursor position cursorRestore -- restory cursor position