warning cleanup

Author: minimapletinytools

potato_flow

@@ -2,7 +2,6 @@ module Potato.Flow.Vty.AppKbCmd where
 
 import           Relude
 
-import           Potato.Flow
 import           Potato.Reflex.Vty.Helpers
 
 import           Reflex

src/Potato/Flow/Vty/AppKbCmd.hs

@@ -11,18 +11,10 @@ module Potato.Flow.Vty.Canvas (
 import           Relude
 
 import           Potato.Flow
-import           Potato.Flow.Controller
-import           Potato.Flow.Controller.Handler
-import           Potato.Flow.Math
 import           Potato.Flow.Vty.Input
 import           Potato.Reflex.Vty.Helpers
-import           Potato.Reflex.Vty.Widget
-import           Reflex.Potato.Helpers
 import Potato.Flow.Vty.PotatoReader
 
-import           Control.Lens
-import qualified Data.IntMap.Strict             as IM
-import           Data.These
 import qualified Data.Text as T
 import qualified Data.List.Index as L
 import Data.Tuple.Extra (thd3)
@@ -34,7 +26,7 @@ import           Reflex.Vty
 
 -- alternative text rendering methods that don't show spaces
 textNoRenderSpaces
-  :: (Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m)
+  :: (HasDisplayRegion t m, HasImageWriter t m, HasTheme t m)
   => Behavior t Text
   -> m ()
 textNoRenderSpaces t = do
@@ -54,19 +46,14 @@ textNoRenderSpaces t = do
             (x,n):xs -> (0, (c:x,n):xs)
             -- first character case
             [] -> (0, [([c], 0)])
-    makeimages theme =
+    makeimages th =
       -- (\x -> traceShow (length x) x) .
       join
       . L.imap (\i -> fmap (V.translateY i)) -- for each line, offset the image vertically
-      . fmap (fmap (\(t,offset) -> V.translateX offset $  V.string theme (reverse t))) -- for each chunk and offset, convert to image
+      . fmap (fmap (\(txt,offset) -> V.translateX offset $  V.string th (reverse txt))) -- for each chunk and offset, convert to image
       . fmap (thd3 . foldl' foldlinefn (0,0,[]) . T.unpack) -- for each line, split into chunks with offset
       . T.split (=='\n') -- split into lines
 
-
--- TODO this needs to come from Potato.Flow
-defaultCanvasLBox :: LBox
-defaultCanvasLBox = LBox (V2 0 0) (V2 100 50)
-
 lBox_to_region :: LBox -> Region
 lBox_to_region (LBox (V2 x y) (V2 w h)) = Region x y w h
 
@@ -76,11 +63,13 @@ region_to_lBox (Region x y w h) = (LBox (V2 x y) (V2 w h))
 dynLBox_to_dynRegion :: (Reflex t) => Dynamic t LBox -> Dynamic t Region
 dynLBox_to_dynRegion dlb = ffor dlb $ lBox_to_region
 
+{- DELETE ME
 translate_dynRegion :: (Reflex t) => Dynamic t XY -> Dynamic t Region -> Dynamic t Region
 translate_dynRegion dpos dr = ffor2 dpos dr $ \(V2 x y) region -> region {
     _region_left = _region_left region + x
     , _region_top = _region_top region + y
   }
+-}
 
 pan_lBox :: XY -> LBox -> LBox
 pan_lBox pan (LBox p s) = LBox (p+pan) s
@@ -144,6 +133,7 @@ holdCanvasWidget CanvasWidgetConfig {..} = mdo
   localTheme (const (fmap _potatoStyle_softSelected potatostylebeh)) $ do
     fill (constant ' ')
     simpleList oobRegions renderRegion
+    return ()
 
   -- 2. render the canvas region
   renderRegion trueRegion
@@ -152,6 +142,7 @@ holdCanvasWidget CanvasWidgetConfig {..} = mdo
   -- TODO use correct theme
   localTheme (const (fmap _potatoStyle_selected potatostylebeh)) $ do
     textNoRenderSpaces . current . ffor3 _canvasWidgetConfig_pan screenRegion _canvasWidgetConfig_renderedSelection $ debugRenderRegionFn
+    return ()
 
 
 

src/Potato/Flow/Vty/Canvas.hs

@@ -13,9 +13,7 @@ module Potato.Flow.Vty.Common (
 import           Relude
 import qualified Relude.Unsafe               as Unsafe
 
-import           Potato.Flow.Controller
 import           Potato.Flow.Vty.Attrs
-import           Potato.Reflex.Vty.Helpers
 import Potato.Reflex.Vty.Widget
 
 import           Control.Monad.Fix
@@ -29,6 +27,8 @@ import           Reflex
 import           Reflex.Vty
 
 
+
+
 ffilterButtonIndex :: (Reflex t) => Int -> Event t Int -> Event t ()
 ffilterButtonIndex i = fmapMaybe (\i' -> if i == i' then Just () else Nothing)
 
@@ -39,14 +39,14 @@ maximumlist = foldr (\x y ->if x >= y then x else y) (-1)
 simpleDrag :: (Reflex t, MonadHold t m, MonadFix m, HasInput t m) => V.Button -> m (Event t ((Int, Int), (Int, Int)))
 simpleDrag btn = do
   dragEv <- drag2 btn
-  return $ flip push dragEv $ \d@(Drag2 (fromX, fromY) (toX, toY) _ mods ds) -> do
+  return $ flip push dragEv $ \(Drag2 (fromX, fromY) (toX, toY) _ _ ds) -> do
     return $ if ds == DragEnd
       then Just $ ((fromX, fromY), (toX, toY))
       else Nothing
 
 
 -- | option to pass in height is a hack to work around circular dependency issues as when using Layout, displayWidth may be dependent on returned dynamic height
-buttonList :: forall t m. (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasTheme t m)
+buttonList :: forall t m. (MonadFix m, MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasTheme t m)
   => Dynamic t [Text] -- ^ list of button contents
   -> Maybe (Dynamic t Int) -- ^ optional width (displayWidth is used if Nothing)
   -> m (Event t Int, Dynamic t Int) -- ^ (event when button is clicked, height)
@@ -129,7 +129,7 @@ radioListSimple :: forall t m. (Reflex t, MonadFix m, MonadHold t m, MonadNodeId
   -> m (Dynamic t Int) -- ^ which radio is selected
 radioListSimple initial buttons = mdo
   (radioEvs,_) <- radioList (constDyn buttons) radioDyn Nothing
-  radioDyn <- holdDyn [0] $ fmap (\x->[x]) radioEvs
+  radioDyn <- holdDyn [initial] $ fmap (\x->[x]) radioEvs
   return $ fmap (Unsafe.head) radioDyn
 
 
@@ -138,7 +138,7 @@ radioListSimple initial buttons = mdo
 -- | creates a check box "[x]" in upper left corner of region
 -- override style: does not modify state internally, instead state must be passed back in
 checkBox
-  :: forall t m. (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasTheme t m)
+  :: forall t m. (Reflex t, MonadFix m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasTheme t m)
   => Dynamic t Bool
   -> m (Event t Bool)
 checkBox stateDyn = do

src/Potato/Flow/Vty/Common.hs

@@ -10,15 +10,8 @@ module Potato.Flow.Vty.Info (
 import           Relude
 
 import           Potato.Flow
-import           Potato.Flow.Vty.Common
 import           Potato.Reflex.Vty.Helpers
 
-import           Control.Monad.Fix
-import           Control.Monad.NodeId
-import qualified Data.Sequence                     as Seq
-import qualified Data.Text                         as T
-
-import qualified Graphics.Vty                      as V
 import           Reflex
 import           Reflex.Network
 import           Reflex.Vty

src/Potato/Flow/Vty/Info.hs

@@ -11,18 +11,13 @@ module Potato.Flow.Vty.Tools (
 import           Relude
 
 import           Potato.Flow.Controller
-import           Potato.Flow.Vty.Attrs
 import           Potato.Flow.Vty.Common
 import           Potato.Reflex.Vty.Helpers
 
 import           Control.Monad.Fix
 import           Control.Monad.NodeId
-import qualified Data.List.Index                    as L
-import qualified Data.Text                          as T
 
-import qualified Graphics.Vty                       as V
 import           Reflex
-import           Reflex.Vty
 
 
 data ToolWidgetConfig t = ToolWidgetConfig {
@@ -36,11 +31,11 @@ data ToolWidget t = ToolWidget {
 }
 
 
-onlyIfBeh :: (Reflex t) => Event t a -> Behavior t Bool -> Event t a
-onlyIfBeh ev beh = fmapMaybe (\(b,e) -> if b then Just e else Nothing) $ attach beh ev
+--onlyIfBeh :: (Reflex t) => Event t a -> Behavior t Bool -> Event t a
+--onlyIfBeh ev beh = fmapMaybe (\(b,e) -> if b then Just e else Nothing) $ attach beh ev
 
 
-holdToolsWidget :: forall t m. (PostBuild t m, MonadHold t m, MonadFix m, MonadNodeId m, MonadWidget t m)
+holdToolsWidget :: forall t m. (PostBuild t m, MonadWidget t m)
   => ToolWidgetConfig t
   -> m (ToolWidget t)
 holdToolsWidget ToolWidgetConfig {..} = mdo
@@ -55,16 +50,6 @@ holdToolsWidget ToolWidgetConfig {..} = mdo
     textareaB = void $ ffilter (==5) radioEvs
 
   let
-    -- TODO DELETE, we don't do key press anymore
-    {-
-    allowKB = constant True
-    keyPressEv' k = (flip fmapMaybe) (_pFWidgetCtx_ev_input _toolWidgetConfig_pfctx) $ \case
-      V.EvKey (V.KChar k') [] | k' == k -> Just ()
-      _ -> Nothing
-    keyPressEv k = onlyIfBeh (keyPressEv' k) allowKB
-    -}
-    keyPressEv k = never
-
     setTool = leftmost
       [Tool_Select <$ leftmost [selectB]
       , Tool_Pan <$ leftmost [panB]

src/Potato/Flow/Vty/Tools.hs

@@ -49,24 +49,24 @@ type MonadWidget t m = (Reflex t, MonadHold t m, MonadFix m, NotReady t m, Adjus
 
 type MonadLayoutWidget t m = (MonadWidget t m, HasFocus t m, HasLayout t m)
 
-debugFocus :: (Reflex t, Monad m, HasFocusReader t m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => m ()
+debugFocus :: (HasFocusReader t m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => m ()
 debugFocus = do
   f <- focus
   text $ T.pack . show <$> current f
 
-debugInput :: (Reflex t, MonadHold t m, HasInput t m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => m ()
+debugInput :: (MonadHold t m, HasInput t m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => m ()
 debugInput = do
   lastEvent <- hold "No event yet" . fmap show =<< input
   text $ T.pack <$> lastEvent
 
-debugSize ::  (Reflex t, MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => m ()
+debugSize ::  (MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => m ()
 debugSize = do
   ldw <- displayWidth
   ldh <- displayHeight
   let combine w h = "w: " <> show w <> " h: " <> show h
   text $ liftA2 combine (current ldw) (current ldh)
 
-dragTest :: (Reflex t, MonadHold t m, MonadFix m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasTheme t m) => m ()
+dragTest :: (MonadHold t m, MonadFix m, HasDisplayRegion t m, HasImageWriter t m, HasInput t m, HasTheme t m) => m ()
 dragTest = do
   lastEvent <- hold "No event yet" . fmap show =<< drag V.BLeft
   text $ T.pack <$> lastEvent
@@ -78,12 +78,12 @@ fmapLabelShow :: (Functor f, Show a) => Text -> f a -> f Text
 fmapLabelShow t = fmap (\x -> t <> ": " <> show x)
 
 -- TODO rename to debugStreamEv
-debugStream :: (Reflex t, MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => [Event t Text] -> m ()
+debugStream :: (MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => [Event t Text] -> m ()
 debugStream evs = do
   t <- holdDyn "" $ mergeWith (\a b -> a <> "\n" <> b) evs
   richText richTextConfig_simpleForeColorAttr (current t)
 
-debugStreamBeh :: (Reflex t, MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => [Behavior t Text] -> m ()
+debugStreamBeh :: (MonadHold t m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => [Behavior t Text] -> m ()
 debugStreamBeh behs = text $ foldr (liftA2 (\t1 t2 -> t1 <> " " <> t2)) "" behs
 
 countEv :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Dynamic t Int)

src/Potato/Reflex/Vty/Helpers.hs

@@ -27,14 +27,10 @@ module Potato.Reflex.Vty.Widget
 
 import           Prelude
 
-import           Control.Applicative  (liftA2)
-import           Graphics.Vty         (Image)
 import qualified Graphics.Vty         as V
 
 import           Reflex
 import           Reflex.Class         ()
-import           Reflex.Host.Class    (MonadReflexCreateTrigger)
-import           Reflex.Vty.Host
 import           Reflex.Vty.Widget
 import           Reflex.Vty.Widget.Input.Mouse
 
@@ -62,7 +58,7 @@ singleClick btn = do
     withinBounds (Drag2 (fromX, fromY) (toX, toY) _ _ _) = fromX == toX && fromY == toY
   dragEv <- drag2 btn
   didStayOnDyn <- foldDyn (const . withinBounds) False dragEv
-  return $ flip push dragEv $ \d@(Drag2 (fromX, fromY) (toX, toY) _ mods ds) -> do
+  return $ flip push dragEv $ \d@(Drag2 (fromX, fromY) _ _ mods ds) -> do
     didStayOn <- sample . current $ didStayOnDyn
     return $ if ds == DragEnd && withinBounds d
       then Just $ SingleClick btn (fromX, fromY) mods (not didStayOn)
@@ -80,7 +76,7 @@ integralFractionalDivide n d = fromIntegral n / fromIntegral d
 -- | A split of the available space into two parts with a draggable separator.
 -- Starts with half the space allocated to each, and the first pane has focus.
 -- Clicking in a pane switches focus.
-splitHDrag :: (Reflex t, MonadFix m, MonadHold t m, MonadNodeId m, HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasFocusReader t m)
+splitHDrag :: (Reflex t, MonadFix m, MonadHold t m, HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasFocusReader t m)
   => Int -- ^ initial width of left panel
   -> m ()
   -> m a