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

kh: improve term code style

Browse Source 
Based on feedback during review.
This commit is contained in:
fang 2021-04-14 17:10:50 +02:00
parent 65602198fc
commit 98d48913bf
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
3 changed files with 23 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -309,12 +309,7 @@ instance FromNoun Bolt where
n -> $(deriveFromNounFunc ''Bolt) n n -> $(deriveFromNounFunc ''Bolt) n
instance FromNoun Belt where instance FromNoun Belt where
parseNoun = \case parseNoun n = Bol <$> parseNoun n <|> $(deriveFromNounFunc ''Belt) n
A c -> pure $ Bol $ Key $ C.chr $ fromIntegral c
n -> runParser ($(deriveFromNounFunc ''Bolt) n) [] belt bolt
where
belt p m = $(deriveFromNounFunc ''Belt) n
bolt !b = pure $ Bol b
instance ToNoun Bolt where instance ToNoun Bolt where
toNoun = \case toNoun = \case
@ -323,9 +318,7 @@ instance ToNoun Bolt where
instance ToNoun Belt where instance ToNoun Belt where
toNoun = \case toNoun = \case
Bol b -> case b of Bol b -> toNoun b
Key c -> A $ fromIntegral $ C.ord c
b -> $(deriveToNounFunc ''Bolt) b
n -> $(deriveToNounFunc ''Belt) n n -> $(deriveToNounFunc ''Belt) n
data TermEv data TermEv

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

@ -84,15 +84,15 @@ step st@St{..} = \case
EvSlog s -> st & recordSlog s EvSlog s -> st & recordSlog s
EvSpin s -> st { sSpinner = s } EvSpin s -> st { sSpinner = s }
EvMove p -> st { sCurPos = p } EvMove p -> st { sCurPos = p }
EvEdit t -> if fst sCurPos == 0 then st { sLine = t }
else st
EvNewl -> if fst sCurPos == 0 then
st { sLine = "", sCurPos = (0, 0) }
& recordText (sLine <> "\n")
else
st { sCurPos = (((fst sCurPos) - 1), 0) }
EvBell -> st EvBell -> st
EvDraw -> st EvDraw -> st
EvEdit t | (0, _) <- sCurPos -> st { sLine = t }
| otherwise -> st
EvNewl | (0, _) <- sCurPos ->
st { sLine = "", sCurPos = (0, 0) }
& recordText (sLine <> "\n")
| otherwise ->
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 {
@ -113,8 +113,10 @@ drawState :: St -> [Ev]
drawState St{..} = hist <> out <> cur <> spin drawState St{..} = hist <> out <> cur <> spin
where where
hist = drawHistory <$> toList sHistory hist = drawHistory <$> toList sHistory
out = if null sLine then [] else [EvEdit sLine] out | null <- sLine = []
cur = if 0 == fst sCurPos then [] else [EvMove sCurPos] | otherwise = [EvEdit sLine]
cur | (0, _) <- sCurPos = []
| otherwise = [EvMove sCurPos]
spin = maybe [] (singleton . EvSpin . Just) sSpinner spin = maybe [] (singleton . EvSpin . Just) sSpinner
drawHistory (HistoryText t) = EvLine t drawHistory (HistoryText t) = EvLine t
@ -151,12 +153,12 @@ fromTermEv = \case
toTermEv :: Ev -> Term.Ev toTermEv :: Ev -> Term.Ev
toTermEv = \case toTermEv = \case
EvLine "" -> Term.Blank EvLine "" -> Term.Blank
EvLine t -> Term.Trace (Cord t) EvLine t -> Term.Trace (Cord t)
EvSlog s -> Term.Slog s EvSlog s -> Term.Slog s
EvSpin s -> Term.Spinr (fromCause <$> s) EvSpin s -> Term.Spinr (fromCause <$> s)
EvMove (r, c) -> Term.Blits [Arvo.Hop $ Arvo.Roc (fromIntegral r) (fromIntegral c)] EvMove (r, c) -> Term.Blits [Arvo.Hop $ Arvo.Roc (fromIntegral r) (fromIntegral c)]
EvBell -> Term.Blits [Arvo.Bel ()] EvBell -> Term.Blits [Arvo.Bel ()]
EvDraw -> Term.Blits [Arvo.Clr ()] EvDraw -> Term.Blits [Arvo.Clr ()]
EvEdit t -> Term.Blits [Arvo.Put $ unpack t] EvEdit t -> Term.Blits [Arvo.Put $ unpack t]
EvNewl -> Term.Blits [Arvo.Nel ()] EvNewl -> Term.Blits [Arvo.Nel ()]

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

@ -34,10 +34,10 @@ cursorMove :: MonadIO m => Int -> Int -> m ()
cursorMove r c = liftIO $ ANSI.setCursorPosition r c cursorMove r c = liftIO $ ANSI.setCursorPosition r c
cursorSave :: MonadIO m => m () cursorSave :: MonadIO m => m ()
cursorSave = liftIO $ ANSI.saveCursor 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