From b5785fff56aeeb5619de034fc3e0bf130d7f5209 Mon Sep 17 00:00:00 2001 From: queue-miscreant Date: Tue, 29 Jul 2025 00:59:42 -0500 Subject: [PATCH] lift rendercells to either string a --- posts/number-number/2/Diagonal.hs | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) diff --git a/posts/number-number/2/Diagonal.hs b/posts/number-number/2/Diagonal.hs index 9b223d5..0dfd83c 100644 --- a/posts/number-number/2/Diagonal.hs +++ b/posts/number-number/2/Diagonal.hs @@ -15,26 +15,23 @@ instance Show RowNumber where -- Rendered cell data, along with its row number and an optional value to show instead data RenderCell a = RC { cellRow :: Maybe RowNumber, -- Nothing if this is a header; Just . RC otherwise - cellForceShow :: Maybe String, -- TODO: Either String a - cellData :: Maybe a + cellData :: Either String a -- Left if fixed display data, a otherwise } deriving Functor -- If a forced value is availaible, use it; otherwise, show the inside instance Show a => Show (RenderCell a) where - show (RC _ Nothing (Just x)) = show x - show (RC _ Nothing Nothing) = "" - show (RC _ (Just s) _) = s + show (RC _ (Left s)) = s + show (RC _ (Right x)) = show x -- Lift a RenderCell over Either to an Either over RenderCells --- If the force-string is set, then a `Left` version with a Nothing value is returned +-- If the force-string is set (cellData is a Left), then a `Left` version is produced liftRC :: RenderCell (Either a b) -> Either (RenderCell a) (RenderCell b) -liftRC (RC rn Nothing Nothing) = Left $ RC rn Nothing Nothing -liftRC (RC rn (Just x) _) = Left $ RC rn (Just x) Nothing -liftRC (RC rn Nothing (Just (Left v))) = Left $ RC rn Nothing $ Just v -liftRC (RC rn Nothing (Just (Right v))) = Right $ RC rn Nothing $ Just v +liftRC (RC rn (Left x)) = Left $ RC rn $ Left x +liftRC (RC rn (Right (Left v))) = Left $ RC rn $ Right v +liftRC (RC rn (Right (Right v))) = Right $ RC rn $ Right v -- Single column with a fixed header and data coming from a row number -newColumn header f = columns f (\_ -> Headed $ RC Nothing (Just header) Nothing) [()] +newColumn header f = columns f (\_ -> Headed $ RC Nothing (Left header)) [()] -- Numbered rows of data, as opposed to data for rendering data DiagRow a = DR { @@ -44,7 +41,7 @@ data DiagRow a = DR { -- Same as `newColumn`, but reads into a DiagRow's row numberRows -- The display function `f` is used to convert the value to a String -newColumnR header f = newColumn header (\_ c -> RC (Just $ rowNumber c) (Just $ f $ rowNumber c) Nothing) +newColumnR header f = newColumn header (\_ c -> RC (Just $ rowNumber c) (Left $ f $ rowNumber c)) -- Number rows with the title "Sequence" numberColumn = newColumnR "Sequence" show @@ -55,16 +52,16 @@ ellipsisColumn = newColumnR "..." (const "...") -- The ellipsis row is mapped to a cells which always display as ellipses -- The remaining rows are `Right` if they lie on the main diagonal, or `Left` otherwise diagBox' n = columns cell headCell [0..n] - where cell _ (DR Ellipsis _) = RC (Just Ellipsis) (Just "...") Nothing - cell i (DR rn rd) = RC (Just rn) Nothing $ Just $ (if RN i == rn then Right else Left) (rd !! i) - headCell i = Headed $ RC Nothing (Just $ show i) Nothing + where cell _ (DR Ellipsis _) = RC (Just Ellipsis) (Left "...") + cell i (DR rn rd) = RC (Just rn) $ Right $ (if RN i == rn then Right else Left) (rd !! i) + headCell i = Headed $ RC Nothing (Left $ show i) diagBox n = numberColumn <> diagBox' n <> ellipsisColumn displayRows f = (displayTable .) . tagRows' where -- Tag rows by (predicate function, extra value) tuples - tagRows' [] r@(RC rn _ _) = Left r -- Tag missing things as left - tagRows' ((p, f):ps) r@(RC rn _ _) = if p == rn then Right (f, r) else tagRows' ps r -- Match found, tag right + tagRows' [] r@(RC rn _) = Left r -- Tag missing things as left + tagRows' ((p, f):ps) r@(RC rn _) = if p == rn then Right (f, r) else tagRows' ps r -- Match found, tag right displayTable row = case bimap liftRC (fmap liftRC) row of (Left (Left r)) -> Left r (Left (Right r)) -> Right $ f r