clean up gui examples

examples/gui/src/Calculator.hs

@@ -1,42 +1,26 @@
+{-# OPTIONS -fplugin=WidgetRattus.Plugin #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE OverloadedLists #-}
-{-# OPTIONS -fplugin=WidgetRattus.Plugin #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-{-# HLINT ignore "Evaluate" #-}
-{-# HLINT ignore "Use const" #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 import WidgetRattus
 import WidgetRattus.Signal
 import WidgetRattus.Widgets
 import Prelude hiding (map, const, zipWith, zip, filter, getLine, putStrLn,null)
-import Data.Text hiding (filter, map, all, foldl1)
-
+import Data.Text (Text)
 
+nums :: List Int
+nums = [0..9]
 
 window :: C VStack
 window = do
-    zero <- mkButton (const ("0" ::Text))
-    one <- mkButton (const ("1" ::Text))
-    two <- mkButton (const ("2" ::Text))
-    three <- mkButton (const ("3" ::Text))
-    four <- mkButton (const ("4" ::Text))
-    five <- mkButton (const ("5" ::Text))
-    six <- mkButton (const ("6" ::Text))
-    seven <- mkButton (const ("7" ::Text))
-    eight <- mkButton (const ("8" ::Text))
-    nine <- mkButton (const ("9" ::Text))
-
-    let onclick0 = mapAwait (box (\ _ x -> x * 10)) (btnOnClickSig zero)
-    let onclick1 = mapAwait (box (\ _ x -> x * 10 + 1)) (btnOnClickSig one)
-    let onclick2 = mapAwait (box (\ _ x -> x * 10 + 2)) (btnOnClickSig two)
-    let onclick3 = mapAwait (box (\ _ x -> x * 10 + 3)) (btnOnClickSig three)
-    let onclick4 = mapAwait (box (\ _ x -> x * 10 + 4)) (btnOnClickSig four)
-    let onclick5 = mapAwait (box (\ _ x -> x * 10 + 5)) (btnOnClickSig five)
-    let onclick6 = mapAwait (box (\ _ x -> x * 10 + 6)) (btnOnClickSig six)
-    let onclick7 = mapAwait (box (\ _ x -> x * 10 + 7)) (btnOnClickSig seven)
-    let onclick8 = mapAwait (box (\ _ x -> x * 10 + 8)) (btnOnClickSig eight)
-    let onclick9 = mapAwait (box (\ _ x -> x * 10 + 9)) (btnOnClickSig nine)
+    numBtns :: List Button  
+        <- mapM (mkButton . const) nums
+
+    let numClicks :: List (O (Sig (Int -> Int))) 
+          = zipWith' (\b n -> mapAwait (box (\ _ x -> x * 10 + n)) (btnOnClickSig b)) numBtns nums
+
+    let [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9] = numBtns
 
     addBut <- mkButton (const ("+"::Text))
     subBut <- mkButton (const ("-"::Text))
@@ -46,7 +30,7 @@ window = do
             mapAwait (box (\ _ _ -> 0))
             (interleave (box (\ a _ -> a)) (interleave (box (\ a _ -> a)) (btnOnClickSig addBut) (btnOnClickSig subBut)) (btnOnClickSig eqBut))
 
-    let sigList = [onclick0, onclick1, onclick2, onclick3, onclick4, onclick5, onclick6, onclick7, onclick8, onclick9, resetSig] :: List (O (Sig (Int->Int)))
+    let sigList = resetSig :! numClicks :: List (O (Sig (Int->Int)))
     let combinedSig = foldl1 (interleave (box (\ a _ -> a))) sigList
 
     let numberSig = scanAwait (box (\ a f-> f a)) 0 combinedSig
@@ -58,7 +42,7 @@ window = do
 
     let calcSig = triggerStable (box (\ op x -> box (unbox op x))) (box (0 +)) opSig bufferedSig
 
-    let resultSig = WidgetRattus.Signal.zipWith (box (\ f x -> unbox f x)) calcSig bufferedSig
+    let resultSig = zipWith (box (\ f x -> unbox f x)) calcSig bufferedSig
 
     let eqSig = triggerStable (box (\ _ x -> x)) 0 (btnOnClickSig eqBut) resultSig
 
@@ -69,12 +53,12 @@ window = do
 
     result <- mkLabel displaySig
 
-    operators <- mkHStack (const [enabledWidget addBut, enabledWidget subBut, enabledWidget eqBut])
-    firstRow <- mkHStack (const [enabledWidget seven, enabledWidget eight, enabledWidget nine])
-    secondRow <- mkHStack (const [enabledWidget four, enabledWidget five, enabledWidget six])
-    thirdRow <- mkHStack (const [enabledWidget one, enabledWidget two, enabledWidget three])
-    fourthRow <- mkHStack (const [enabledWidget zero])
-    numbers <- mkVStack (const [enabledWidget firstRow, enabledWidget secondRow, enabledWidget thirdRow, enabledWidget fourthRow])
+    operators <- mkHStack (const [addBut, subBut, eqBut])
+    row1 <- mkHStack (const [b7, b8, b9])
+    row2 <- mkHStack (const [b4, b5, b6])
+    row3 <- mkHStack (const [b1, b2, b3])
+    row4 <- mkHStack (const [b0])
+    numbers <- mkVStack (const [row1, row2 , row3, row4])
 
     input <- mkHStack (const [enabledWidget numbers, enabledWidget operators])
 

examples/gui/src/FlightBooker.hs

@@ -8,7 +8,7 @@
 import WidgetRattus
 import WidgetRattus.Signal
 import WidgetRattus.Widgets
-import Prelude hiding (map, const, zipWith, zip, filter, getLine, putStrLn,null)
+import Prelude hiding (map, const, zipWith, zipWith3, zip, filter, getLine, putStrLn,null)
 import Data.Text (Text)
 
 -- Benchmark 3
@@ -67,7 +67,7 @@ window = do
     let isRF = map (box (== "Return-Flight")) (tddCurr dropDown)
     let isOW = map (box (== "One-Way")) (tddCurr dropDown)
 
-    let labelSig = WidgetRattus.Signal.zipWith3 (box bookingToText) isOW (tfContent tf1) (tfContent tf2)
+    let labelSig = zipWith3 (box bookingToText) isOW (tfContent tf1) (tfContent tf2)
 
     let sig = scanAwait (box (\ _ _ -> True )) False (btnOnClickSig button)
 
@@ -76,11 +76,11 @@ window = do
     popup <- mkPopup sig (const (enabledWidget label))
 
     let tf1IsDate = map (box isDate) (tfContent tf1)
-    let tf1IsLater = WidgetRattus.Signal.zipWith (box isLater) (tfContent tf1) (tfContent tf2)
+    let tf1IsLater = zipWith (box isLater) (tfContent tf1) (tfContent tf2)
 
-    let oneWayAndDate = WidgetRattus.Signal.zipWith (box (&&)) isOW tf1IsDate
-    let returnFlightAndIsLater = WidgetRattus.Signal.zipWith (box (&&)) isRF tf1IsLater
-    let validBooking = WidgetRattus.Signal.zipWith (box (||)) oneWayAndDate returnFlightAndIsLater
+    let oneWayAndDate = zipWith (box (&&)) isOW tf1IsDate
+    let returnFlightAndIsLater = zipWith (box (&&)) isRF tf1IsLater
+    let validBooking = zipWith (box (||)) oneWayAndDate returnFlightAndIsLater
 
     mkVStack (const
         [enabledWidget popup, enabledWidget dropDown,

examples/gui/src/TemperatureConverter.hs

@@ -43,7 +43,7 @@ window = do
 
     fStack <- mkVStack (const [enabledWidget tfF2, enabledWidget fLabel])
     cStack <- mkVStack (const [enabledWidget tfC2, enabledWidget cLabel])  
-    mkHStack (const [enabledWidget fStack, enabledWidget cStack])          
+    mkHStack (const [fStack, cStack])          
 
 
 main :: IO ()

examples/gui/src/Timer.hs

@@ -40,7 +40,7 @@ second (_ :* y) = y
 window :: C VStack
 window = do
     slider <- mkSlider 50 (const 1) (const 100)
-    resetBtn <- mkButton (const  (pack "Reset"))
+    resetBtn <- mkButton (const ("Reset" :: Text))
 
     let resSig = mkSig (btnOnClick resetBtn)
     let resetSig = mapAwait (box (\ _ -> reset)) resSig

src/WidgetRattus/Plugin/Utils.hs

@@ -297,13 +297,14 @@ isStrictRec d pr t = do
   let pr' = Set.insert (TC t) pr
   let (_,t') = splitForAllTys' t
   let (c, tys) = repSplitAppTys t'
-  if isJust (getTyVar_maybe c) then and (map (isStrictRec (d+1) pr') tys)
+  if isJust (getTyVar_maybe c) then all (isStrictRec (d+1) pr') tys
   else  case splitTyConApp_maybe t' of
     Nothing -> isJust (getTyVar_maybe t)
     Just (con,args) ->
       case getNameModule con of
         Nothing -> False
         Just (name,mod)
+          | (mod == "GHC.Internal.IsList" || mod == "GHC.IsList") && name == "Item" -> all (isStrictRec (d+1) pr') args
           | mod == "GHC.Num.Integer" && name == "Integer" -> True
           | mod == "Data.Text.Internal" && name == "Text" -> True
           | mod == "GHC.IORef" && name == "IORef" -> True
@@ -321,10 +322,10 @@ isStrictRec d pr t = do
               DataTyCon {data_cons = cons, is_enum = enum}
                 | enum -> True
                 | all hasStrictArgs cons ->
-                  and  (map check cons)
+                  all check cons
                 | otherwise -> False
                 where check con = case dataConInstSig con args of
-                        (_, _,tys) -> and (map (isStrictRec (d+1) pr') tys)
+                        (_, _,tys) -> all (isStrictRec (d+1) pr') tys
               TupleTyCon {} -> null args
               NewTyCon {nt_rhs = ty} -> isStrictRec (d+1) pr' ty
               _ -> False

src/WidgetRattus/Widgets.hs

@@ -48,13 +48,13 @@ mkLabel :: (Displayable a, Stable a) => Sig a -> C Label
 mkLabel t = do
       return Label{labText = t}
 
-mkHStack :: Sig(List Widget) -> C HStack
+mkHStack :: IsWidget a => Sig(List a) -> C HStack
 mkHStack wl = do
-      return HStack{hGrp = wl}
+      return (HStack wl)
 
-mkVStack :: Sig(List Widget) -> C VStack
+mkVStack :: IsWidget a => Sig(List a) -> C VStack
 mkVStack wl = do
-      return VStack{vGrp = wl}
+      return (VStack wl)
 
 mkTextDropdown :: Sig (List Text) -> Text -> C TextDropdown
 mkTextDropdown opts init = do

src/WidgetRattus/Widgets/Types.hs

@@ -2,7 +2,7 @@
 {-# OPTIONS -fplugin=WidgetRattus.Plugin #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE OverloadedStrings #-}
+
 
 module WidgetRattus.Widgets.Types where
 
@@ -42,9 +42,11 @@ class Continuous a => IsWidget a where
 data Widget where
     Widget :: IsWidget a => !a -> !(Sig Bool) -> Widget
 
-data HStack = HStack {hGrp :: !(Sig (List Widget))}
+data HStack where 
+      HStack :: IsWidget a => !(Sig (List a)) -> HStack
 
-data VStack = VStack {vGrp :: !(Sig (List Widget))}
+data VStack where 
+      VStack :: IsWidget a => !(Sig (List a)) -> VStack
 
 data TextDropdown = TextDropdown {tddCurr :: !(Sig Text), tddEvent :: !(Chan Text), tddList :: !(Sig (List Text))}
 
@@ -87,10 +89,10 @@ instance IsWidget Label where
 
 
 instance IsWidget HStack where
-      mkWidget HStack{hGrp = ws} = Monomer.hstack (fmap mkWidget (current ws))
+      mkWidget (HStack ws) = Monomer.hstack (fmap mkWidget (current ws))
 
 instance IsWidget VStack where
-      mkWidget VStack{vGrp = ws} = Monomer.vstack (fmap mkWidget (current ws))
+      mkWidget (VStack ws) = Monomer.vstack (fmap mkWidget (current ws))
 
 instance IsWidget TextDropdown where
       mkWidget TextDropdown{tddList = opts ::: _, tddCurr = curr ::: _, tddEvent = ch}