packages feed

gtk3-helpers (empty) → 0.1.0

raw patch · 9 files changed

+400/−0 lines, 9 filesdep +arraydep +basedep +directorysetup-changed

Dependencies added: array, base, directory, filepath, gio, glib, gtk3, hlint, mtl, process, regex-posix, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ivan Perez (Keera Studios) 2010-2012++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ivan Perez nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ gtk3-helpers.cabal view
@@ -0,0 +1,89 @@+Name:                gtk3-helpers+Version:             0.1.0+Synopsis:            A collection of auxiliary operations and widgets related to Gtk+Description:         A collection of auxiliary operations and widgets related to Gtk+.+Homepage:            http://keera.co.uk/blog/community+License:             BSD3+License-file:        LICENSE+Author:              Ivan Perez+Maintainer:          ivan.perez@keera.co.uk+-- Copyright:+Stability:           Experimental+Category:            Graphics+Build-type:          Simple+-- Extra-source-files:+cabal-version: >= 1.10++Library+  default-language: Haskell2010++  -- Exposed-modules:+  Build-depends:       base >=4 && < 5, template-haskell, process, gtk3, gio, glib, mtl, array+  -- Other-modules:+  hs-source-dirs:      src/+  -- Build-tools:+  ghc-options: -Wall++  exposed-modules:+                 -- Data.Board.GameBoardIO+                 -- , Game.Board.BasicTurnGame+                 -- , Graphics.UI.Gtk.Board.TiledBoard+                 -- , Graphics.UI.Gtk.Board.BoardLink+                 -- , Graphics.UI.Gtk.Entry.FormatEntry+                 -- , Graphics.UI.Gtk.Entry.HighlightedEntry+                   Graphics.UI.Gtk.Extra.Builder+                 , Graphics.UI.Gtk.Extra.BuilderTH+                 , Graphics.UI.Gtk.Helpers.Combo+                 -- , Graphics.UI.Gtk.Helpers.FileDialog+                 -- , Graphics.UI.Gtk.Helpers.MenuItem+                 -- , Graphics.UI.Gtk.Helpers.MessageDialog+                 -- , Graphics.UI.Gtk.Helpers.ModelViewNotebookSync+                 -- , Graphics.UI.Gtk.Helpers.ModelViewPath+                 -- , Graphics.UI.Gtk.Helpers.Multiline.TextBuffer+                 -- , Graphics.UI.Gtk.Helpers.Pixbuf+                 -- , Graphics.UI.Gtk.Helpers.TreeView+                 -- , Graphics.UI.Gtk.Layout.BackgroundContainer+                 -- , Graphics.UI.Gtk.Layout.DummyBin+                 -- , Graphics.UI.Gtk.Layout.EitherWidget+                 -- , Graphics.UI.Gtk.Layout.MaybeWidget+                 , System.Application++-- You can disable the hlint test suite with -f-test-hlint+flag test-hlint+  default: False+  manual: True++-- You can disable the haddock coverage test suite with -f-test-doc-coverage+flag test-doc-coverage+  default: False+  manual: True++test-suite hlint+  type: exitcode-stdio-1.0+  main-is: hlint.hs+  default-language: Haskell2010+  hs-source-dirs: tests+  if !flag(test-hlint)+    buildable: False+  else+    build-depends:+      base,+      hlint >= 1.7++-- Verify that the code is thoroughly documented+test-suite haddock-coverage+  type: exitcode-stdio-1.0+  main-is: HaddockCoverage.hs+  default-language: Haskell2010+  ghc-options: -Wall+  hs-source-dirs: tests++  if !flag(test-doc-coverage)+    buildable: False+  else+    build-depends:+      base >= 4 && < 5,+      directory,+      filepath,+      process,+      regex-posix
+ src/Graphics/UI/Gtk/Extra/Builder.hs view
@@ -0,0 +1,39 @@+-- | A collection of small functions to help retrieve+-- information from Glade files.++module Graphics.UI.Gtk.Extra.Builder+   ( fromBuilder+   , loadInterface+   )+  where++import Graphics.UI.Gtk++-- | Graphics.UI.Gtk.builderGetObject with the arguments flipped+-- (Builder goes last).+fromBuilder :: (GObjectClass cls) =>+               (GObject -> cls) -> String -> Builder -> IO cls+fromBuilder f s b = builderGetObject b f s++-- | Returns a builder from which the objects in this part of the interface+-- can be accessed.+loadInterface :: String -> IO Builder+loadInterface fn = builderNew `incidentallyM` (`builderAddFromFile` fn)+-- It can be written in point-free style, but I'm not sure it's+-- clearer+-- loadInterface = incidentallyM builderNew . flip builderAddFromFile++-- -- | Returns a builder from which the objects in this part of the interface+-- --+-- -- can be accessed.+-- loadInterface :: String -> IO Builder+-- loadInterface builderPath = do+--   builder <- builderNew+--   builderAddFromFile builder builderPath+--   return builder++-- | Sequences two monadic computations and returns the+-- result of the first.+incidentallyM :: Monad m => m a -> (a -> m b) -> m a +incidentallyM op f = op >>= (\x -> (f x >> return x))+
+ src/Graphics/UI/Gtk/Extra/BuilderTH.hs view
@@ -0,0 +1,64 @@+-- | This module allows you to access Glade objects from+-- a Gtk Builder by providing the builder, the type of the+-- object and the name (the cast operation is deduced+-- automatically from the type name).+--+-- It uses Graphics.UI.Gtk.Builder.onBuilder to access a+-- glade object using TH.++module Graphics.UI.Gtk.Extra.BuilderTH+  ( gtkBuilderAccessor+  , gtkViewAccessor+  , fromBuilder+  )+ where++import Graphics.UI.Gtk.Extra.Builder (fromBuilder)+import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Lib++-- | Accessor for Glade objects from Gtk Builders by name and+-- type.+gtkBuilderAccessor :: String -> String -> Q [Dec]+gtkBuilderAccessor name kind = sequenceQ+  -- Declaration+  [ sigD funcName+         -- Builder -> IO Kind+         (appT (appT arrowT (conT (mkName "Builder")))           +               (appT (conT (mkName "IO")) (conT (mkName kind))))+  -- Implementation+  , funD funcName                                                 +         -- castedOnBuilder objectName+         [clause [] (normalB (appE castedAccess                   +                                   (litE (stringL name)))) []]+  ]++  where castedAccess = appE (varE (mkName "fromBuilder")) casting+        casting      = varE (mkName ("castTo" ++ kind))+        funcName     = mkName name++-- | Accessor for Glade objects from Gtk Builders encapsulated in+-- Views, by name and -- type.+gtkViewAccessor :: String -> String -> String -> String -> Q [Dec]+gtkViewAccessor builderModule uiAccessor name kind = sequenceQ+  -- Declaration+  [ sigD funcName+         -- Builder -> IO Kind+         (appT (appT arrowT (conT (mkName "View")))           +               (appT (conT (mkName "IO")) (conT (mkName kind))))+  -- Implementation+  , funD funcName                                                 +         -- castedOnBuilder objectName+         [clause [varP builderName]+                 (normalB (appE (varE funcNameInBuilder)+                                (appE (varE (mkName uiAccessor))+                                      (varE builderName)+                                )+                          )) []]+  ]++  where castedAccess      = appE (varE (mkName "fromBuilder")) casting+        casting           = varE (mkName ("castTo" ++ kind))+        funcName          = mkName name+        funcNameInBuilder = mkName $ builderModule ++ ('.' : name) +        builderName       = mkName "b"
+ src/Graphics/UI/Gtk/Helpers/Combo.hs view
@@ -0,0 +1,44 @@+module Graphics.UI.Gtk.Helpers.Combo where++import Data.List+import Data.Maybe+import Graphics.UI.Gtk++addTextColumn :: (TreeModelClass (model row), TypedTreeModelClass model)+                => ComboBox -> model row -> (row -> Maybe String) -> IO()+addTextColumn cb st f = do++  comboBoxSetModel cb (Just st)+  renderer <- cellRendererTextNew+  cellLayoutPackStart cb renderer True+  cellLayoutSetAttributes cb renderer st $ map (cellText :=).maybeToList.f+  return ()++type TypedComboBox a = (ComboBox, ListStore a)++typedComboBoxCombo :: TypedComboBox a -> ComboBox+typedComboBoxCombo = fst++typedComboBoxStore :: TypedComboBox a -> ListStore a+typedComboBoxStore = snd++typedComboBoxGetSelected :: TypedComboBox a -> IO (Maybe a)+typedComboBoxGetSelected (cb, ls) = do+  sel  <- get cb comboBoxActive+  list <- listStoreToList ls+  if sel < 0 || length list <= sel+   then return Nothing+   else return $ Just $ list!!sel++typedComboBoxGetSelectedUnsafe :: TypedComboBox a -> IO a+typedComboBoxGetSelectedUnsafe (cb, ls) = do+  sel  <- get cb comboBoxActive+  list <- listStoreToList ls+  return $ list!!sel++typedComboBoxSetSelected :: (Eq a) => TypedComboBox a -> a -> IO ()+typedComboBoxSetSelected (cb, ls) x = do+  list <- listStoreToList ls+  case elemIndex x list of+   Nothing -> return ()+   Just ix -> set cb [ comboBoxActive := ix ]
+ src/System/Application.hs view
@@ -0,0 +1,17 @@+module System.Application where++-- External imports+import Control.Monad+-- import Control.Monad.Extra+import System.GIO.File.AppInfo+import System.Process++-- FIXME: This uses runProcess instead of appInfoLaunchUris because+-- the latter segfaults in my machine+openUrlBySystemTool :: String -> IO Bool+openUrlBySystemTool url = do+  infos <- appInfoGetAllForType "text/html"+  unless (null infos) $ void $ do+    let exe = appInfoGetExecutable $ head infos+    runProcess exe [url] Nothing Nothing Nothing Nothing Nothing+  return (not (null infos))
+ tests/HaddockCoverage.hs view
@@ -0,0 +1,91 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (HaddockCoverage)+-- Copyright   :  (C) 2015 Ivan Perez+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Ivan Perez <ivan.perez@keera.co.uk>+-- Stability   :  provisional+-- Portability :  portable+--+-- Copyright notice: This file borrows code+-- https://hackage.haskell.org/package/lens-4.7/src/tests/doctests.hsc+-- which is itself licensed BSD-style as well.+--+-- Run haddock on a source tree and report if anything in any+-- module is not documented.+-----------------------------------------------------------------------------+module Main where++import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.Exit+import System.FilePath+import System.IO+import System.Process+import Text.Regex.Posix++main :: IO ()+main = do+  -- Find haskell modules+  -- TODO: Ideally cabal should do this (provide us with the+  -- list of modules). An alternative would be to use cabal haddock+  -- but that would need a --no-html argument or something like that.+  -- Alternatively, we could use cabal haddock with additional arguments.+  --+  -- See:+  -- https://github.com/keera-studios/haddock/commit/d5d752943c4e5c6c9ffcdde4dc136fcee967c495+  -- https://github.com/haskell/haddock/issues/309#issuecomment-150811929+  files <- getSources++  let haddockArgs = [ "--no-warnings", "--ignore-all-exports" ] ++ files+  let cabalArgs   = [ "exec", "--", "haddock" ] ++ haddockArgs+  (code, out, _err) <- readProcessWithExitCode "cabal" cabalArgs ""++  -- Filter out coverage lines, and find those that denote undocumented+  -- modules.+  --+  -- TODO: is there a way to annotate a function as self-documenting,+  -- in the same way we do with ANN for hlint?+  let isIncompleteModule :: String -> Bool+      isIncompleteModule line = isCoverageLine line && not (line =~ "^ *100%")+        where isCoverageLine :: String -> Bool+              isCoverageLine line = line =~ "^ *[0-9]+%"++  let incompleteModules :: [String]+      incompleteModules = filter isIncompleteModule $ lines out++  -- Based on the result of haddock, report errors and exit.+  -- Note that, unline haddock, this script does not+  -- output anything to stdout. It uses stderr instead+  -- (as it should).+  case (code, incompleteModules) of+    (ExitSuccess  , []) -> return ()+    -- (ExitFailure _, _)  -> exitFailure+    (_            , _)  -> do+      hPutStrLn stderr "The following modules are not fully documented:"+      mapM_ (hPutStrLn stderr) incompleteModules+      exitFailure++getSources :: IO [FilePath]+getSources = filter isHaskellFile <$> go "src"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++    isHaskellFile fp = (isSuffixOf ".hs" fp || isSuffixOf ".lhs" fp)+                     && not (any (`isSuffixOf` fp) excludedFiles)++    excludedFiles = [ ]++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c++-- find-based implementation (not portable)+--+-- getSources :: IO [FilePath]+-- getSources = fmap lines $ readProcess "find" ["src/", "-iname", "*hs"] ""
+ tests/hlint.hs view
@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (hlint)+-- Copyright   :  (C) 2013 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This module runs HLint on the lens source tree.+-----------------------------------------------------------------------------+module Main where++import Control.Monad+import Language.Haskell.HLint+import System.Environment+import System.Exit++main :: IO ()+main = do+    args <- getArgs+    hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args+    unless (null hints) exitFailure