Skip to content

Instantly share code, notes, and snippets.

@epost

epost/Main.purs

Last active August 30, 2017 13:34
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save epost/1137b3221a0f86ba7fb97f3ad374cb12 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save epost/1137b3221a0f86ba7fb97f3ad374cb12 to your computer and use it in GitHub Desktop.
Download ZIP
Spreadsheet visualisation in PureScript Thermite
Raw
Main.purs
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment