fix all lazy data type warnings

WidgetRattus.cabal

@@ -57,7 +57,8 @@ library
                        hashtables >= 1.3.1 && < 1.4,
                        simple-affine-space >= 0.2.1 && < 0.3,
                        transformers >= 0.5.6 && < 0.7,
-                       template-haskell >= 2.17 && < 2.22
+                       template-haskell >= 2.17 && < 2.22,
+                       text
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -W

examples/gui/gui.cabal

@@ -10,6 +10,6 @@ build-type:          Simple
 executable gui
   hs-source-dirs:      src
   main-is:             GUI.hs
-  other-modules:       AsyncRattus.Widgets, Counter, TemperatureConverter, FlightBooker, Timer, Calculator
+  other-modules:       AsyncRattus.Widgets, AsyncRattus.Widgets.Types, Counter, TemperatureConverter, FlightBooker, Timer, Calculator
   default-language:    Haskell2010
-  build-depends:       WidgetRattus>=0.2, base, text, monomer, containers
+  build-depends:       WidgetRattus>=0.2, base, text, monomer, containers, deepseq

examples/gui/src/AsyncRattus/Widgets.hs

@@ -2,15 +2,14 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-{-# HLINT ignore "Use newtype instead of data" #-}
-{-# LANGUAGE InstanceSigs #-}
-{-# HLINT ignore "Use const" #-}
-{-# HLINT ignore "Use void" #-}
 
-module AsyncRattus.Widgets where
+
+module AsyncRattus.Widgets 
+(module AsyncRattus.Widgets.Types, module AsyncRattus.Widgets ) where
 
 import AsyncRattus
+import AsyncRattus.Widgets.Types
+import AsyncRattus.Plugin.Annotation
 import AsyncRattus.Signal
 import AsyncRattus.Channels ( chan, wait, C(C), Chan )
 import Data.Text
@@ -22,116 +21,14 @@ import Data.IntSet as IntSet
 
 import qualified Monomer
 
--- The Displayable typeclass is used to define the display function.
--- The display function is used to convert a datatype to Text.
-class Displayable a where
-      display :: a -> Text
-
 -- The identity function.
 instance Displayable Text where
-      display :: Text -> Text
       display x = x
 
 -- Convert Int to Text via String.
 instance Displayable Int where  
-      display x = pack (show x)
-
--- The IsWidget typeclass is used to define the mkWidget function.
-class Continuous a => IsWidget a where
-      mkWidget :: a -> Monomer.WidgetNode AppModel AppEvent
-
--- The AppModel datatype used to contain the Widget passed to runApplication. 
--- The associated clock is a set of timers. 
--- Any timers created with mkTimerEvent will be added to the clock.
-data AppModel where
-    AppModel :: IsWidget a => !a -> !Clock -> AppModel
-
--- Instance decleration for AppModel making it possible to
--- compare two AppModels.
-instance (Eq AppModel) where
-      (==) :: AppModel -> AppModel -> Bool
-      _ == _ = False
-
--- AppEvent data type used to convert channels into events.
-data AppEvent where
-      AppEvent :: !(Chan a) -> !a -> AppEvent
-
--- Coustom data types for widgets.
-data Widget where
-    Widget :: IsWidget a => !a -> !(Sig Bool) -> Widget
-
-data Button where
-    Button :: (Displayable a, Stable a) =>  {btnContent :: !(Sig a) , btnClick :: !(Chan ())} -> Button
-
-data TextField = TextField {tfContent :: !(Sig Text), tfInput :: !(Chan Text)} 
-
-data Label where
-      Label :: (Displayable a, Stable a) => {labText :: !(Sig a)} -> Label
-
-data HStack = HStack {hGrp :: !(Sig (List Widget))}
-
-data VStack = VStack {vGrp :: !(Sig (List Widget))}
-
-data TextDropdown = TextDropdown {tddCurr :: !(Sig Text), tddEvent :: !(Chan Text), tddList :: !(Sig (List Text))}
-
-data Popup = Popup {popCurr :: !(Sig Bool), popEvent :: !(Chan Bool), popChild :: !(Sig Widget)}
-
-data Slider = Slider {sldCurr :: !(Sig Int), sldEvent :: !(Chan Int), sldMin :: !(Sig Int), sldMax :: !(Sig Int)}
-
--- Template Haskell code for generating instances of Continous.
-continuous ''Button
-continuous ''TextField
-continuous ''Label
-continuous ''Widget
-continuous ''HStack
-continuous ''VStack
-continuous ''TextDropdown
-continuous ''Popup
-continuous ''Slider
-
--- isWidget Instance declerations for Widgets.
--- Here widgget data types are passed to Monomer constructors.
-instance IsWidget Button where
-      mkWidget :: Button -> Monomer.WidgetNode AppModel AppEvent
-      mkWidget Button{btnContent = txt ::: _ , btnClick = click} =
-            Monomer.button  (display txt) (AppEvent click ())
-
-instance IsWidget TextField where
-      mkWidget :: TextField -> Monomer.WidgetNode AppModel AppEvent
-      mkWidget TextField{tfContent = txt ::: _, tfInput = inp} = 
-            Monomer.textFieldV txt (AppEvent inp)
-
-instance IsWidget Label where
-      mkWidget :: Label -> Monomer.WidgetNode AppModel AppEvent
-      mkWidget Label{labText = txt ::: _} = Monomer.label (display txt)
-
-
-instance IsWidget HStack where
-      mkWidget :: HStack -> Monomer.WidgetNode AppModel AppEvent
-      mkWidget HStack{hGrp = ws} = Monomer.hstack (fmap mkWidget (current ws))
-
-instance IsWidget VStack where
-      mkWidget :: VStack -> Monomer.WidgetNode AppModel AppEvent
-      mkWidget VStack{vGrp = ws} = Monomer.vstack (fmap mkWidget (current ws))
-
-instance IsWidget TextDropdown where
-      mkWidget :: TextDropdown -> Monomer.WidgetNode AppModel AppEvent
-      mkWidget TextDropdown{tddList = opts ::: _, tddCurr = curr ::: _, tddEvent = ch}
-            = Monomer.textDropdownV curr (AppEvent ch) opts
-
-instance IsWidget Popup where
-      mkWidget :: Popup -> Monomer.WidgetNode AppModel AppEvent
-      mkWidget Popup{popCurr = curr ::: _, popEvent = ch, popChild = child}
-            = Monomer.popupV curr (AppEvent ch) (mkWidget (current child))
-
-instance IsWidget Slider where
-      mkWidget :: Slider -> Monomer.WidgetNode AppModel AppEvent
-      mkWidget Slider{sldCurr = curr ::: _, sldEvent = ch, sldMin = min ::: _, sldMax = max ::: _}
-            = Monomer.hsliderV curr (AppEvent ch) min max
+      display x = toText x
 
-instance IsWidget Widget where
-    mkWidget :: Widget -> Monomer.WidgetNode AppModel AppEvent
-    mkWidget (Widget w (e ::: _)) = Monomer.nodeEnabled (mkWidget w) e
 
 
 -- Function to construct a Widget that never gets disabled
@@ -236,6 +133,7 @@ mkTimerEvent n cb = (threadDelay n >> cb (AppEvent (Chan n) ())) >> return ()
 
 -- runApplication takes as input a widget and starts the GUI applicaiton
 -- by calling Monomer's startApp function.
+{-# ANN runApplication AllowLazyData #-}
 runApplication :: IsWidget a => C a -> IO ()
 runApplication (C w) = do
     w' <- w

examples/gui/src/AsyncRattus/Widgets/Types.hs

@@ -0,0 +1,109 @@
+
+{-# OPTIONS -fplugin=AsyncRattus.Plugin #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module AsyncRattus.Widgets.Types where
+
+import AsyncRattus
+import AsyncRattus.InternalPrimitives
+import AsyncRattus.Signal
+import AsyncRattus.Channels ( chan, wait, C(C), Chan )
+import Data.Text
+
+import qualified Monomer
+{-# ANN module AllowLazyData #-}
+
+-- The Displayable typeclass is used to define the display function.
+-- The display function is used to convert a datatype to Text.
+class Displayable a where
+      display :: a -> Text
+
+-- The AppModel datatype used to contain the Widget passed to runApplication. 
+-- The associated clock is a set of timers. 
+-- Any timers created with mkTimerEvent will be added to the clock.
+data AppModel where
+    AppModel :: IsWidget a => !a -> !Clock -> AppModel
+
+
+
+instance (Eq AppModel) where
+      _ == _ = False
+
+
+-- AppEvent data type used to convert channels into events.
+data AppEvent where
+      AppEvent :: !(Chan a) -> !a -> AppEvent
+
+-- The IsWidget typeclass is used to define the mkWidget function.
+class Continuous a => IsWidget a where
+      mkWidget :: a -> Monomer.WidgetNode AppModel AppEvent
+-- Coustom data types for widgets.
+data Widget where
+    Widget :: IsWidget a => !a -> !(Sig Bool) -> Widget
+
+data HStack = HStack {hGrp :: !(Sig (List Widget))}
+
+data VStack = VStack {vGrp :: !(Sig (List Widget))}
+
+data TextDropdown = TextDropdown {tddCurr :: !(Sig Text), tddEvent :: !(Chan Text), tddList :: !(Sig (List Text))}
+
+data Popup = Popup {popCurr :: !(Sig Bool), popEvent :: !(Chan Bool), popChild :: !(Sig Widget)}
+
+data Slider = Slider {sldCurr :: !(Sig Int), sldEvent :: !(Chan Int), sldMin :: !(Sig Int), sldMax :: !(Sig Int)}
+
+data Button where
+    Button :: (Displayable a, Stable a) =>  {btnContent :: !(Sig a) , btnClick :: !(Chan ())} -> Button
+
+
+data Label where
+      Label :: (Displayable a, Stable a) => {labText :: !(Sig a)} -> Label
+
+data TextField = TextField {tfContent :: !(Sig Text), tfInput :: !(Chan Text)} 
+
+-- Template Haskell code for generating instances of Continous.
+continuous ''Button
+continuous ''TextField
+continuous ''Label
+continuous ''Widget
+continuous ''HStack
+continuous ''VStack
+continuous ''TextDropdown
+continuous ''Popup
+continuous ''Slider
+
+-- isWidget Instance declerations for Widgets.
+-- Here widgget data types are passed to Monomer constructors.
+instance IsWidget Button where
+      mkWidget Button{btnContent = txt ::: _ , btnClick = click} =
+            Monomer.button  (display txt) (AppEvent click ())
+
+instance IsWidget TextField where
+      mkWidget TextField{tfContent = txt ::: _, tfInput = inp} = 
+            Monomer.textFieldV txt (AppEvent inp)
+
+instance IsWidget Label where
+      mkWidget Label{labText = txt ::: _} = Monomer.label (display txt)
+
+
+instance IsWidget HStack where
+      mkWidget HStack{hGrp = ws} = Monomer.hstack (fmap mkWidget (current ws))
+
+instance IsWidget VStack where
+      mkWidget VStack{vGrp = ws} = Monomer.vstack (fmap mkWidget (current ws))
+
+instance IsWidget TextDropdown where
+      mkWidget TextDropdown{tddList = opts ::: _, tddCurr = curr ::: _, tddEvent = ch}
+            = Monomer.textDropdownV curr (AppEvent ch) opts
+
+instance IsWidget Popup where
+      mkWidget Popup{popCurr = curr ::: _, popEvent = ch, popChild = child}
+            = Monomer.popupV curr (AppEvent ch) (mkWidget (current child))
+
+instance IsWidget Slider where
+      mkWidget Slider{sldCurr = curr ::: _, sldEvent = ch, sldMin = min ::: _, sldMax = max ::: _}
+            = Monomer.hsliderV curr (AppEvent ch) min max
+
+instance IsWidget Widget where
+    mkWidget (Widget w (e ::: _)) = Monomer.nodeEnabled (mkWidget w) e

examples/gui/src/Calculator.hs

@@ -16,7 +16,7 @@ import Control.Concurrent ( forkIO )
 import Control.Monad
 import Prelude hiding (map, const, zipWith, zip, filter, getLine, putStrLn,null)
 import Data.Text.IO
-import Data.Text hiding (filter, map, all)
+import Data.Text hiding (filter, map, all, foldl1)
 import qualified AsyncRattus.Widgets
 import Data.Text.Array (equal)
 import Monomer.Common.Lens (HasY(y), HasX (x))
@@ -60,8 +60,8 @@ calc = do
             mapAwait (box (\ _ _ -> 0))
             (interleave (box (\ a b -> a)) (interleave (box (\ a b -> a)) (btnOnClickSig addBut) (btnOnClickSig subBut)) (btnOnClickSig eqBut))
 
-    let sigList = [onclick0, onclick1, onclick2, onclick3, onclick4, onclick5, onclick6, onclick7, onclick8, onclick9, resetSig] :: [O (Sig (Int->Int))]
-    let combinedSig = Prelude.foldl1 (interleave (box (\ a b -> a))) sigList
+    let sigList = [onclick0, onclick1, onclick2, onclick3, onclick4, onclick5, onclick6, onclick7, onclick8, onclick9, resetSig] :: List (O (Sig (Int->Int)))
+    let combinedSig = foldl1 (interleave (box (\ a b -> a))) sigList
 
     let numberSig = scanAwait (box (\ a f-> f a)) 0 combinedSig
     let bufferedSig = buffer 0 numberSig

examples/gui/src/FlightBooker.hs

@@ -14,48 +14,48 @@ import Control.Concurrent ( forkIO )
 import Control.Monad
 import Prelude hiding (map, const, zipWith, zip, filter, getLine, putStrLn,null)
 import Data.Text.IO
-import Data.Text hiding (filter, map, all)
 import qualified Data.Text as Text
 import Data.Text (Text, unpack, splitOn)
 import Text.Read (readMaybe)
 import Data.Maybe (isNothing, isJust)
+import Control.DeepSeq
 
 -- Benchmark 3
 isDate :: Text -> Bool
-isDate txt = case splitOn "-" txt of
+isDate txt = case splitOn' "-" txt of
   [dayStr, monthStr, yearStr] ->
-    let day = readMaybe (unpack dayStr) :: Maybe Int
-        month = readMaybe (unpack monthStr) :: Maybe Int
-        year = readMaybe (unpack yearStr) :: Maybe Int
+    let day = readMaybe' dayStr
+        month = readMaybe' monthStr
+        year = readMaybe' yearStr
     in isValid day month year
   _ -> False
   where
-    isValid :: Maybe Int -> Maybe Int -> Maybe Int -> Bool
-    isValid (Just d) (Just m) (Just y)
+    isValid :: Maybe' Int -> Maybe' Int -> Maybe' Int -> Bool
+    isValid (Just' d) (Just' m) (Just' y)
       | m < 1 || m > 12 = False
       | d < 1 || d > daysInMonth m y = False
       | otherwise = True
     isValid _ _ _ = False
 
     daysInMonth :: Int -> Int -> Int
     daysInMonth m y
-        | m `Prelude.elem` ([4, 6, 9, 11] :: [Int]) = 30
+        | m `elem` ([4, 6, 9, 11] :: List Int) = 30
         | m == 2 = if isLeapYear y then 29 else 28
         | otherwise = 31
 
     isLeapYear :: Int -> Bool
     isLeapYear y = y `mod` 4 == 0 && (y `mod` 100 /= 0 || y `mod` 400 == 0)
 
 isLater :: Text -> Text -> Bool
-isLater dep ret = case (splitOn "-" dep, splitOn "-" ret) of
+isLater dep ret = case (splitOn' "-" dep, splitOn' "-" ret) of
   ([depDayStr, depMonthStr, depYearStr], [retDayStr, retMonthStr, retYearStr]) ->
-    let depDay = readMaybe (unpack depDayStr) :: Maybe Int
-        depMonth = readMaybe (unpack depMonthStr) :: Maybe Int
-        depYear = readMaybe (unpack depYearStr) :: Maybe Int
-        retDay = readMaybe (unpack retDayStr) :: Maybe Int
-        retMonth = readMaybe (unpack retMonthStr) :: Maybe Int
-        retYear = readMaybe (unpack retYearStr) :: Maybe Int
-    in all isJust ([depDay, depMonth, depYear, retDay, retMonth, retYear] :: [Maybe Int]) &&
+    let depDay = readMaybe' depDayStr
+        depMonth = readMaybe' depMonthStr
+        depYear = readMaybe' depYearStr
+        retDay = readMaybe' retDayStr
+        retMonth = readMaybe' retMonthStr
+        retYear = readMaybe' retYearStr
+    in all isJust' ([depDay, depMonth, depYear, retDay, retMonth, retYear] :: List (Maybe' Int)) &&
        (depYear < retYear ||
        (depYear == retYear && (depMonth < retMonth ||
        (depMonth == retMonth && depDay < retDay))))

examples/gui/src/TemperatureConverter.hs

@@ -24,13 +24,13 @@ import GHC.TypeError (ErrorMessage(Text))
 celsiusToFahrenheit :: Text -> Text
 celsiusToFahrenheit t =
         case signed decimal t of
-            Right (t', _) -> pack $ show (t' * 9 `div` 5 + 32)
+            Right (t', _) -> toText (t' * 9 `div` 5 + 32)
             Left _ -> "Invalid input"
 
 fahrenheitToCelsius :: Text -> Text
 fahrenheitToCelsius t =
     case signed decimal t of
-        Right (t', _) -> pack $ show ((t' - 32) * 5 `div` 9)
+        Right (t', _) -> toText ((t' - 32) * 5 `div` 9)
         Left _ -> "Invalid input"
 
 -- Initial version of benchmark 2.