fltkhs 0.8.0.0 → 0.8.0.1

raw patch · 15 files changed

+58/−37 lines, 15 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• fltkhs.cabal +1/−1
• scripts/doc-parser.hs +16/−3
• src/Graphics/UI/FLTK/LowLevel/Base/DoubleWindow.chs +0/−1
• src/Graphics/UI/FLTK/LowLevel/Base/Group.chs +2/−2
• src/Graphics/UI/FLTK/LowLevel/Base/Input.chs +2/−2
• src/Graphics/UI/FLTK/LowLevel/Base/MenuButton.chs +2/−2
• src/Graphics/UI/FLTK/LowLevel/Base/MenuItem.chs +5/−5
• src/Graphics/UI/FLTK/LowLevel/Base/Tabs.chs +6/−6
• src/Graphics/UI/FLTK/LowLevel/Base/Widget.chs +4/−4
• src/Graphics/UI/FLTK/LowLevel/Base/Window.chs +6/−6
• src/Graphics/UI/FLTK/LowLevel/Box.chs +3/−0
• src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs +4/−0
• src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs +2/−1
• src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs +3/−3
• src/Graphics/UI/FLTK/LowLevel/Window.chs +2/−1

@@ -1,5 +1,5 @@ name : fltkhs-version : 0.8.0.0+version : 0.8.0.1 synopsis : FLTK bindings description: Low level bindings for the FLTK GUI toolkit. For installation and quick start instruction please scroll all the way down to the README. license : MIT

