diff --git a/posts/number-number/2/Diagonal.hs b/posts/number-number/2/Diagonal.hs index 0dfd83c..67ca1f6 100644 --- a/posts/number-number/2/Diagonal.hs +++ b/posts/number-number/2/Diagonal.hs @@ -1,7 +1,9 @@ {-# LANGUAGE TupleSections #-} +-- Module for displaying diagonals over Colonnades module Diagonal where import Colonnade +import Data.List (lookup) import Data.Profunctor import Data.Bifunctor @@ -35,25 +37,28 @@ newColumn header f = columns f (\_ -> Headed $ RC Nothing (Left header)) [()] -- Numbered rows of data, as opposed to data for rendering data DiagRow a = DR { - rowNumber :: RowNumber, - rowData :: [a] + rowNumber :: RowNumber, -- Row number + rowLabels :: [(String, String)], -- Extra labelling lookup for this row, which should not be manipulated + rowData :: [a] -- Actual row data } deriving Functor -- 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) (Left $ f $ rowNumber c)) +-- Additional column from a label on the row +labelColumn header = newColumn header (\_ (DR rn rl rd) -> RC (Just rn) $ Left $ maybe "" id $ lookup header rl) + -- Number rows with the title "Sequence" numberColumn = newColumnR "Sequence" show -- Column of ellipses ellipsisColumn = newColumnR "..." (const "...") -- Create a Colonnade over DiagRows by mapping them into lists --- 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 +-- The ellipsis row is mapped to cells which always display as ellipses diagBox' n = columns cell headCell [0..n] - 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) + where cell _ (DR Ellipsis _ _) = RC (Just Ellipsis) (Left "...") + cell i (DR rn _ rd) = RC (Just rn) $ Right $ (Just i, rd !! i) headCell i = Headed $ RC Nothing (Left $ show i) diagBox n = numberColumn <> diagBox' n <> ellipsisColumn @@ -63,22 +68,51 @@ displayRows f = (displayTable .) . tagRows' 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 (Left r)) -> Left r (Left (Right r)) -> Right $ f r - (Right (g, r)) -> Right $ g $ either id id r + (Right (g, r)) -> Right $ g $ either id id r +-- Build a list of `DiagRow`s from xs, terminated by an ellipsis and an Omega row (y) rowsOmega :: [[a]] -> [a] -> [DiagRow a] -rowsOmega xs y = zipWith (\x n -> DR (RN n) x) xs [0..] ++ [DR Ellipsis [], DR Omega y] +rowsOmega xs y = zipWith (\x n -> DR (RN n) [] x) xs [0..] ++ [DR Ellipsis [] [], DR Omega [] y] -diagData = rowsOmega [ - [1, 2, 3, 4, 5, 6], - [9, 2, 4, 8, 3, 7], - [2, 2, 8, 2, 2, 2], - [2, 3, 9, 3, 9, 9], - [9, 4, 9, 4, 9, 4], - [8, 1, 2, 5, 7, 9] - ] - [2, 3, 9, 4, 0, 0] +-- Build a labelled list of `DiagRow`s from labelled sequences xs, terminated by an ellipsis and an Omega row (y) +-- l is the label name to use in the DiagRow +rowsOmegaLabelled :: String -> [(String, [a])] -> [a] -> [DiagRow a] +rowsOmegaLabelled l xs y = zipWith (\(x, y) n -> DR (RN n) [(l, x)] y) xs [0..] ++ [DR Ellipsis [] [], DR Omega [] y] -displayDiagTable ps = rmap style . diagBox - where style = either show id . displayRows (("Red " ++) . show) (map (, ("Green " ++). show) ps) +-- rmap over a Colonnade using the first function in `ps` which does not return Nothing +-- If no functions match, `f` is used instead. +renderCells f ps = rmap $ tryOne ps where + tryOne [] c = f c + tryOne (p:ps) c = case p c of + Just new -> new + Nothing -> tryOne ps c + +-- Mark a diagonal using the function f +-- Cells are expected to be of the format (Maybe {columnNumber}, data) +-- Diagonal n is the one where the difference between the row number and column number is n +-- Nonmatches go to Nothing +markDiagonal n f (RC (Just (RN r)) x) = case x of + Left _ -> Nothing + Right (Nothing, y) -> Nothing + Right (Just x, y) -> if r - x == n then Just $ f y else Nothing +markDiagonal n f (RC _ x) = Nothing + +-- Mark certain row numbers using the function f +-- Nonmatches go to Nothing +markRows rns f x@(RC (Just rn) _) + | rn `elem` rns = Just $ f x + | otherwise = Nothing +markRows _ _ (RC _ _) = Nothing + +-- Show the pure cell data without the column index +showCell (RC _ (Left s)) = s +showCell (RC _ (Right (_, x))) = show x + +-- Demo some data with emphasized rows and a diagonal +displayDiagData :: Show a => [RowNumber] -> Int -> Colonnade Headed (DiagRow a) String +displayDiagData rows = renderCells showCell [ + markDiagonal 0 (("Red " ++) . show), + markRows rows (("Green " ++) . showCell) + ] . diagBox