module Network.JMacroRPC.Panels (
JS, Hask, PanelPath,
Event(..), Signal(..), Sink(..),
PanelState(..), PState, newIdent, descended,
PageSlice(..), Panel(..), UpdateList,
pureSig,
zipSinks,
contramapJs,
plainHTML,
onHtml,
joinWith,
buildInput,
inDiv,
para,
mkTable,
withSample,
sampleSigJs,
onEvent,
tellSink,
bindSigSink,
sampleIO,
bindEventIO,
button, select, selectInput, textPane, newVar,
panelPrelude,
panelToPageGen,
calcPanel
)
where
import Control.Monad.State
import Control.Arrow((***))
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Attoparsec.ByteString.Lazy(parse,Result(..))
import Data.Functor.Contravariant
import Data.Map(Map)
import Data.Set(Set)
import Data.Maybe
import Language.Javascript.JMacro
import Text.Blaze.Html5(Html)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5 as H5
import Text.Blaze.Html5((!),toValue)
import qualified Text.Blaze.Html5.Attributes as H
import Control.Applicative
import Data.Monoid
import Data.List(intercalate)
import Data.String
import Data.Aeson
import Data.Aeson.Parser
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as T
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.ByteString.Char8 as B
import qualified Text.Blaze.Html.Renderer.Pretty as P
import qualified Text.Blaze.Html.Renderer.Text as T
import Data.List.Split
import Network.JMacroRPC.Base
data JS
data Hask
type PanelPath = [Int]
printPath :: PanelPath -> String
printPath = intercalate "_" . map show . reverse
data Event = Event [PanelPath]
instance Monoid Event where
mempty = Event []
mappend (Event x) (Event y) = Event (x <> y)
data Signal typ a where
PureSig :: a -> Signal typ a
OneSig :: FromJSON a => PanelPath -> Signal typ a
MultiSig :: Signal typ1 a -> Signal typ2 b -> ((a,b) -> c) -> Signal Hask c
instance Functor (Signal Hask) where
fmap f (PureSig x) = PureSig $ f x
fmap f (OneSig p) = MultiSig (OneSig p) (PureSig ()) (f . fst)
fmap f (MultiSig x y g) = MultiSig x y (f . g)
instance Applicative (Signal Hask) where
pure x = PureSig x
(PureSig f) <*> x = fmap f x
f <*> (PureSig y) = fmap ($ y) f
f <*> x = MultiSig f x (uncurry ($))
pureSig :: a -> Signal typ a
pureSig = PureSig
data Sink typ m a where
ServerSink :: (a -> PState m [JStat]) -> Sink Hask m a
PureSink :: ToJExpr a => JExpr -> Sink typ m a
liftSink :: Monad m => Sink typ m a -> Sink Hask m a
liftSink (PureSink js) = ServerSink $ \x -> return [ [jmacro|`(js)` `(x)`|] ]
liftSink (ServerSink f) = ServerSink f
runSink :: Monad m => Sink typ m a -> a -> PState m [JStat]
runSink (ServerSink f) = f
runSink x@(PureSink _) = runSink (liftSink x)
instance Monad m => Contravariant (Sink Hask m) where
contramap f (ServerSink g) = ServerSink (g . f)
contramap f x = contramap f (liftSink x)
contramapJs :: ToJExpr a => JExpr -> Sink JS m b -> Sink JS m a
contramapJs f (PureSink g) = PureSink [jmacroE|\x -> `(g)` (`(f)` x)|]
zipSinks :: Monad m => Sink Hask m a -> Sink Hask m b -> Sink Hask m (a,b)
zipSinks (ServerSink f) (ServerSink g) = ServerSink (\(x,y) -> liftM2 (<>) (f x) (g y))
zipSinks s t = zipSinks (liftSink s) (liftSink t)
extractIds :: Signal typ a -> [PanelPath]
extractIds (PureSig _) = []
extractIds (OneSig p) = [p]
extractIds (MultiSig x y _) = extractIds x <> extractIds y
data PanelState = PanelState {
ps_path :: PanelPath,
ps_env :: Map String BS.ByteString,
ps_env_clean :: Map String BS.ByteString,
ps_events :: Set String,
ps_listener :: Maybe (String, Map String BS.ByteString)
} deriving (Show)
type PState m a = StateT PanelState m a
readSignal :: (Functor m, Monad m) => Signal typ a -> PState m a
readSignal x = case x of
PureSig v -> return v
OneSig p -> mbParse p . M.lookup (printPath p) . ps_env <$> get
MultiSig sa sb f -> fmap f $ liftA2 (,) (readSignal sa) (readSignal sb)
where mbParse p Nothing = error $ "no value in env for: " ++ printPath p
mbParse _ (Just v) = case parse value v of
Done _ jv -> case fromJSON jv of
Success a -> a
_ -> case fromJSON (String $ T.decodeUtf8 $ B.concat $ BS.toChunks v) of
Success a -> a
_ -> error $ "unable to parse: " ++ show v
_ -> case fromJSON (String $ T.decodeUtf8 $ B.concat $ BS.toChunks v) of
Success a -> a
_ -> error $ "unable to parse string: " ++ show v
setEnv :: (Functor m, Monad m, ToJSON a) => PanelPath -> a -> PState m ()
setEnv i x = modify (\ps -> ps {ps_env = go (ps_env ps)})
where go = M.insert (printPath i) (encode x)
incrPath :: PanelPath -> PanelPath
incrPath (x:xs) = x + 1 : xs
incrPath [] = []
newIdent :: (Monad m, Functor m) => PState m PanelPath
newIdent = do
i <- ps_path <$> get
modify (\s -> s {ps_path = incrPath i})
return i
descended :: (Monad m, Functor m) => (PanelPath -> PState m a) -> PState m a
descended f = do
i <- ps_path <$> get
modify (\s -> s {ps_path = 0 : i})
res <- f i
modify (\s -> s {ps_path = incrPath i})
return res
data PageSlice = PS {
htmlP :: Html,
jsP :: [JStat]
}
instance Monoid PageSlice where
mempty = PS mempty mempty
mappend (PS h j) (PS h' j') = PS (h <> h') (j <> j')
data Panel m = Panel {
drawP :: PState m PageSlice,
updateP :: PState m [(PanelPath, PageSlice)]
}
instance Monad m => Monoid (Panel m) where
mempty = Panel (return mempty) (return mempty)
mappend (Panel d u) (Panel d' u') = Panel (liftM2 (<>) d d') (liftM2 (<>) u u')
runPanelDraw :: (Monad m, Functor m) => Map String BS.ByteString -> Set String -> Panel m -> m PageSlice
runPanelDraw m s p = drawP p `evalStateT` startState
where startState = PanelState [0] m m s Nothing
runPanelUpdateSlice :: (Monad m, Functor m) => (String, Map String BS.ByteString) -> Map String BS.ByteString -> Set String -> Panel m -> m [(PanelPath,PageSlice)]
runPanelUpdateSlice (slice, parentData) m s p = updateP p `evalStateT` startState
where startState = PanelState [0] (M.union parentData m) m s (Just (slice, parentData))
runPanelUpdateMany :: (Monad m, Functor m) => Map String BS.ByteString -> Map String (Map String BS.ByteString) -> Set String -> Panel m -> m [(PanelPath,PageSlice)]
runPanelUpdateMany m listenerData s p = concat <$> mapM go (M.toList listenerData)
where go listenerPair = runPanelUpdateSlice listenerPair m s p
plainHTML :: (Monad m, Functor m) => Html -> Panel m
plainHTML h = Panel (return $ PS h []) (return [])
onHtmlPS :: (Html -> Html) -> PageSlice -> PageSlice
onHtmlPS f (PS h j) = PS (f h) j
onHtml :: (Monad m, Functor m) => (Html -> Html) -> Panel m -> Panel m
onHtml f (Panel d u) = Panel (fmap (onHtmlPS f) d) u
joinWithPS :: ([Html] -> Html) -> [PageSlice] -> PageSlice
joinWithPS f ps = PS (f $ map htmlP ps) (concatMap jsP ps)
joinWith :: (Monad m, Functor m) => ([Html] -> Html) -> [Panel m] -> Panel m
joinWith f xs = Panel (joinWithPS f <$> mapM drawP xs) (concat <$> mapM updateP xs)
withSample :: (FromJSON a, Monad m, Functor m) => Signal typ a -> (a -> Panel m) -> Panel m
withSample sig k = Panel onDraw onUpdate
where onDraw = descended $ \i -> setDependenciesSig (printPath i) (extractIds sig) <$> ((drawP . k <=< readSignal) sig)
onUpdate = descended $ const $ (updateP . k <=< readSignal) sig
setDependenciesSig :: String -> [PanelPath] -> PageSlice -> PageSlice
setDependenciesSig pathI depList (PS h j) = PS
((H.div ! H.id (toValue pathI) ! H.name (toValue "inp")) h)
(map (\d -> [jmacro|signalDepends(`(pathI)`,`(printPath d)`);|]) depList ++ j)
sampleSigJs :: ToJSON a => Signal JS a -> JExpr
sampleSigJs (OneSig ip) = [jmacroE|$("#"+`(ip)`).val()|]
sampleSigJs (PureSig x) = [jmacroE|`(toJSON x)`|]
onEvent :: (Monad m, Functor m) => Event -> Panel m -> Panel m
onEvent (Event depList) p = Panel onDraw onUpdate
where onDraw = descended $ \i -> do
let ip = printPath i
setDependenciesEvt ip <$> drawP p
setDependenciesEvt pathI (PS h j) = PS
((H.div ! H.id (toValue pathI) ! H.name (toValue "evt")) h)
(map (\d -> [jmacro|eventDepends(`(pathI)`,`(printPath d)`);|]) depList ++ j)
onUpdate = descended $ \i -> do
let ip = printPath i
events <- ps_events <$> get
listener <- fmap fst . ps_listener <$> get
let shouldUpdate = case listener of
Just l -> l == ip
Nothing -> any (`S.member` events) (map printPath depList)
if shouldUpdate
then do
parentDeps <- fromMaybe M.empty . fmap snd . ps_listener <$> get
setCleanState
(\x -> [(i,x)]) . setDependenciesUpd parentDeps ip <$> drawP p
else updateP p
setCleanState = modify (\ps -> ps {ps_env = ps_env_clean ps})
setDependenciesUpd parentData pathI (PS h j) = PS
((H.div ! H.id (toValue pathI) ! H.name (toValue "evt")) h)
(map (\d -> [jmacro|eventDependsPD(`(pathI)`,`(printPath d)`,`(M.map BS.unpack $ parentData)`);|]) depList ++ j)
tellSink :: (Functor m, Monad m) => Sink typ m a -> a -> Panel m
tellSink i x = Panel (do
l <- ps_listener <$> get
case l of
Just _ -> PS mempty <$> runSink i x
Nothing -> return mempty
)
(return [])
bindSigSink :: (Monad m, Functor m, FromJSON a, ToJSON a) => Event -> Signal typ1 a -> Sink typ2 m a -> Panel m
bindSigSink (Event depList) (PureSig a) (PureSink js) = Panel draw (newIdent >> return [])
where draw = newIdent >>= \i -> return $ PS mempty (map (\eid -> [jmacro|clientEventDepends `(printPath i)` `(printPath eid)` (\ -> `(js)` `(toJSON a)`);|]) depList)
bindSigSink (Event depList) (OneSig sid) (PureSink js) = Panel draw (newIdent >> return [])
where draw = newIdent >>= \i -> return $ PS mempty (map (\eid -> [jmacro|clientEventDepends `(printPath i)` `(printPath eid)` (\ -> `(js)` $("#"+`(sid)`).val());|]) depList)
bindSigSink ev sig sink = onEvent ev . withSample sig $ \i -> tellSink sink i
buildInput :: (FromJSON a, ToJSON a, Monad m, Functor m) =>
(PanelPath -> (a, sinks, Panel m))
-> (Event -> Signal typ a -> sinks -> Panel m -> Panel m)
-> Panel m
buildInput mkInput k = Panel onDraw onUpdate
where onDraw = newIdent >>= \i -> do
let (initial, inputs, control) = mkInput i
e = Event [i]
s = OneSig i
p = k e s inputs control
setEnv i initial
descended $ \ i' -> setDependenciesSig (printPath i') [i] <$> drawP p
onUpdate = newIdent >>= \i ->
let (_, inputs, control) = mkInput i
e = Event [i]
s = OneSig i
p = k e s inputs control
in descended $ const $ updateP p
button :: (Monad m, Functor m) => String -> (Event -> Panel m -> Panel m) -> Panel m
button txt k = buildInput mkButton kont
where kont e _s _i p = k e p
mkButton i = (
(),
(),
Panel (return $ PS htmlBit jsBit) (return [])
)
where htmlBit = H.button ! H.id (toValue ip) $ fromString txt
jsBit = [[jmacro|registerButton(`(ip)`);|]]
ip = printPath i
select :: (Monad m, Functor m, ToJSON a, FromJSON a) => (String, a) -> [(String, a)] -> (Event -> Signal typ a -> Panel m -> Panel m) -> Panel m
select defOpt options k = buildInput mkSelect kont
where kont evt sig _sink p = k evt sig p
mkSelect i = (
snd defOpt,
(),
Panel (return $ PS htmlBit jsBit) (return [])
)
where htmlBit = H.select ! H.id (toValue ip) $ mconcat $ map mkOption (defOpt : options)
mkOption (n,v) = H.option ! H.value (toValue . BS.unpack $ encode v) $ (fromString n)
jsBit = [[jmacro|registerSelect(`(ip)`);|]]
ip = printPath i
sampleIO :: (Monad m) => m a -> (a -> Panel m) -> Panel m
sampleIO act k = Panel onDraw onUpdate
where onDraw = drawP . k =<< lift act
onUpdate = updateP . k =<< lift act
bindEventIO :: (Monad m, Functor m) => Event -> m () -> Panel m
bindEventIO e act = onEvent e $ Panel (return mempty) (lift act >> return mempty)
selectInput :: (Monad m, Functor m, FromJSON a, ToJSON a) => (String, a) -> [(String,a)] -> (Event -> a -> Panel m -> Panel m) -> Panel m
selectInput defOpt opts k = select defOpt opts $ \e sig p -> withSample sig $ \i -> k e i p
textPane :: (Monad m, Functor m) => String -> (Event -> Signal typ String -> Sink typ m String -> Panel m -> Panel m) -> Panel m
textPane initial kont = buildInput mkInput kont
where mkInput i = (
initial,
input,
Panel (return $ PS htmlBit jsBit) (return [])
)
where htmlBit = H.input ! H.id (toValue ip) ! H.value (toValue initial)
jsBit = [[jmacro|registerInput(`(ip)`);|]]
ip = printPath i
input = PureSink [jmacroE|\x -> $("#"+`(ip)`).val(x)|]
newVar :: (Monad m, Functor m, ToJSON a, FromJSON a, ToJExpr a) => a -> (Event -> Signal typ a -> Sink typ m a -> Panel m -> Panel m) -> Panel m
newVar initial kont = buildInput mkInput kont
where mkInput i = (
initial,
input,
Panel (return $ PS htmlBit jsBit) (return [])
)
where htmlBit = H.input ! H.hidden (toValue True) ! H.id (toValue ip) ! H.value (toValue . BS.unpack $ encode initial)
jsBit = [[jmacro|registerInput(`(ip)`);|]]
ip = printPath i
input = PureSink [jmacroE|\x -> $("#"+`(ip)`).val(JSON.stringify(x))|]
inDiv :: (Monad m, Functor m) => [Panel m] -> Panel m
inDiv = onHtml H.div . mconcat
para :: (Monad m, Functor m) => String -> Panel m
para = plainHTML . H.p . fromString
mkTable :: (Monad m, Functor m) => Int -> [Panel m] -> Panel m
mkTable n xs = onHtml H.table . mconcat . map row $ chunksOf n xs
where row ys = onHtml H.tr . mconcat $ map (onHtml H.td) ys
panelPrelude :: JStat
panelPrelude = [jmacro|
fun setInsert set val { set[val] = true; return set; }
fun setInsertMany set newset {
for(var n in newset) {
set[n] = true;
}
return set;
}
fun setDeleteMany set newset {
for(var n in newset) {
delete set[n];
}
return set;
}
fun nullSet set {
for(k in set) {
return false;
}
return true;
}
fun setToList set {
var lst = [];
for(k in set) {
lst.push(k);
}
return lst;
}
fun insertMapSet ms k v {
if(typeof ms[k] == "undefined") {
ms[k] = {}
}
setInsert(ms[k],v);
return ms;
}
fun insertMapMap ms k k1 v {
if(typeof ms[k] == "undefined") {
ms[k] = {}
}
ms[k][k1] = v;
return ms;
}
// Map IDPath (Set IDPath)
// :: Map Event DependentSections
var !eventToDepsMap = {};
// Map Section DataRequired
// signalMap :: Map IDPath (Set IDPath)
var !sectToSigsMap = {};
// Map IDPath (Set IDPath)
var !listenerToParentDataMap = {};
// Map IDPath (Map IDPath (() -> IO ()))
var !eventToClientDepsMap = {};
// IDPath -> Set IDPath
fun subsetIDMapFromPfx pfx mp {
var pfl = pfx.length;
var res = {};
for (var idp in mp) {
if(idp.slice(0,pfl) == pfx) {
setInsertMany res mp[idp];
}
}
return res;
}
//
//
//
// IDPath -> Set IDPath
fun parentsIDMapFromPfx pfx mp {
var res = {};
for (var idp in mp) {
if(pfx.slice(0,idp.length) == idp) {
setInsertMany res mp[idp];
}
}
return res;
}
fun signalDepends listenerId signalId -> insertMapSet sectToSigsMap listenerId signalId;
//
fun eventDepends listenerId eventID {
insertMapSet eventToDepsMap eventID listenerId;
var parentDeps = parentsIDMapFromPfx listenerId sectToSigsMap;
var parentMap = {};
for(var p in parentDeps) {
parentMap[p] = $("#"+p).val();
}
listenerToParentDataMap[listenerId] = parentMap;
}
//
fun eventDependsPD listenerId eventId parentData {
insertMapSet eventToDepsMap eventId listenerId;
listenerToParentDataMap[listenerId] = parentData;
}
fun clientEventDepends listenerId eventId js {
insertMapMap eventToClientDepsMap eventId listenerId js;
}
fun invalidateRegion(uid) {
var pfl = uid.length;
var subSects = {};
setInsert subSects uid;
for(var sect in sectToSigsMap) {
if(sect.slice(0,pfl) == uid) {
setInsert subSects sect;
delete sectToSigsMap[sect];
}
}
//
for(var sect in sectToSigsMap) {
setDeleteMany sectToSigsMap[sect] subSects;
}
//
var subEvts = {};
setInsert subEvts uid;
for(var evt in eventToDepsMap) {
if(evt.slice(0,pfl) == uid) {
setInsert subEvts evt;
delete eventToDepsMap[evt];
}
}
//
for(var evt in eventToDepsMap) {
setDeleteMany eventToDepsMap[evt] subEvts;
}
//
for(var listener in listenerToParentDataMap) {
if(listener.slice(0,pfl) == uid) {
delete listener listenerToParentDataMap;
}
}
//
for(var evt in eventToClientDepsMap) {
if(evt.slice(0,pfl) == uid) {
eventToClientDepsMap[evt] = {};
}
for(var listener in eventToClientDepsMap[evt]) {
if(listener.slice(0,pfl) == uid) {
delete listener eventToClientDepsMap[evt];
}
}
}
}
fun executeUpdate(ups) {
for(var i in ups) {
var [uid,[upane,ujs]] = ups[i];
//
invalidateRegion(uid);
//
$("#"+uid).html(upane);
//
eval(ujs);
}
}
fun registerButton b -> $("#"+b).data("isButton",true);
fun registerSelect s -> $("#"+s).data("isSelect",true);
fun registerInput s -> $("#"+s).data("isTextInput",true);
fun fireEvent uid {
console.log("fireevent",uid);
//
var deps = eventToDepsMap[uid];
var depsExist = false;
//
var depDataMap = {};
//
var sectData = {};
for (var dep in deps) {
depsExist = true;
setInsertMany sectData (subsetIDMapFromPfx dep sectToSigsMap);
setInsertMany sectData (parentsIDMapFromPfx dep sectToSigsMap);
depDataMap[dep] = listenerToParentDataMap[dep];
}
//
var clientDeps = eventToClientDepsMap[uid] == null ? {} : eventToClientDepsMap[uid];
console.log("clientDeps",clientDeps);
for (var cdep in clientDeps) {
console.log("cdep",clientDeps[cdep]);
clientDeps[cdep]();
}
var envMap = {};
for(var s in sectData) {
envMap[s] = $("#"+s).val();
}
if(depsExist) {
executeUpdate (updateEvent(envMap,depDataMap,[uid]));
}
}
fun handleButton e {
var tg = $(e.target);
if(tg.data("isButton")) {
fireEvent(tg.attr("id"));
}
}
$("html").on("click", "button", handleButton);
fun handleSelect e {
var tg = $(e.target);
if(tg.data("isSelect")) {
fireEvent(tg.attr("id"));
}
}
$("html").on("change", "select", handleSelect);
fun handleInput e {
var tg = $(e.target);
if(tg.data("isTextInput")) {
fireEvent(tg.attr("id"));
}
}
$("html").on("change", "input", handleInput);
|]
type UpdateList = [(String, (String,String))]
panelToPageGen :: forall m resp. (Monad m, Functor m, ToJsonRPC (m (Either String UpdateList)) m) =>
([JsonRPC m ()] -> m resp)
-> (T.Text -> m resp)
-> Maybe String
-> String
-> Panel m
-> (m resp, m resp)
panelToPageGen serveRpcs returnResponse jqLoc title p = (updateHandler, drawHandler)
where drawHandler = do
dp <- runPanelDraw M.empty S.empty $ p
returnResponse $ T.renderHtml $ H.html $ do
H.head $ do
H5.title (fromString title)
H.script ! H.src (toValue $ fromMaybe "https://ajax.googleapis.com/ajax/libs/jquery/1.8.1/jquery.min.js" jqLoc) $ mempty
H.script . fromString . show . renderJs $ invokeRPCLib `mappend` rpcDecls `mappend` panelPrelude
H.script . fromString . show . renderJs . wrapJQuery . jsP $ dp
H.body . htmlP $ dp
wrapJQuery jm = [jmacroE|$(\ {`(jm)`;})|]
updateHandler = serveRpcs allRPCs
allRPCs = [updateRPC]
rpcDecls = mconcat $ map jsonRPCToDecl allRPCs
updateFun :: Map String BS.ByteString -> Map String (Map String BS.ByteString) -> Set String -> m (Either String UpdateList)
updateFun envMap listenerData eventSet = do
slices <- runPanelUpdateMany envMap listenerData eventSet p
return $ Right $ map (printPath *** renderPS) $ slices
renderPS ps = (P.renderHtml . htmlP $ ps,
show . renderJs . mconcat . jsP $ ps)
updateRPC :: JsonRPC m ()
updateRPC = toJsonRPC "updateEvent" $ \envMap depDataMap eventSet -> updateFun (M.map textToBS envMap) (M.map (M.map textToBS) depDataMap) eventSet
textToBS = BS.fromChunks . (:[]) . T.encodeUtf8
calcPanel :: (Monad m, Functor m) => Panel m
calcPanel = textPane "0" $ \_ displaysig displayInp displaypane ->
newVar "0" $ \_ storesig storeInp storepane ->
newVar "" $ \_ cmdstoresig cmdstoreInp cmdstorepane ->
let
trimJs = [jmacroE|\x {for(var i = 0; i<x.length;i++) {
if(x[i] != '0') { return x.substring(i,x.length)}
}
return 0;}|]
addDisplayInp = contramapJs [jmacroE|\x -> `(trimJs)` (`(sampleSigJs displaysig)` + x)|] displayInp
numButton val = button val $ \ e b -> b <> bindSigSink e (pureSig val) addDisplayInp
opButton val = button val $ \ e b -> b <> bindSigSink e (pureSig val) cmdstoreInp
<> bindSigSink e displaysig storeInp
<> bindSigSink e (pureSig "0") displayInp
clearButton = button "c" $ \ e b -> b <>
bindSigSink e (pureSig "0") storeInp <>
bindSigSink e (pureSig "0") displayInp <>
bindSigSink e (pureSig "") cmdstoreInp
equalButton = button "=" $ \ e b -> b <> onEvent e
(withSample cmdstoresig $ \cmdstoreval ->
withSample displaysig $ \dispval ->
withSample storesig $ \storeval ->
let execOp op = tellSink displayInp (show $ (read storeval :: Int) `op` (read dispval :: Int))
in case cmdstoreval of
"+" -> execOp (+)
"-" -> execOp (flip subtract)
"*" -> execOp (*)
"/" -> execOp (div)
_ -> mempty)
buttonPane = mkTable 3 $ map (numButton . show) ([(1::Int)..9] ++ [0]) ++ map opButton ["+","-","*","/"] ++ [equalButton,clearButton]
in
inDiv [displaypane <> storepane <> cmdstorepane,
buttonPane
]