related:
- https://en.wikipedia.org/wiki/Befunge (via @rightfold)
- https://esolangs.org/wiki/Funciton
related:
module Main where | |
import Prelude | |
import Control.Monad ((=<<)) | |
import Data.Array (mapWithIndex, index, cons) | |
import Data.Lens (iso) | |
import Data.Foldable (sum) | |
import Data.Maybe | |
import React as R | |
import React.DOM as R | |
import React.DOM.Props as RP | |
import React.DOM.Props (style, onClick, href, target, className) | |
import Thermite hiding (defaultMain) as T | |
import Thermite.Try as T | |
type RowRecNamed = | |
{ qty :: Int | |
, description :: String | |
, price :: Number | |
, total :: Number | |
} | |
columnHeaders = ["qty", "description", "price", "total"] | |
columnHeaderCellsNamed :: Array R.ReactElement | |
columnHeaderCellsNamed = mapWithIndex (\col -> systemCell 0 col) ("" `cons` columnHeaders) | |
rowsIndexed :: Array (Array SType) | |
rowsIndexed = | |
[ [ SInt 1, SStr "partridge" , SFloat 1.50, SFloat 1.50 ] | |
, [ SInt 2, SStr "turtle doves", SFloat 3.00, SFloat 6.00 ] | |
, [ SInt 5, SStr "golden rings", SFloat 7.00, SFloat 35.00 ] | |
] | |
-------------------------------------------------------------------------------- | |
extractColumn :: forall a. (SType -> Maybe a) -> Int -> Array (Array SType) -> Array (Maybe a) | |
extractColumn f col = map (f <=< (flap index) col) | |
-------------------------------------------------------------------------------- | |
data SType = SStr String | SInt Int | SFloat Number | SBool Boolean | |
exS :: SType -> String | |
exS t = case t of | |
SStr x -> x | |
SInt x -> show x | |
SFloat x -> show x | |
SBool x -> show x | |
exSInt :: SType -> Maybe Int | |
exSInt = case _ of | |
SInt x -> pure x | |
_ -> Nothing | |
exSStr :: SType -> Maybe String | |
exSStr = case _ of | |
SStr x -> pure x | |
_ -> Nothing | |
exSBool :: SType -> Maybe Boolean | |
exSBool = case _ of | |
SBool x -> pure x | |
_ -> Nothing | |
exSFloat :: SType -> Maybe Number | |
exSFloat = case _ of | |
SFloat x -> pure x | |
_ -> Nothing | |
liftRow :: Array SType -> RowRecNamed | |
liftRow r = | |
{ qty: fromMaybe (-1) $ exSInt =<< index r 0 | |
, description: fromMaybe "???" $ exSStr =<< index r 1 | |
, price: fromMaybe (-1.0) $ exSFloat =<< index r 2 | |
, total: fromMaybe (-1.0) $ exSFloat =<< index r 3 | |
} | |
-------------------------------------------------------------------------------- | |
columnHeadersIndexed :: Array R.ReactElement | |
columnHeadersIndexed = | |
[ colIndexCell 0 0 | |
, colIndexCell 0 1 | |
, colIndexCell 0 2 | |
, colIndexCell 0 3 | |
, colIndexCell 0 4 | |
] | |
renderRowNamed :: Int -> RowRecNamed -> Array R.ReactElement | |
renderRowNamed rowNum row = | |
[ systemCell rowNum 0 (show (rowNum + 1)) | |
, contentCell rowNum 1 (show row.qty) | |
, contentCell rowNum 2 (row.description) | |
, contentCell rowNum 3 (show row.price) | |
, contentCell rowNum 4 (show row.total) | |
] | |
row cells = R.tr [] cells | |
contentCell r c str = R.td [ className $ "cell row-" <> show r <> " col-" <> show c <> " content-cell" ] [ R.text str ] | |
systemCell r c str = R.td [ className $ "cell row-" <> show r <> " col-" <> show c <> " system-cell" ] [ R.text str ] | |
colIndexCell r c = systemCell r c (show c) | |
-------------------------------------------------------------------------------- | |
stylesheet = | |
""" | |
.cell { | |
padding: 7px; | |
color: #555; | |
border: 1px solid #ccc; | |
} | |
.system-cell { background: #ddd; color: #aaa; } | |
.content-cell { | |
background: #eee; | |
} | |
.cell.row-1 { background: lightgreen; } | |
.cell.col-2 { background: yellow; } | |
""" | |
render :: T.Render _ _ _ | |
render _ _ _ _ = | |
[ R.h1 [] [ R.text "Spreadsheet" ] | |
, R.style [] [ R.text stylesheet ] | |
, R.table [] (columnHeadersIndexed <> (mapWithIndex (\i -> row <<< renderRowNamed i) (liftRow <$> rowsIndexed))) | |
, R.br [] [] | |
, R.table [] (columnHeaderCellsNamed <> (mapWithIndex (\i -> row <<< renderRowNamed i) (liftRow <$> rowsIndexed))) | |
, R.br [] [] | |
, R.ol [] (R.li [] <<< pure <<< R.text <<< fromMaybe "#ERROR" <$> extractColumn exSStr 1 rowsIndexed) | |
, R.br [] [] | |
, R.ol [] (R.li [] <<< pure <<< R.text <<< show <<< fromMaybe 0.0 <$> extractColumn exSFloat 3 rowsIndexed) | |
, R.text (show <<< sum $ fromMaybe 0.0 <$> extractColumn exSFloat 3 rowsIndexed) | |
] | |
spec :: T.Spec _ _ _ _ | |
spec = T.simpleSpec T.defaultPerformAction render | |
main = T.defaultMain spec unit |