@@ -149,7 +149,7 @@ word = manyTill anyChar (try (string " "))  isWidget w ((_,_),_,w') = w == w'-data Command = Functions String | Hierarchy String | Sync+data Command = Functions String | Hierarchy String | Sync | CheckHierarchies  traceHierarchy :: String -> [String] -> [(String,String)] -> [String] traceHierarchy w accum dict = case (lookup w dict) of@@ -162,8 +162,9 @@         case args of           ("functions":w':[]) -> Just (Functions w')           ("hierarchy":w':[]) -> Just (Hierarchy w')-          ("sync":[])         -> Just Sync-          _                   -> Nothing+          ("sync":[]) -> Just Sync+          ("checkHierarchies":[]) -> Just CheckHierarchies+          _ -> Nothing   hierarchyContents <- readFile "../src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs"   let objs = (                filter (not . isInfixOf "Funcs") .@@ -213,6 +214,18 @@       let (functions, inNewVersionOnly) = parseWidgetFile contents       let rendered = maybe [] (sort . map (\(c, sig, mName, wType) -> pprint ((c, sig), mName, wType)))       putStr $ intercalate "\n--\n" (map ((++) "-- ") (rendered functions))+    (Just CheckHierarchies) -> +      print+        (foldl+          (\badHierarchies (o,parentO) ->+             maybe+               badHierarchies+               (\_ ->+                 if (not (parentO == (o ++ "Base")))+                 then badHierarchies ++ [o]+                 else badHierarchies)+               (lookup (o ++ "Base") hier'))+           [] hier')     (Just Sync) ->       mapM         (\(w,hierarchyFs) -> do

@@ -30,7 +30,6 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy import Graphics.UI.FLTK.LowLevel.Base.Widget import Graphics.UI.FLTK.LowLevel.Base.Window-import Graphics.UI.FLTK.LowLevel.Window  {# fun Fl_OverriddenDouble_Window_New as overriddenWindowNew' {`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenDouble_Window_NewXY as overriddenWindowNewXY' {`Int',`Int', `Int', `Int', id `Ptr ()'} -> `Ptr ()' id #}

@@ -131,7 +131,7 @@   runOp _ _ group = withRef group $ \groupPtr -> setResizable' groupPtr nullPtr  {# fun Fl_Group_resizable as resizable' { id `Ptr ()' } -> `Ptr ()' id #}-instance (impl ~ ( IO (Maybe (Ref Widget)))) => Op (GetResizable ()) GroupBase orig impl where+instance (impl ~ ( IO (Maybe (Ref WidgetBase)))) => Op (GetResizable ()) GroupBase orig impl where   runOp _ _ group = withRef group $ \groupPtr -> resizable' groupPtr >>= toMaybeRef  {# fun Fl_Group_add_resizable as addResizable' { id `Ptr ()',id `Ptr ()' } -> `()' supressWarningAboutRes #}@@ -230,7 +230,7 @@ -- -- getChild :: 'Ref' 'GroupBase' -> 'AtIndex' -> 'IO' ('Maybe' ('Ref' 'WidgetBase')) ----- getResizable :: 'Ref' 'GroupBase' -> 'IO' ('Maybe' ('Ref' 'Widget'))+-- getResizable :: 'Ref' 'GroupBase' -> 'IO' ('Maybe' ('Ref' 'WidgetBase')) -- -- handle :: 'Ref' 'GroupBase' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) --

@@ -15,9 +15,9 @@      --      -- $hierarchy -     -- * Input+     -- * Fl_Input functions      ---     -- $Input+     -- $functions     ) where #include "Fl_ExportMacros.h"

@@ -81,7 +81,7 @@     menuButtonDestroy' winPtr     return nullPtr {#fun Fl_Menu_Button_popup as menuButtonPopup' { id `Ptr ()' } -> `Ptr ()' id #}-instance (impl ~ ( IO (Maybe (Ref MenuItem)))) => Op (Popup ()) MenuButtonBase orig impl where+instance (impl ~ ( IO (Maybe (Ref MenuItemBase)))) => Op (Popup ()) MenuButtonBase orig impl where   runOp _ _ menu_bar = withRef menu_bar (\p -> menuButtonPopup' p >>= toMaybeRef)  {# fun Fl_Menu_Button_draw_super as drawSuper' { id `Ptr ()' } -> `()' supressWarningAboutRes #}@@ -142,7 +142,7 @@ -- -- hide :: 'Ref' 'MenuButtonBase' -> 'IO' () ----- popup :: 'Ref' 'MenuButtonBase' -> 'IO' ('Maybe' ('Ref' 'MenuItem'))+-- popup :: 'Ref' 'MenuButtonBase' -> 'IO' ('Maybe' ('Ref' 'MenuItemBase')) -- -- resize :: 'Ref' 'MenuButtonBase' -> 'Rectangle' -> 'IO' () --

@@ -159,8 +159,8 @@ instance (impl ~  IO (Bool)) => Op (Radio ()) MenuItemBase orig impl where   runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> radio' menu_itemPtr -{# fun Fl_Menu_Item_value as value' { id `Ptr ()' } -> `Int' #}-instance (impl ~  IO (Int)) => Op (GetValue ()) MenuItemBase orig impl where+{# fun Fl_Menu_Item_value as value' { id `Ptr ()' } -> `Bool' cToBool #}+instance (impl ~  IO (Bool)) => Op (GetValue ()) MenuItemBase orig impl where   runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> value' menu_itemPtr  {# fun Fl_Menu_Item_set as set' { id `Ptr ()' } -> `()' #}@@ -239,7 +239,7 @@   runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> text' menu_itemPtr >>= cStringToText  {# fun Fl_Menu_Item_pulldown_with_args as pulldownWithArgs' { id `Ptr ()',`Int',`Int',`Int',`Int',id `Ptr ()', id `Ptr ()', id `Ptr ()', fromBool `Bool'} -> `Ptr ()' id #}-instance (Parent a MenuPrimBase, Parent b MenuItemBase, Parent c MenuItemBase, impl ~ (Rectangle -> Maybe (Ref a) -> Maybe (Ref b) -> Maybe (Ref c) -> Maybe Bool -> IO (Maybe (Ref MenuItem)))) => Op (Pulldown ()) MenuItemBase orig impl where+instance (Parent a MenuPrimBase, Parent b MenuItemBase, Parent c MenuItemBase, impl ~ (Rectangle -> Maybe (Ref a) -> Maybe (Ref b) -> Maybe (Ref c) -> Maybe Bool -> IO (Maybe (Ref MenuItemBase)))) => Op (Pulldown ()) MenuItemBase orig impl where   runOp _ _ menu_item rectangle picked' template_menu title menu_barFlag =     let (x_pos, y_pos, width, height) = fromRectangle rectangle         menu_bar = maybe False id menu_barFlag@@ -409,7 +409,7 @@ -- -- getText :: 'Ref' 'MenuItemBase' -> 'IO' 'T.Text' ----- getValue :: 'Ref' 'MenuItemBase' -> 'IO' ('Int')+-- getValue :: 'Ref' 'MenuItemBase' -> 'IO' ('Bool') -- -- hide :: 'Ref' 'MenuItemBase' -> 'IO' () --@@ -423,7 +423,7 @@ -- -- popup:: ('Parent' a 'MenuItemBase', 'Parent' b 'MenuPrimBase', 'Parent' c 'MenuItemBase') => 'Ref' 'MenuItemBase' -> 'Position' -> 'Maybe' 'T.Text' -> 'Maybe' ('Ref' a) -> 'Maybe' ('Ref' b) -> 'IO' ('Maybe' ('Ref' c)) ----- pulldown:: ('Parent' a 'MenuPrimBase', 'Parent' b 'MenuItemBase', 'Parent' c 'MenuItemBase') => 'Ref' 'MenuItemBase' -> 'Rectangle' -> 'Maybe' ('Ref' a) -> 'Maybe' ('Ref' b) -> 'Maybe' ('Ref' c) -> 'Maybe' 'Bool' -> 'IO' ('Maybe' ('Ref' 'MenuItem'))+-- pulldown:: ('Parent' a 'MenuPrimBase', 'Parent' b 'MenuItemBase', 'Parent' c 'MenuItemBase') => 'Ref' 'MenuItemBase' -> 'Rectangle' -> 'Maybe' ('Ref' a) -> 'Maybe' ('Ref' b) -> 'Maybe' ('Ref' c) -> 'Maybe' 'Bool' -> 'IO' ('Maybe' ('Ref' 'MenuItemBase')) -- -- radio :: 'Ref' 'MenuItemBase' -> 'IO' ('Bool') --

@@ -142,7 +142,7 @@   {# fun Fl_Tabs_value as value' { id `Ptr ()' } -> `Ptr ()' id #}-instance (impl ~ (IO (Maybe (Ref Widget)))) => Op (GetValue ()) TabsBase orig impl where+instance (impl ~ (IO (Maybe (Ref WidgetBase)))) => Op (GetValue ()) TabsBase orig impl where    runOp _ _ tabs = withRef tabs $ \tabsPtr -> value' tabsPtr >>= toMaybeRef  {# fun Fl_Tabs_set_value as setValue' { id `Ptr ()',id `Ptr ()' } -> `Int' #}@@ -150,7 +150,7 @@    runOp _ _ tabs w = withRef tabs $ \tabsPtr -> withMaybeRef w $ \wPtr -> setValue' tabsPtr wPtr >>= return . successOrNoChange  {# fun Fl_Tabs_push as push' { id `Ptr ()' } -> `Ptr ()' id #}-instance (impl ~ (IO (Maybe (Ref Widget)))) => Op (GetPush ()) TabsBase orig impl where+instance (impl ~ (IO (Maybe (Ref WidgetBase)))) => Op (GetPush ()) TabsBase orig impl where    runOp _ _ tabs = withRef tabs $ \tabsPtr -> push' tabsPtr >>= toMaybeRef  {# fun Fl_Tabs_set_push as setPush' { id `Ptr ()',id `Ptr ()' } -> `Int' #}@@ -158,7 +158,7 @@    runOp _ _ tabs w = withRef tabs $ \tabsPtr -> withMaybeRef w $ \wPtr -> setPush' tabsPtr wPtr >>= return . successOrNoChange  {# fun Fl_Tabs_which as which' { id `Ptr ()',`Int',`Int' } -> `Ptr ()' id #}-instance (impl ~ (Position -> IO (Maybe (Ref Widget)))) => Op (Which ()) TabsBase orig impl where+instance (impl ~ (Position -> IO (Maybe (Ref WidgetBase)))) => Op (Which ()) TabsBase orig impl where    runOp _ _ tabs (Position (X event_x) (Y event_y)) = withRef tabs $ \tabsPtr -> which' tabsPtr event_x event_y >>= toMaybeRef  {# fun Fl_Tabs_client_area_with_tabh as clientAreaWithTabh' { id `Ptr ()', alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*, `Int'} -> `()' #}@@ -233,11 +233,11 @@ -- -- draw :: 'Ref' 'TabsBase' -> 'IO' () ----- getPush :: 'Ref' 'TabsBase' -> 'IO' ('Maybe' ('Ref' 'Widget'))+-- getPush :: 'Ref' 'TabsBase' -> 'IO' ('Maybe' ('Ref' 'WidgetBase')) -- -- getTabAlign :: 'Ref' 'TabsBase' -> 'IO' ('AlignType') ----- getValue :: 'Ref' 'TabsBase' -> 'IO' ('Maybe' ('Ref' 'Widget'))+-- getValue :: 'Ref' 'TabsBase' -> 'IO' ('Maybe' ('Ref' 'WidgetBase')) -- -- handle :: 'Ref' 'TabsBase' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) --@@ -257,5 +257,5 @@ -- -- tabPositions :: 'Ref' 'TabsBase' -> 'IO' 'AtIndex' ----- which :: 'Ref' 'TabsBase' -> 'Position' -> 'IO' ('Maybe' ('Ref' 'Widget'))+-- which :: 'Ref' 'TabsBase' -> 'Position' -> 'IO' ('Maybe' ('Ref' 'WidgetBase')) -- @

@@ -424,8 +424,8 @@ instance (impl ~ (IO ())) => Op (Deactivate ()) WidgetBase orig impl where   runOp _ _ widget = withRef widget $ \widgetPtr -> deactivate' widgetPtr {# fun Fl_Widget_output as output' { id `Ptr ()' } -> `Int' #}-instance (impl ~ (IO (Int))) => Op (GetOutput ()) WidgetBase orig impl where-  runOp _ _ widget = withRef widget $ \widgetPtr -> output' widgetPtr+instance (impl ~ (IO (Bool))) => Op (GetOutput ()) WidgetBase orig impl where+  runOp _ _ widget = withRef widget $ \widgetPtr -> ((==) 0) <$> output' widgetPtr {# fun Fl_Widget_set_output as setOutput' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (SetOutput ()) WidgetBase orig impl where   runOp _ _ widget = withRef widget $ \widgetPtr -> setOutput' widgetPtr@@ -669,7 +669,7 @@ -- -- drawFocus :: 'Ref' 'WidgetBase' -> 'Maybe' ('Boxtype', 'Rectangle') -> 'IO' () ----- drawLabel :: 'Ref' 'WidgetBase' -> 'Maybe' ('Rectangle,Alignments') -> 'IO' ()+-- drawLabel :: 'Ref' 'WidgetBase' -> 'Maybe' ('Rectangle', 'Alignments') -> 'IO' () -- -- flags :: 'Ref' 'WidgetBase' -> 'IO' ['WidgetFlag'] --@@ -681,7 +681,7 @@ -- -- getColor :: 'Ref' 'WidgetBase' -> 'IO' ('Color') ----- getDamage :: 'Ref' 'WidgetBase' -> 'IO' (['Damage')]+-- getDamage :: 'Ref' 'WidgetBase' -> 'IO' (['Damage']) -- -- getDeimage :: 'Ref' 'WidgetBase' -> 'IO' ('Maybe' ('Ref' 'Image')) --

@@ -331,12 +331,12 @@   runOp _ _ win = withRef win $ \winPtr -> iconize' winPtr  {# fun Fl_Window_x_root as xRoot' { id `Ptr ()' } -> `Int' #}-instance (impl ~ ( IO (Int))) => Op (GetXRoot ()) WindowBase orig impl where-  runOp _ _ win = withRef win $ \winPtr -> xRoot' winPtr+instance (impl ~ ( IO (X))) => Op (GetXRoot ()) WindowBase orig impl where+  runOp _ _ win = withRef win $ \winPtr -> xRoot' winPtr >>= return . X  {# fun Fl_Window_y_root as yRoot' { id `Ptr ()' } -> `Int' #}-instance (impl ~ ( IO (Int))) => Op (GetYRoot ()) WindowBase orig impl where-  runOp _ _ win = withRef win $ \winPtr -> yRoot' winPtr+instance (impl ~ ( IO (Y))) => Op (GetYRoot ()) WindowBase orig impl where+  runOp _ _ win = withRef win $ \winPtr -> yRoot' winPtr >>= return . Y  {# fun Fl_Window_current as current' {  } -> `Ptr ()' id #} currentWindow ::  (Parent a WindowBase) => IO (Ref a)@@ -515,11 +515,11 @@ -- -- getType_ :: 'Ref' 'WindowBase' -> 'IO' ('WindowType') ----- getXRoot :: 'Ref' 'WindowBase' -> 'IO' ('Int')+-- getXRoot :: 'Ref' 'WindowBase' -> 'IO' ('X') -- -- getXclass :: 'Ref' 'WindowBase' -> 'IO' 'T.Text' ----- getYRoot :: 'Ref' 'WindowBase' -> 'IO' ('Int')+-- getYRoot :: 'Ref' 'WindowBase' -> 'IO' ('Y') -- -- handle :: 'Ref' 'WindowBase' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) --

@@ -95,6 +95,9 @@  -- $hierarchy -- @+-- "Graphics.UI.FLTK.LowLevel.Base.Widget"+--  |+--  v -- "Graphics.UI.FLTK.LowLevel.Widget" --  | --  v

@@ -1220,6 +1220,10 @@ -- pointer to some initialized but empty chunk of memory and filling it up. The -- corresponding Haskell function just returns a 'Data.Text'. --+-- (5) Widget destructors can be called explicitly with 'destroy'. The reason it+-- is called 'destroy' instead of 'delete' to match C++ is that it is a mistake+-- and it's too late to change it now.+-- -- -- It is hoped that until the documentation becomes more self-sustaining the -- user can use these heuristics (and the type signatures) along with the

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, EmptyDataDecls, ExistentialQuantification #-}+{-# LANGUAGE CPP, EmptyDataDecls, ExistentialQuantification, RoleAnnotations #-}  #ifdef CALLSTACK_AVAILABLE {-# LANGUAGE ImplicitParams #-}@@ -265,6 +265,7 @@ newtype NumRestyled = NumRestyled Int deriving (Show, Eq, Ord) newtype DeletedText = DeletedText T.Text deriving (Show, Eq, Ord) +type role Ref nominal data Ref a           = Ref !(ForeignPtr (Ptr ())) deriving (Eq, Show, Ord) data FunRef          = FunRef !(FunPtr ()) -- * The FLTK widget hierarchy

@@ -2144,7 +2144,7 @@ type instance Functions DoubleWindowBase = DoubleWindowBaseFuncs  data CDoubleWindow parent-type DoubleWindow = CDoubleWindow WindowBase+type DoubleWindow = CDoubleWindow DoubleWindowBase type DoubleWindowFuncs =   (Destroy   (Flush@@ -2484,7 +2484,7 @@ type instance Functions FillSliderBase = ()  data CFillSlider parent-type FillSlider = CFillSlider SliderBase+type FillSlider = CFillSlider FillSliderBase  type instance Functions FillSlider = () @@ -4733,7 +4733,7 @@ type instance Functions ScrolledBase = ScrolledBaseFuncs  data CScrolled parent-type Scrolled = CScrolled Group+type Scrolled = CScrolled ScrolledBase type ScrolledFuncs =   (Resize   (Draw

@@ -41,6 +41,7 @@  {# fun Fl_Window_flush as flush' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ ( IO ())) => Op (Flush ()) Window orig impl where+  runOp _ _ window = withRef window $ \windowPtr -> flush' windowPtr  -- $hierarchy -- @@@ -53,7 +54,7 @@ -- "Graphics.UI.FLTK.LowLevel.Base.Window" --  | --  v--- "Graphics.UI.FLTK.LowLevel.Window"runOp _ _ window = withRef window $ \windowPtr -> flush' windowPtr+-- "Graphics.UI.FLTK.LowLevel.Window" -- @  -- $functions