mirror of
https://github.com/urbit/shrub.git
synced 2024-12-19 00:13:12 +03:00
kh: improve term code style
Based on feedback during review.
This commit is contained in:
parent
65602198fc
commit
98d48913bf
@ -309,12 +309,7 @@ instance FromNoun Bolt where
|
||||
n -> $(deriveFromNounFunc ''Bolt) n
|
||||
|
||||
instance FromNoun Belt where
|
||||
parseNoun = \case
|
||||
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
|
||||
parseNoun n = Bol <$> parseNoun n <|> $(deriveFromNounFunc ''Belt) n
|
||||
|
||||
instance ToNoun Bolt where
|
||||
toNoun = \case
|
||||
@ -323,9 +318,7 @@ instance ToNoun Bolt where
|
||||
|
||||
instance ToNoun Belt where
|
||||
toNoun = \case
|
||||
Bol b -> case b of
|
||||
Key c -> A $ fromIntegral $ C.ord c
|
||||
b -> $(deriveToNounFunc ''Bolt) b
|
||||
Bol b -> toNoun b
|
||||
n -> $(deriveToNounFunc ''Belt) n
|
||||
|
||||
data TermEv
|
||||
|
@ -84,15 +84,15 @@ step st@St{..} = \case
|
||||
EvSlog s -> st & recordSlog s
|
||||
EvSpin s -> st { sSpinner = s }
|
||||
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
|
||||
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
|
||||
recordText :: Text -> St -> St
|
||||
recordText !t st@St{..} = st {
|
||||
@ -113,8 +113,10 @@ drawState :: St -> [Ev]
|
||||
drawState St{..} = hist <> out <> cur <> spin
|
||||
where
|
||||
hist = drawHistory <$> toList sHistory
|
||||
out = if null sLine then [] else [EvEdit sLine]
|
||||
cur = if 0 == fst sCurPos then [] else [EvMove sCurPos]
|
||||
out | null <- sLine = []
|
||||
| otherwise = [EvEdit sLine]
|
||||
cur | (0, _) <- sCurPos = []
|
||||
| otherwise = [EvMove sCurPos]
|
||||
spin = maybe [] (singleton . EvSpin . Just) sSpinner
|
||||
|
||||
drawHistory (HistoryText t) = EvLine t
|
||||
@ -151,12 +153,12 @@ fromTermEv = \case
|
||||
|
||||
toTermEv :: Ev -> Term.Ev
|
||||
toTermEv = \case
|
||||
EvLine "" -> Term.Blank
|
||||
EvLine t -> Term.Trace (Cord t)
|
||||
EvSlog s -> Term.Slog s
|
||||
EvSpin s -> Term.Spinr (fromCause <$> s)
|
||||
EvLine "" -> Term.Blank
|
||||
EvLine t -> Term.Trace (Cord t)
|
||||
EvSlog s -> Term.Slog s
|
||||
EvSpin s -> Term.Spinr (fromCause <$> s)
|
||||
EvMove (r, c) -> Term.Blits [Arvo.Hop $ Arvo.Roc (fromIntegral r) (fromIntegral c)]
|
||||
EvBell -> Term.Blits [Arvo.Bel ()]
|
||||
EvDraw -> Term.Blits [Arvo.Clr ()]
|
||||
EvEdit t -> Term.Blits [Arvo.Put $ unpack t]
|
||||
EvNewl -> Term.Blits [Arvo.Nel ()]
|
||||
EvBell -> Term.Blits [Arvo.Bel ()]
|
||||
EvDraw -> Term.Blits [Arvo.Clr ()]
|
||||
EvEdit t -> Term.Blits [Arvo.Put $ unpack t]
|
||||
EvNewl -> Term.Blits [Arvo.Nel ()]
|
||||
|
@ -34,10 +34,10 @@ cursorMove :: MonadIO m => Int -> Int -> m ()
|
||||
cursorMove r c = liftIO $ ANSI.setCursorPosition r c
|
||||
|
||||
cursorSave :: MonadIO m => m ()
|
||||
cursorSave = liftIO $ ANSI.saveCursor
|
||||
cursorSave = liftIO ANSI.saveCursor
|
||||
|
||||
cursorRestore :: MonadIO m => m ()
|
||||
cursorRestore = liftIO $ ANSI.restoreCursor
|
||||
cursorRestore = liftIO ANSI.restoreCursor
|
||||
|
||||
putCSI :: MonadIO m => Char -> [Int] -> m ()
|
||||
putCSI c a = liftIO do
|
||||
|
Loading…
Reference in New Issue
Block a user