diff --git a/ltk.cabal b/ltk.cabal --- a/ltk.cabal +++ b/ltk.cabal @@ -1,5 +1,5 @@ name: ltk -version: 0.15.0.1 +version: 0.15.0.2 cabal-version: >= 1.8 build-type: Simple license: GPL @@ -19,10 +19,6 @@ type: git location: https://github.com/leksah/ltk -Flag gtk3 - description: Use Gtk3 - default: True - Library build-depends: Cabal >=1.6.0 && <1.23, base >=4.0.0.0 && <4.9, containers >=0.2 && <0.6, filepath >=1.1.0 && <1.5, @@ -31,11 +27,8 @@ pretty >=1.0.1.0 && <1.2, transformers >=0.2.2.0 && <0.5, ghc -any - if flag(gtk3) - build-depends: gtk3 >=0.13.2 && <0.14 - cpp-options: -DMIN_VERSION_gtk=MIN_VERSION_gtk3 - else - build-depends: gtk >=0.13.2 && <0.14 + build-depends: gtk3 >=0.13.2 && <0.14 + cpp-options: -DMIN_VERSION_gtk=MIN_VERSION_gtk3 exposed-modules: Default MyMissing Control.Event Graphics.UI.Editor.Basics Graphics.UI.Editor.Composite diff --git a/src/Graphics/UI/Editor/Composite.hs b/src/Graphics/UI/Editor/Composite.hs --- a/src/Graphics/UI/Editor/Composite.hs +++ b/src/Graphics/UI/Editor/Composite.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- @@ -116,9 +115,9 @@ noti2 <- emptyNotifier noti3 <- emptyNotifier mapM_ (propagateEvent notifier [noti1,noti2,noti3]) (Clicked : allGUIEvents) - r1@(frame1,inj1,ext1) <- (fst p1) (snd p1) noti1 - r2@(frame2,inj2,ext2) <- (fst p2) (snd p2) noti2 - r3@(frame3,inj3,ext3) <- (fst p3) (snd p3) noti3 + r1@(frame1,inj1,ext1) <- fst p1 (snd p1) noti1 + r2@(frame2,inj2,ext2) <- fst p2 (snd p2) noti2 + r3@(frame3,inj3,ext3) <- fst p3 (snd p3) noti3 mkEditor (\widget (v1,v2,v3) -> do core <- readIORef coreRef @@ -295,7 +294,7 @@ hasChild <- hasChildEditor childRef (childWidget,inj2,ext2) <- getChildEditor childRef childEdit childParams cNoti children <- containerGetChildren vBox - unless (elem childWidget children) $ + unless (childWidget `elem` children) $ boxPackEnd vBox childWidget PackNatural 0 inj2 getDefault widgetShowAll childWidget @@ -550,7 +549,7 @@ -- and a nontrivial: -- [("Package",\(Dependency str _) -> [cellText := str]) -- ,("Version",\(Dependency _ vers) -> [cellText := showVersionRange vers])]) -data ColumnDescr row = ColumnDescr Bool [(Text,(row -> [AttrOp CellRendererText]))] +data ColumnDescr row = ColumnDescr Bool [(Text, row -> [AttrOp CellRendererText])] -- -- | An editor with a subeditor, of which a list of items can be selected @@ -588,12 +587,12 @@ activateEvent listStore notifier (Just (\ w h -> do res <- after (castToTreeModel w) rowInserted (\ _ _ -> - h >> return ()) + void h) return (ConnectC res))) MayHaveChanged activateEvent listStore notifier (Just (\ w h -> do res <- after (castToTreeModel w) rowDeleted (\ _ -> - h >> return ()) + void h) return (ConnectC res))) MayHaveChanged treeView <- treeViewNewWithModel listStore let minSize = getParameter paraMinSize parameters @@ -601,9 +600,7 @@ sw <- scrolledWindowNew Nothing Nothing containerAdd sw treeView scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic -#ifdef MIN_VERSION_gtk3 scrolledWindowSetMinContentHeight sw (snd minSize) -#endif sel <- treeViewGetSelection treeView treeSelectionSetMode sel SelectionSingle mapM_ (\(str,func) -> do @@ -635,10 +632,9 @@ Nothing -> return () Just replaceF -> do cont <- listStoreToList listStore - mapM_ (listStoreRemove listStore) - $ map fst - $ filter (\(_,e) -> replaceF v e) - $ zip [0..] cont + mapM_ (listStoreRemove listStore . fst) + . filter (\(_,e) -> replaceF v e) + $ zip [0..] cont case mbSort of Nothing -> do listStoreAppend listStore v @@ -696,7 +692,7 @@ filesEditor :: Maybe FilePath -> FileChooserAction -> Text -> Editor [FilePath] filesEditor fp act label p = multisetEditor - (ColumnDescr False [("",(\row -> [cellText := T.pack row]))]) + (ColumnDescr False [("", \ row -> [cellText := T.pack row])]) (fileEditor fp act label, emptyParams) (Just sort) (Just (==)) @@ -706,7 +702,7 @@ textsEditor :: (Text -> Bool) -> Bool -> Editor [Text] textsEditor validation trimBlanks p = multisetEditor - (ColumnDescr False [("",(\row -> [cellText := row]))]) + (ColumnDescr False [("", \ row -> [cellText := row])]) (textEditor validation trimBlanks, emptyParams) (Just sort) (Just (==)) @@ -730,7 +726,7 @@ return (wid,pinj,pext) dependenciesEditor :: [PackageIdentifier] -> Editor [Dependency] -dependenciesEditor packages p noti = +dependenciesEditor packages p = multisetEditor (ColumnDescr True [("Package",\(Dependency (PackageName str) _) -> [cellText := T.pack str]) ,("Version",\(Dependency _ vers) -> [cellText := T.pack $ display vers])]) @@ -746,41 +742,40 @@ $ paraDirection <<<- ParaDirection Vertical $ paraPack <<<- ParaPack PackGrow $ p) - noti versionRangeEditor :: Editor VersionRange versionRangeEditor para noti = do (wid,inj,ext) <- maybeEditor - ((eitherOrEditor - (pairEditor - (comboSelectionEditor v1 (T.pack . show), emptyParams) - (versionEditor, paraName <<<- ParaName "Enter Version" $ emptyParams), - (paraDirection <<<- ParaDirection Vertical - $ paraName <<<- ParaName "Simple" - $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) - $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) - $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) - $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) - $ emptyParams)) - (tupel3Editor - (comboSelectionEditor v2 (T.pack . show), emptyParams) - (versionRangeEditor, paraShadow <<<- ParaShadow ShadowIn $ emptyParams) - (versionRangeEditor, paraShadow <<<- ParaShadow ShadowIn $ emptyParams), - paraName <<<- ParaName "Complex" - $ paraDirection <<<- ParaDirection Vertical - $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) - $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) - $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) - $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) - $ emptyParams) "Select version range"), emptyParams) + (eitherOrEditor + (pairEditor (comboSelectionEditor v1 (T.pack . show), emptyParams) + (versionEditor, + paraName <<<- ParaName "Enter Version" $ emptyParams), + paraDirection <<<- ParaDirection Vertical $ + paraName <<<- ParaName "Simple" $ + paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) $ + paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) $ + paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) $ + paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) $ emptyParams) + (tupel3Editor + (comboSelectionEditor v2 (T.pack . show), emptyParams) + (versionRangeEditor, + paraShadow <<<- ParaShadow ShadowIn $ emptyParams) + (versionRangeEditor, + paraShadow <<<- ParaShadow ShadowIn $ emptyParams), + paraName <<<- ParaName "Complex" $ + paraDirection <<<- ParaDirection Vertical $ + paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) $ + paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) $ + paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) $ + paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) $ emptyParams) + "Select version range", + emptyParams) False "Any Version" (paraDirection <<<- ParaDirection Vertical $ para) noti let vrinj AnyVersion = inj Nothing -#if MIN_VERSION_Cabal(1,8,0) vrinj (WildcardVersion v) = inj (Just (Left (WildcardVersionS,v))) -#endif vrinj (ThisVersion v) = inj (Just (Left (ThisVersionS,v))) vrinj (LaterVersion v) = inj (Just (Left (LaterVersionS,v))) vrinj (EarlierVersion v) = inj (Just (Left (EarlierVersionS,v))) @@ -800,9 +795,7 @@ Nothing -> return (Just AnyVersion) Just Nothing -> return (Just AnyVersion) Just (Just (Left (ThisVersionS,v))) -> return (Just (ThisVersion v)) -#if MIN_VERSION_Cabal(1,8,0) Just (Just (Left (WildcardVersionS,v))) -> return (Just (WildcardVersion v)) -#endif Just (Just (Left (LaterVersionS,v))) -> return (Just (LaterVersion v)) Just (Just (Left (EarlierVersionS,v))) -> return (Just (EarlierVersion v)) @@ -814,11 +807,7 @@ -> return (Just (IntersectVersionRanges v1 v2)) return (wid,vrinj,vrext) where -#if MIN_VERSION_Cabal(1,8,0) v1 = [ThisVersionS,WildcardVersionS,LaterVersionS,ThisOrLaterVersionS,EarlierVersionS,ThisOrEarlierVersionS] -#else - v1 = [ThisVersionS,LaterVersionS,ThisOrLaterVersionS,EarlierVersionS,ThisOrEarlierVersionS] -#endif v2 = [UnionVersionRangesS,IntersectVersionRangesS] data Version1 = ThisVersionS | WildcardVersionS | LaterVersionS | ThisOrLaterVersionS | EarlierVersionS | ThisOrEarlierVersionS diff --git a/src/Graphics/UI/Editor/Simple.hs b/src/Graphics/UI/Editor/Simple.hs --- a/src/Graphics/UI/Editor/Simple.hs +++ b/src/Graphics/UI/Editor/Simple.hs @@ -76,12 +76,10 @@ -- | An invisible editor without any effect -- noEditor :: alpha -> Editor alpha -noEditor proto parameters notifier = +noEditor proto = mkEditor (\ widget _ -> return ()) (return (Just proto)) - parameters - notifier -- -- | Editor for a boolean value in the form of a check button @@ -164,11 +162,15 @@ case core of Nothing -> do box <- vBoxNew True 2 - let label0 = if length labels > 0 then labels !! 0 else T.pack (show (vals !! 0)) + let label0 = case labels ++ map (T.pack . show) vals of + (x:_) -> x + _ -> error "enumEditor" button0 <- radioButtonNewWithLabel label0 buttons <- mapM (\ v -> do let n = fromEnum v - let label = if length labels > n then labels !! n else T.pack (show v) + let label = case drop n labels of + (l:_) -> l + _ -> T.pack (show v) radio <- if n == 0 then return button0 else radioButtonNewWithLabelFromWidget button0 label @@ -183,17 +185,17 @@ buttons)) (Clicked:genericGUIEvents) propagateAsChanged notifier [Clicked] mapM_ (\(b,n) -> toggleButtonSetActive b (n == fromEnum enumValue)) - (zip buttons [0..length buttons - 1]) + (zip buttons [0..]) writeIORef coreRef (Just buttons) - Just buttons -> do + Just buttons -> mapM_ (\(b,n) -> toggleButtonSetActive b (n == fromEnum enumValue)) - (zip buttons [0..length buttons - 1])) + (zip buttons [0..])) (do core <- readIORef coreRef case core of Nothing -> return Nothing Just buttons -> do boolArray <- mapM toggleButtonGetActive buttons - let mbInd = findIndex (== True) boolArray + let mbInd = elemIndex True boolArray let res = case mbInd of Nothing -> Nothing Just i -> Just (vals !! i) @@ -336,10 +338,10 @@ Nothing -> do spin <- spinButtonNewWithRange min max step widgetSetName spin (getParameter paraName parameters) - mapM_ (activateEvent (castToWidget spin) notifier Nothing) (genericGUIEvents) + mapM_ (activateEvent (castToWidget spin) notifier Nothing) genericGUIEvents activateEvent (castToWidget spin) notifier (Just (\ w h -> do - res <- afterValueSpinned (castToSpinButton w) (h >> return ()) + res <- afterValueSpinned (castToSpinButton w) (void h) return (unsafeCoerce res))) MayHaveChanged containerAdd widget spin spinButtonSetValue spin (fromIntegral v) @@ -405,12 +407,12 @@ Nothing -> do combo <- comboBoxNewText widgetSetSizeRequest combo 200 (-1) - mapM_ (\o -> comboBoxAppendText combo (showF o)) list + mapM_ (comboBoxAppendText combo . showF) list widgetSetName combo (getParameter paraName parameters) mapM_ (activateEvent (castToWidget combo) notifier Nothing) genericGUIEvents activateEvent (castToWidget combo) notifier (Just (\ w h -> do - res <- on (castToComboBox w) changed (h >> return ()) + res <- on (castToComboBox w) changed (void h) return (unsafeCoerce res))) MayHaveChanged comboBoxSetActive combo 1 containerAdd widget combo @@ -452,7 +454,7 @@ mapM_ (activateEvent (castToWidget combo) notifier Nothing) genericGUIEvents activateEvent (castToWidget combo) notifier (Just (\ w h -> do - res <- on (castToComboBox w) changed (h >> return ()) + res <- on (castToComboBox w) changed (void h) return (unsafeCoerce res))) MayHaveChanged comboBoxSetActive combo 1 containerAdd widget combo @@ -561,7 +563,7 @@ $ \row -> [ cellText := showF (snd row)] treeViewSetHeadersVisible listView False listStoreClear listStore - mapM_ (listStoreAppend listStore) $ map (\e -> (elem e objs,e)) list + mapM_ (listStoreAppend listStore . (\ e -> (e `elem` objs, e))) list let minSize = getParameter paraMinSize parameters uncurry (widgetSetSizeRequest listView) minSize sw <- scrolledWindowNew Nothing Nothing @@ -578,7 +580,7 @@ listStoreSetValue listStore i (not (fst val),snd val) listView `on` keyPressEvent $ do name <- eventKeyName - liftIO $ do + liftIO $ case name of "Return" -> do sel <- treeViewGetSelection listView @@ -590,15 +592,15 @@ _ -> return False writeIORef coreRef (Just (listView,listStore)) Just (listView,listStore) -> do - let model = map (\e -> (elem e objs,e)) list + let model = map (\e -> (e `elem` objs,e)) list listStoreClear listStore - mapM_ (listStoreAppend listStore) $ map (\e -> (elem e objs,e)) list) + mapM_ (listStoreAppend listStore . (\ e -> (e `elem` objs, e))) list) (do core <- readIORef coreRef case core of Nothing -> return Nothing Just (listView,listStore) -> do model <- listStoreToList listStore - return (Just (map snd $ filter (\e -> fst e) model))) + return (Just (map snd $ filter fst model))) parameters notifier @@ -621,9 +623,9 @@ propagateAsChanged notifier [KeyPressed,ButtonPressed] sel <- treeViewGetSelection listView treeSelectionSetMode sel - (case getParameter paraMultiSel parameters of - True -> SelectionMultiple - False -> SelectionSingle) + (if getParameter paraMultiSel parameters + then SelectionMultiple + else SelectionSingle) renderer <- cellRendererTextNew col <- treeViewColumnNew treeViewAppendColumn listView col @@ -639,9 +641,7 @@ containerAdd sw listView scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic containerAdd widget sw -#ifdef MIN_VERSION_gtk3 scrolledWindowSetMinContentHeight sw (snd minSize) -#endif treeSelectionUnselectAll sel let mbInd = elemIndex obj list case mbInd of @@ -742,10 +742,10 @@ -- Nothing -> fn -- Just rel -> makeRelative rel fn entrySetText entry (T.pack fn) - triggerEvent notifier (GUIEvent { + triggerEvent notifier GUIEvent { selector = MayHaveChanged, eventText = "", - gtkReturn = True}) + gtkReturn = True} return (e{gtkReturn=True}) -- @@ -764,7 +764,7 @@ mapM_ (activateEvent (castToWidget fs) notifier Nothing) (Clicked: genericGUIEvents) activateEvent (castToWidget fs) notifier (Just (\ w h -> do - res <- onFontSet (castToFontButton w) (h >> return ()) + res <- onFontSet (castToFontButton w) (void h) return (unsafeCoerce res))) MayHaveChanged containerAdd widget fs case mbValue of @@ -801,7 +801,7 @@ mapM_ (activateEvent (castToWidget cs) notifier Nothing) (Clicked: genericGUIEvents) activateEvent (castToWidget cs) notifier (Just (\ w h -> do - res <- onColorSet (castToColorButton w) (h >> return ()) + res <- onColorSet (castToColorButton w) (void h) return (unsafeCoerce res))) MayHaveChanged containerAdd widget cs colorButtonSetColor cs c diff --git a/src/Graphics/UI/Frame/Panes.hs b/src/Graphics/UI/Frame/Panes.hs --- a/src/Graphics/UI/Frame/Panes.hs +++ b/src/Graphics/UI/Frame/Panes.hs @@ -69,7 +69,7 @@ -- data PaneDirection = TopP | BottomP | LeftP | RightP deriving (Eq,Show,Read) - + -- -- | Description of a window layout -- Horizontal: top bottom Vertical: left right diff --git a/src/Graphics/UI/Frame/ViewFrame.hs b/src/Graphics/UI/Frame/ViewFrame.hs --- a/src/Graphics/UI/Frame/ViewFrame.hs +++ b/src/Graphics/UI/Frame/ViewFrame.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE FlexibleInstances #-} @@ -141,16 +140,12 @@ import System.Glib (GObjectClass(..), isA) import Graphics.UI.Gtk.Layout.Notebook (gTypeNotebook) import System.CPUTime (getCPUTime) -import Graphics.UI.Gtk.Gdk.EventM (Modifier(..)) -#ifdef MIN_VERSION_gtk3 +import Graphics.UI.Gtk.Gdk.EventM + (Modifier(..), eventModifierMouse, TimeStamp(..)) import Graphics.UI.Gtk.General.CssProvider (cssProviderNew, cssProviderLoadFromString) import Graphics.UI.Gtk.General.StyleContext (styleContextAddProvider) import Graphics.UI.Gtk.General.Enums (Align(..)) -#else -import Graphics.UI.Gtk (rcParseString) -#endif import MyMissing (forceJust, forceHead) -import Graphics.UI.Gtk.Gdk.EventM (TimeStamp(..)) import Graphics.UI.Editor.MakeEditor (mkField, FieldDescription(..), buildEditor) import Graphics.UI.Editor.Simple (stringEditor, textEditor, okCancelFields) @@ -166,6 +161,9 @@ import qualified Control.Monad.Reader as Gtk (liftIO) import qualified Data.Text as T (pack, stripPrefix, unpack) import Data.Monoid ((<>)) +import Graphics.UI.Gtk.Abstract.Widget (buttonReleaseEvent) +import Data.Foldable (forM_) +import Control.Arrow (Arrow(..)) --import Debug.Trace (trace) trace (a::Text) b = b @@ -173,28 +171,11 @@ groupPrefix = "_group_" withoutGroupPrefix :: Text -> Text -withoutGroupPrefix s = case groupPrefix `T.stripPrefix` s of - Nothing -> s - Just s' -> s' +withoutGroupPrefix s = fromMaybe s (groupPrefix `T.stripPrefix` s) initGtkRc :: IO () -#ifdef MIN_VERSION_gtk3 initGtkRc = return () -#else -initGtkRc = rcParseString ("style \"leksah-close-button-style\"\n" ++ - "{\n" ++ - " GtkButton::default-border = 0\n" ++ - " GtkButton::default-outside-border = 0\n" ++ - " GtkButton::inner-border = 0\n" ++ - " GtkWidget::focus-padding = 0\n" ++ - " GtkWidget::focus-line-width = 0\n" ++ - " xthickness = 0\n" ++ - " ythickness = 0\n" ++ - " padding = 0\n" ++ - "}\n" ++ - "widget \"*.leksah-close-button\" style \"leksah-close-button-style\"") -#endif removePaneAdmin :: RecoverablePane alpha beta delta => alpha -> delta () removePaneAdmin pane = do @@ -219,29 +200,28 @@ setPaneMapSt (Map.insert (paneName pane) (pp, conn) paneMap') setPanesSt (Map.insert (paneName pane) (PaneC pane) panes') return True - else do - trace ("ViewFrame>addPaneAdmin:pane with this name already exist" <> paneName pane) $ - return False + else trace + ("ViewFrame>addPaneAdmin:pane with this name already exist" <> + paneName pane) + $ return False getPanePrim :: RecoverablePane alpha beta delta => delta (Maybe alpha) getPanePrim = do selectedPanes <- getPanes - if null selectedPanes || length selectedPanes > 1 - then return Nothing - else (return (Just $ head selectedPanes)) + if null selectedPanes || length selectedPanes > 1 + then return Nothing + else return (Just $ head selectedPanes) -getPanes :: RecoverablePane alpha beta delta => delta ([alpha]) +getPanes :: RecoverablePane alpha beta delta => delta [alpha] getPanes = do panes' <- getPanesSt - return (catMaybes - $ map (\(PaneC p) -> cast p) - $ Map.elems panes') + return (mapMaybe (\ (PaneC p) -> cast p) (Map.elems panes')) -notebookInsertOrdered :: PaneMonad alpha => (NotebookClass self, WidgetClass child) - => self - -> child -- child - the Widget to use as the contents of the page. +notebookInsertOrdered :: PaneMonad alpha => (NotebookClass self, WidgetClass child) + => self + -> child -- child - the Widget to use as the contents of the page. -> Text - -> Maybe Label -- the label for the page as Text or Label + -> Maybe Label -- the label for the page as Text or Label -> Bool -> alpha () notebookInsertOrdered nb widget labelStr mbLabel isGroup = do @@ -251,11 +231,12 @@ menuLabel <- liftIO $ labelNew (Just labelStr) numPages <- liftIO $ notebookGetNPages nb mbWidgets <- liftIO $ mapM (notebookGetNthPage nb) [0 .. (numPages-1)] - let widgets = map (\v -> forceJust v "ViewFrame.notebookInsertOrdered: no widget") mbWidgets + let widgets = map (`forceJust` "ViewFrame.notebookInsertOrdered: no widget") mbWidgets labelStrs <- liftIO $ mapM widgetGetName widgets - let pos = case findIndex (\ s -> withoutGroupPrefix s > withoutGroupPrefix labelStr) labelStrs of - Just i -> i - Nothing -> -1 + let pos = fromMaybe (-1) + (findIndex + (\ s -> withoutGroupPrefix s > withoutGroupPrefix labelStr) + labelStrs) labelBox <- if isGroup then groupLabel labelStr else mkLabelBox label labelStr liftIO $ do markLabel nb labelBox False @@ -286,7 +267,6 @@ Just i -> imageNewFromPixbuf i Nothing -> imageNewFromStock stockClose IconSizeMenu -#ifdef MIN_VERSION_gtk3 provider <- cssProviderNew cssProviderLoadFromString provider ( ".button {\n" <> @@ -306,13 +286,13 @@ context <- widgetGetStyleContext image styleContextAddProvider context provider 600 widgetSetVAlign tabButton AlignCenter - widgetSetVAlign lbl AlignCenter -#endif + widgetSetVAlign lbl AlignCenter + containerSetBorderWidth tabButton 0 containerAdd tabButton image - boxPackStart innerBox tabButton PackNatural 0 boxPackStart innerBox lbl PackGrow 0 + boxPackStart innerBox tabButton PackNatural 5 containerAdd labelBox innerBox dragSourceSet labelBox [Button1] [ActionCopy,ActionMove] @@ -325,13 +305,17 @@ return (tabButton,labelBox) cl <- runInIO closeHandler liftIO $ on tb buttonActivated (cl ()) + liftIO $ on lb buttonReleaseEvent $ do + modifiers <- eventModifierMouse + let middleButton = Button2 + when (middleButton `elem` modifiers) (liftIO $ cl ()) + return False return lb where closeHandler :: PaneMonad alpha => () -> alpha () closeHandler _ = case groupPrefix `T.stripPrefix` paneName of - Just group -> do - closeGroup group + Just group -> closeGroup group Nothing -> do (PaneC pane) <- paneFromName paneName closePane pane @@ -358,7 +342,7 @@ Nothing -> return () Just container -> do children <- containerGetChildren container - let label = castToLabel $ forceHead (tail children) "ViewFrame>>markLabel: empty children" + let label = castToLabel $ forceHead children "ViewFrame>>markLabel: empty children" (text :: Text) <- widgetGetName topWidget labelSetUseMarkup (castToLabel label) True labelSetMarkup (castToLabel label) @@ -372,7 +356,7 @@ bufs <- getPanesSt let ind = foldr (\(PaneC buf) ind -> if primPaneName buf == bn - then max ind ((getAddedIndex buf) + 1) + then max ind (getAddedIndex buf + 1) else ind) 0 (Map.elems bufs) if ind == 0 @@ -451,21 +435,20 @@ mbPanePath <- getActivePanePath case mbPanePath of Nothing -> return () - Just panePath -> do - viewSplit' panePath dir + Just panePath -> viewSplit' panePath dir viewSplit' :: PaneMonad alpha => PanePath -> Direction -> alpha () viewSplit' panePath dir = do l <- getLayout case layoutFromPath panePath l of - (TerminalP _ _ _ (Just _) _) -> trace ("ViewFrame>>viewSplit': can't split detached: ") return () + (TerminalP _ _ _ (Just _) _) -> trace "ViewFrame>>viewSplit': can't split detached: " return () _ -> do - activeNotebook <- (getNotebook' "viewSplit") panePath + activeNotebook <- getNotebook' "viewSplit" panePath ind <- liftIO $ notebookGetCurrentPage activeNotebook mbPD <- do mbParent <- liftIO $ widgetGetParent activeNotebook case mbParent of - Nothing -> trace ("ViewFrame>>viewSplit': parent not found: ") return Nothing + Nothing -> trace "ViewFrame>>viewSplit': parent not found: " return Nothing Just parent -> do (nb,paneDir) <- do let (name,altname,paneDir, @@ -495,8 +478,8 @@ widgetSetName nb (altname :: Text) panedPack2 newpane nb True True nbIndex <- if parent `isA` gTypeNotebook - then notebookPageNum ((castToNotebook' "viewSplit'1") parent) activeNotebook - else trace ("ViewFrame>>viewSplit': parent not a notebook: ") return Nothing + then notebookPageNum (castToNotebook' "viewSplit'1" parent) activeNotebook + else trace "ViewFrame>>viewSplit': parent not a notebook: " return Nothing containerRemove (castToContainer parent) activeNotebook widgetSetName activeNotebook (name :: Text) panedPack1 newpane activeNotebook True True @@ -506,11 +489,11 @@ | dir `elem` [TopP, LeftP] -> liftIO $ panedPack1 (castToPaned parent) np True True | otherwise -> liftIO $ panedPack2 (castToPaned parent) np True True (GroupP group:_, Just n) -> do - liftIO $ notebookInsertPage ((castToNotebook' "viewSplit' 2") parent) np group n + liftIO $ notebookInsertPage (castToNotebook' "viewSplit' 2" parent) np group n label <- groupLabel group - liftIO $ notebookSetTabLabel ((castToNotebook' "viewSplit' 3") parent) np label + liftIO $ notebookSetTabLabel (castToNotebook' "viewSplit' 3" parent) np label label2 <- groupMenuLabel group - liftIO $ notebookSetMenuLabel ((castToNotebook' "viewSplit' 4") parent) np label2 + liftIO $ notebookSetMenuLabel (castToNotebook' "viewSplit' 4" parent) np label2 return () ([], _) -> do liftIO $ boxPackStart (castToBox parent) np PackGrow 0 @@ -521,9 +504,9 @@ widgetGrabFocus activeNotebook case nbi of Just n -> do - notebookSetCurrentPage ((castToNotebook' "viewSplit' 5") parent) n + notebookSetCurrentPage (castToNotebook' "viewSplit' 5" parent) n return () - _ -> trace ("ViewFrame>>viewSplit': parent not a notebook2: ")return () + _ -> trace "ViewFrame>>viewSplit': parent not a notebook2: "return () return (nb,paneDir) handleFunc <- runInIO (handleNotebookSwitch nb) liftIO $ after nb switchPage handleFunc @@ -547,40 +530,37 @@ viewCollapse :: PaneMonad alpha => alpha () viewCollapse = do mbPanePath <- getActivePanePath - case mbPanePath of - Nothing -> return () - Just panePath -> do - viewCollapse' panePath + forM_ mbPanePath viewCollapse' viewCollapse' :: PaneMonad alpha => PanePath -> alpha () viewCollapse' panePath = trace "viewCollapse' called" $ do layout1 <- getLayoutSt case layoutFromPath panePath layout1 of - (TerminalP _ _ _ (Just _) _) -> trace ("ViewFrame>>viewCollapse': can't collapse detached: ") + (TerminalP _ _ _ (Just _) _) -> trace "ViewFrame>>viewCollapse': can't collapse detached: " return () _ -> do let newPanePath = init panePath let mbOtherSidePath = otherSide panePath case mbOtherSidePath of - Nothing -> trace ("ViewFrame>>viewCollapse': no other side path found: ") return () + Nothing -> trace "ViewFrame>>viewCollapse': no other side path found: " return () Just otherSidePath -> do nbop <- getNotebookOrPaned otherSidePath castToWidget let nb = if nbop `isA` gTypeNotebook - then Just ((castToNotebook' "viewCollapse' 0") nbop) + then Just (castToNotebook' "viewCollapse' 0" nbop) else Nothing case nb of - Nothing -> trace ("ViewFrame>>viewCollapse': other side path not collapsedXX: ") $ + Nothing -> trace "ViewFrame>>viewCollapse': other side path not collapsedXX: " $ case layoutFromPath otherSidePath layout1 of - VerticalP _ _ _ -> do + VerticalP{} -> do viewCollapse' (otherSidePath ++ [SplitP LeftP]) viewCollapse' panePath - HorizontalP _ _ _ -> do + HorizontalP{} -> do viewCollapse' (otherSidePath ++ [SplitP TopP]) viewCollapse' panePath - otherwise -> trace ("ViewFrame>>viewCollapse': impossible1 ") return () + otherwise -> trace "ViewFrame>>viewCollapse': impossible1 " return () Just otherSideNotebook -> do paneMap <- getPaneMapSt - activeNotebook <- (getNotebook' "viewCollapse' 1") panePath + activeNotebook <- getNotebook' "viewCollapse' 1" panePath -- 1. Move panes and groups to one side (includes changes to paneMap and layout) let paneNamesToMove = map (\(w,(p,_)) -> w) $filter (\(w,(p,_)) -> otherSidePath == p) @@ -604,7 +584,7 @@ Nothing -> error "collapse: no grandparent" Just grandparent -> do nbIndex <- if grandparent `isA` gTypeNotebook - then liftIO $ notebookPageNum ((castToNotebook' "viewCollapse'' 1") grandparent) parent + then liftIO $ notebookPageNum (castToNotebook' "viewCollapse'' 1" grandparent) parent else return Nothing liftIO $ containerRemove (castToContainer grandparent) parent liftIO $ containerRemove (castToContainer parent) activeNotebook @@ -617,11 +597,11 @@ (SplitP dir, _) | dir == BottomP || dir == RightP -> liftIO $ panedPack2 (castToPaned grandparent) activeNotebook True True (GroupP group, Just n) -> do - liftIO $ notebookInsertPage ((castToNotebook' "viewCollapse'' 2") grandparent) activeNotebook group n + liftIO $ notebookInsertPage (castToNotebook' "viewCollapse'' 2" grandparent) activeNotebook group n label <- groupLabel group liftIO $ do - notebookSetTabLabel ((castToNotebook' "viewCollapse'' 3") grandparent) activeNotebook label - notebookSetCurrentPage ((castToNotebook' "viewCollapse'' 4") grandparent) n + notebookSetTabLabel (castToNotebook' "viewCollapse'' 3" grandparent) activeNotebook label + notebookSetCurrentPage (castToNotebook' "viewCollapse'' 4" grandparent) n return () _ -> error "collapse: Unable to find page index" liftIO $ widgetSetName activeNotebook $panePathElementToWidgetName lasPathElem @@ -639,9 +619,9 @@ getGroupsFrom :: PanePath -> PaneLayout -> [Text] getGroupsFrom path layout = case layoutFromPath path layout of - t@(TerminalP _ _ _ _ _) -> Map.keys (paneGroups t) - HorizontalP _ _ _ -> [] - VerticalP _ _ _ -> [] + t@(TerminalP{}) -> Map.keys (paneGroups t) + HorizontalP{} -> [] + VerticalP{} -> [] viewNewGroup :: PaneMonad alpha => alpha () viewNewGroup = do @@ -690,11 +670,7 @@ dia <- dialogNew set dia [ windowTransientFor := parent , windowTitle := ("Enter group name" :: Text) ] -#ifdef MIN_VERSION_gtk3 upper <- castToVBox <$> dialogGetContentArea dia -#else - upper <- castToVBox <$> dialogGetUpper dia -#endif lower <- castToHBox <$> dialogGetActionArea dia (widget,inj,ext,_) <- buildEditor moduleFields "" (widget2,_,_,notifier) <- buildEditor okCancelFields () @@ -707,7 +683,7 @@ boxPackStart lower widget2 PackNatural 7 widgetShowAll dia resp <- dialogRun dia - value <- ext ("") + value <- ext "" widgetDestroy dia case resp of ResponseOk | value /= Just "" -> return value @@ -716,10 +692,10 @@ moduleFields :: FieldDescription Text moduleFields = VFD emptyParams [ mkField - (paraName <<<- ParaName ("New group ") + (paraName <<<- ParaName "New group " $ emptyParams) id - (\ a b -> a) + const (textEditor (const True) True)] viewNest :: PaneMonad alpha => Text -> alpha () @@ -727,12 +703,11 @@ mbPanePath <- getActivePanePath case mbPanePath of Nothing -> return () - Just panePath -> do - viewNest' panePath group + Just panePath -> viewNest' panePath group viewNest' :: PaneMonad alpha => PanePath -> Text -> alpha () viewNest' panePath group = do - activeNotebook <- (getNotebook' "viewNest' 1") panePath + activeNotebook <- getNotebook' "viewNest' 1" panePath mbParent <- liftIO $ widgetGetParent activeNotebook case mbParent of Nothing -> return () @@ -761,7 +736,7 @@ Just path -> do panesMap <- getPaneMapSt let nameAndpathList = filter (\(a,pp) -> path `isPrefixOf` pp) - $ map (\(a,b) -> (a,fst b)) (Map.assocs panesMap) + $ map (second fst) (Map.assocs panesMap) continue <- case nameAndpathList of (_:_) -> liftIO $ do md <- messageDialogNew (Just mainWindow) [] MessageQuestion ButtonsYesNo @@ -773,9 +748,9 @@ otherwise -> return False [] -> return True when continue $ do - panes <- mapM paneFromName $ map fst nameAndpathList + panes <- mapM (paneFromName . fst) nameAndpathList results <- mapM (\ (PaneC p) -> closePane p) panes - when (foldr (&&) True results) $ do + when (and results) $ do nbOrPaned <- getNotebookOrPaned path castToWidget mbParent <- liftIO $ widgetGetParent nbOrPaned case mbParent of @@ -791,12 +766,11 @@ mbPanePath <- getActivePanePath case mbPanePath of Nothing -> return Nothing - Just panePath -> do - viewDetach' panePath (T.pack id) + Just panePath -> viewDetach' panePath (T.pack id) viewDetach' :: PaneMonad alpha => PanePath -> Text -> alpha (Maybe (Window,Widget)) viewDetach' panePath id = do - activeNotebook <- (getNotebook' "viewDetach'") panePath + activeNotebook <- getNotebook' "viewDetach'" panePath mbParent <- liftIO $ widgetGetParent activeNotebook case mbParent of Nothing -> return Nothing @@ -810,8 +784,7 @@ set window [ windowTitle := ("Leksah detached window" :: Text) , widgetName := Just id ] case size of - Just (width, height) -> do - windowSetDefaultSize window width height + Just (width, height) -> windowSetDefaultSize window width height Nothing -> do (Rectangle _ _ curWidth curHeight) <- widgetGetAllocation activeNotebook windowSetDefaultSize window curWidth curHeight @@ -839,7 +812,7 @@ setWindowsSt $ delete window windows return False Just pp -> do - nb <- (getNotebook' "handleReattach") pp + nb <- getNotebook' "handleReattach" pp parent <- getNotebookOrPaned (init pp) castToContainer liftIO $ containerRemove (castToContainer window) nb liftIO $ containerAdd parent nb @@ -849,7 +822,7 @@ case last pp of GroupP groupName -> do label <- groupLabel groupName - liftIO $ notebookSetTabLabel ((castToNotebook' "handleReattach") parent) nb label + liftIO $ notebookSetTabLabel (castToNotebook' "handleReattach" parent) nb label otherwise -> return () return False -- "now destroy the window" @@ -860,10 +833,10 @@ case mbPanePath of Nothing -> return Nothing Just panePath -> do - activeNotebook <- (getNotebook' "getActiveWindow") panePath + activeNotebook <- getNotebook' "getActiveWindow" panePath top <- liftIO $ widgetGetToplevel activeNotebook - if (top `isA` gTypeWindow) - then return . Just $ castToWindow top + if top `isA` gTypeWindow + then return . Just $ castToWindow top else return Nothing getActiveScreen :: PaneMonad alpha => alpha (Maybe Screen) @@ -893,7 +866,7 @@ panes' <- getPanesSt foldM (\r (PaneC p) -> do n2 <- liftIO $ widgetGetName (getTopWidget p) - return (if n1 == n2 then (Just (PaneC p)) else r)) + return (if n1 == n2 then Just (PaneC p) else r)) Nothing (Map.elems panes') @@ -905,19 +878,16 @@ viewMove direction = do mbPane <- getActivePaneSt case mbPane of - Nothing -> do - return () + Nothing -> return () Just (paneName,_) -> do (PaneC pane) <- paneFromName paneName mbPanePath <- getActivePanePath case mbPanePath of - Nothing -> do - return () + Nothing -> return () Just panePath -> do layout <- getLayoutSt case findMoveTarget panePath layout direction of - Nothing -> do - return () + Nothing -> return () Just moveTo -> move moveTo pane -- @@ -930,7 +900,7 @@ canMove reversedPath = case head reversedPath of SplitP d | d == oppositeDir - -> SplitP direction : (tail reversedPath) + -> SplitP direction : tail reversedPath GroupP group -> [] _ -> canMove (tail reversedPath) basePath = reverse (canMove $ reverse panePath) @@ -945,7 +915,7 @@ move :: RecoverablePane alpha beta delta => PanePath -> alpha -> delta () move toPanePath pane = do let name = paneName pane - toNB <- (getNotebook' "move") toPanePath + toNB <- getNotebook' "move" toPanePath move' (name,toNB) -- @@ -958,16 +928,16 @@ layout <- getLayout frameState <- getFrameState case groupPrefix `T.stripPrefix` paneName of - Just group -> do + Just group -> case findGroupPath group layout of Nothing -> trace ("ViewFrame>>move': group not found: " <> group) return () Just fromPath -> do groupNBOrPaned <- getNotebookOrPaned fromPath castToWidget - fromNB <- (getNotebook' "move'") (init fromPath) - case toNB `Map.lookup` (panePathFromNB frameState) of + fromNB <- getNotebook' "move'" (init fromPath) + case toNB `Map.lookup` panePathFromNB frameState of Nothing -> trace "ViewFrame>>move': panepath for Notebook not found1" return () - Just toPath -> do - when (fromNB /= toNB && not (isPrefixOf fromPath toPath)) $ do + Just toPath -> + when (fromNB /= toNB && not (fromPath `isPrefixOf` toPath)) $ do mbNum <- liftIO $ notebookPageNum fromNB groupNBOrPaned case mbNum of Nothing -> trace "ViewFrame>>move': group notebook not found" return () @@ -984,8 +954,8 @@ Nothing -> case paneName `Map.lookup` panes of Nothing -> trace ("ViewFrame>>move': pane not found: " <> paneName) return () - Just (PaneC pane) -> do - case toNB `Map.lookup` (panePathFromNB frameState) of + Just (PaneC pane) -> + case toNB `Map.lookup` panePathFromNB frameState of Nothing -> trace "ViewFrame>>move': panepath for Notebook not found2" return () Just toPath -> case paneName `Map.lookup`paneMap of @@ -994,7 +964,7 @@ Just (fromPath,_) -> do let child = getTopWidget pane (fromPane,cid) <- guiPropertiesFromName paneName - fromNB <- (getNotebook' "move'") fromPane + fromNB <- getNotebook' "move'" fromPane when (fromNB /= toNB) $ do mbNum <- liftIO $ notebookPageNum fromNB child case mbNum of @@ -1033,15 +1003,17 @@ case mbParent of Just parent -> do setCurrentNotebookPages parent - if parent `isA` gTypeNotebook - then do - mbPageNum <- notebookPageNum ((castToNotebook' "setCurrentNotebookPage 1") parent) widget - case mbPageNum of - Just pageNum -> do - notebookSetCurrentPage ((castToNotebook' "setCurrentNotebookPage 2") parent) pageNum - return () - Nothing -> return () - else return () + when (parent `isA` gTypeNotebook) $ do + mbPageNum <- notebookPageNum + (castToNotebook' "setCurrentNotebookPage 1" parent) + widget + case mbPageNum of + Just pageNum -> do + notebookSetCurrentPage + (castToNotebook' "setCurrentNotebookPage 2" parent) + pageNum + return () + Nothing -> return () Nothing -> return () -- @@ -1069,7 +1041,7 @@ p <- panePathForGroup id l <- getLayout return (getBestPanePath p l) - + -- -- | Construct a new notebook -- @@ -1105,8 +1077,8 @@ DragContext -> Point -> InfoId -> - TimeStamp -> - (SelectionDataM ()) + TimeStamp -> + SelectionDataM () dragFunc nb func cont point id timeStamp = do mbText <- selectionDataGetText case mbText of @@ -1116,10 +1088,10 @@ return () terminalsWithPanePath :: PaneLayout -> [(PanePath,PaneLayout)] -terminalsWithPanePath pl = map (\ (pp,l) -> (reverse pp,l)) $ terminalsWithPP [] pl +terminalsWithPanePath pl = map (first reverse) $ terminalsWithPP [] pl where - terminalsWithPP pp t@(TerminalP groups _ _ _ _) = [(pp,t)] - ++ concatMap (terminalsFromGroup pp) (Map.toList groups) + terminalsWithPP pp t@(TerminalP groups _ _ _ _) = (pp, t) : concatMap (terminalsFromGroup pp) + (Map.toList groups) terminalsWithPP pp (VerticalP l r _) = terminalsWithPP (SplitP LeftP : pp) l ++ terminalsWithPP (SplitP RightP : pp) r terminalsWithPP pp (HorizontalP t b _) = terminalsWithPP (SplitP TopP : pp) t @@ -1129,31 +1101,31 @@ findGroupPath :: Text -> PaneLayout -> Maybe PanePath findGroupPath group layout = let terminalPairs = terminalsWithPanePath layout - in case (filter filterFunc terminalPairs) of + in case filter filterFunc terminalPairs of [] -> Nothing - (pp,_) : [] -> Just (pp ++ [GroupP group]) + [(pp, _)] -> Just (pp ++ [GroupP group]) _ -> error ("ViewFrame>>group name not unique: " ++ T.unpack group) where - filterFunc (_,(TerminalP groups _ _ _ _)) = group `Set.member` Map.keysSet groups - filterFunc _ = error "ViewFrame>>findGroupPath: impossible" + filterFunc (_, TerminalP groups _ _ _ _) = group `Set.member` Map.keysSet groups + filterFunc _ = error "ViewFrame>>findGroupPath: impossible" findDetachedPath :: Text -> PaneLayout -> Maybe PanePath findDetachedPath id layout = let terminalPairs = terminalsWithPanePath layout - in case (filter filterFunc terminalPairs) of + in case filter filterFunc terminalPairs of [] -> Nothing - (pp,_) : [] -> Just pp + [(pp, _)] -> Just pp _ -> error ("ViewFrame>>window id not unique: " ++ T.unpack id) where - filterFunc (_,(TerminalP _ _ _ (Just lid) _)) = lid == id - filterFunc _ = False + filterFunc (_, TerminalP _ _ _ (Just lid) _) = lid == id + filterFunc _ = False allGroupNames :: PaneLayout -> Set Text allGroupNames pl = Set.unions $ map getFunc (terminalsWithPanePath pl) where - getFunc (_,(TerminalP groups _ _ _ _)) = Map.keysSet groups - getFunc _ = error "ViewFrame>>allGroupNames: impossible" + getFunc (_, TerminalP groups _ _ _ _) = Map.keysSet groups + getFunc _ = error "ViewFrame>>allGroupNames: impossible" -- @@ -1240,9 +1212,9 @@ Nothing -> return Nothing Just (paneName,_) -> do (pp,_) <- guiPropertiesFromName paneName - return (Just (pp)) + return (Just pp) -getActivePanePathOrStandard :: PaneMonad alpha => StandardPath -> alpha (PanePath) +getActivePanePathOrStandard :: PaneMonad alpha => StandardPath -> alpha PanePath getActivePanePathOrStandard sp = do mbApp <- getActivePanePath case mbApp of @@ -1259,7 +1231,7 @@ mbPanePath <- getActivePanePath case mbPanePath of Just panePath -> do - nb <- (getNotebook' "getActiveNotebook") panePath + nb <- getNotebook' "getActiveNotebook" panePath return (Just nb) Nothing -> return Nothing @@ -1418,38 +1390,38 @@ adjust' (SplitP LeftP:r) (VerticalP lp rp _) = VerticalP (adjust' r lp) rp 0 adjust' (SplitP RightP:r) (VerticalP lp rp _) = VerticalP lp (adjust' r rp) 0 adjust' p l = error $"inconsistent layout (adjust) " ++ show p ++ " " ++ show l - adjustPaneGroupLayout p group = adjust' p group + adjustPaneGroupLayout = adjust' -- -- | Get the widget from a list of strings -- -widgetFromPath :: Widget -> [Text] -> IO (Widget) +widgetFromPath :: Widget -> [Text] -> IO Widget widgetFromPath w [] = return w widgetFromPath w path = do children <- containerGetChildren (castToContainer w) chooseWidgetFromPath children path -chooseWidgetFromPath :: [Widget] -> [Text] -> IO (Widget) -chooseWidgetFromPath _ [] = error $"Cant't find widget (empty path)" +chooseWidgetFromPath :: [Widget] -> [Text] -> IO Widget +chooseWidgetFromPath _ [] = error "Cant't find widget (empty path)" chooseWidgetFromPath widgets (h:t) = do names <- mapM widgetGetName widgets - let mbiInd = findIndex (== h) names + let mbiInd = elemIndex h names case mbiInd of Nothing -> error $"Cant't find widget path " ++ show (h:t) ++ " found only " ++ show names Just ind -> widgetFromPath (widgets !! ind) t -widgetGet :: PaneMonad alpha => [Text] -> (Widget -> b) -> alpha (b) +widgetGet :: PaneMonad alpha => [Text] -> (Widget -> b) -> alpha b widgetGet strL cf = do windows <- getWindowsSt r <- liftIO $chooseWidgetFromPath (map castToWidget windows) strL return (cf r) -widgetGetRel :: Widget -> [Text] -> (Widget -> b) -> IO (b) +widgetGetRel :: Widget -> [Text] -> (Widget -> b) -> IO b widgetGetRel w sl cf = do r <- widgetFromPath w sl return (cf r) -getUIAction :: PaneMonad alpha => Text -> (Action -> a) -> alpha (a) +getUIAction :: PaneMonad alpha => Text -> (Action -> a) -> alpha a getUIAction str f = do uiManager <- getUiManagerSt liftIO $ do diff --git a/src/Text/PrinterParser.hs b/src/Text/PrinterParser.hs --- a/src/Text/PrinterParser.hs +++ b/src/Text/PrinterParser.hs @@ -201,13 +201,13 @@ -- | Things that can be pretty-printed class Pretty a where - -- | Pretty-print something in isolation. - pretty :: a -> PP.Doc - -- | Pretty-print something in a precedence context. - prettyPrec :: Int -> a -> PP.Doc - pretty = prettyPrec 0 - prettyPrec _ = pretty - + -- | Pretty-print something in isolation. + pretty :: a -> PP.Doc + -- | Pretty-print something in a precedence context. + prettyPrec :: Int -> a -> PP.Doc + pretty = prettyPrec 0 + prettyPrec _ = pretty + emptyPrinter :: () -> PP.Doc emptyPrinter _ = PP.empty