fltkhs 0.3.0.0 → 0.3.0.1
raw patch · 7 files changed
+42/−124 lines, 7 filesdep ~parsecsetup-changed
Dependency ranges changed: parsec
Files
- .gitignore +1/−0
- Setup.hs +2/−115
- fltkhs.cabal +2/−2
- src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs +0/−1
- src/Graphics/UI/FLTK/LowLevel/Table.chs +4/−4
- src/Graphics/UI/FLTK/LowLevel/Tree.chs +2/−2
- stack.yaml +31/−0
.gitignore view
@@ -36,3 +36,4 @@ /src/Fluid/Parser.hi /src/Fluid/Types.hi /TAGS+/.stack-work/*
Setup.hs view
@@ -69,39 +69,7 @@ fltkcdir = unsafePerformIO getCurrentDirectory ++ "/c-lib" fltkclib = "fltkc"-headerdir = unsafePerformIO getCurrentDirectory ++ "/c-src"-currentdir :: FilePath-currentdir = unsafePerformIO getCurrentDirectory-getHeaders :: [FilePath]-getHeaders = unsafePerformIO $ do- contents <- getDirectoryContents headerdir- let headerFiles = filter (\f -> takeExtension f == ".h" -- keep the headers- &&- not (takeBaseName f `isPrefixOf` "Derived") -- but not the extra classes- ) contents- return headerFiles-objectFileDir = unsafePerformIO getCurrentDirectory ++ "/static_object_files"-getObjectFileDirContents = getDirectoryContents objectFileDir -addIncludeDirs pd =- let lib = (fromJust . library) pd- bi = libBuildInfo lib- ids = includeDirs bi- bi' = bi {includeDirs = ids ++ [headerdir, currentdir]}- lib' = lib {libBuildInfo = bi'}- in- pd {library = Just lib'}--addHeaders pd =- let lib = (fromJust . library) pd- bi = libBuildInfo lib- is = includes bi- headers = getHeaders- bi' = bi {includes = is ++ headers}- lib' = lib {libBuildInfo = bi'}- in- pd {library = Just lib'}- withFltkc op pd = let lib = (fromJust . library) pd bi = libBuildInfo lib@@ -112,41 +80,6 @@ in pd {library = Just lib'} -removeExecutables pd = pd {executables = []}--getHaskellObjects :: Library -> LocalBuildInfo- -> FilePath -> String -> Bool -> IO [FilePath]-getHaskellObjects lib lbi pref wanted_obj_ext allow_split_objs- | splitObjs lbi && allow_split_objs = do- let splitSuffix = if compilerVersion (compiler lbi) <- Version [6, 11] []- then "_split"- else "_" ++ wanted_obj_ext ++ "_split"- dirs = [ pref </> (ModuleName.toFilePath x ++ splitSuffix)- | x <- libModules lib ]- objss <- mapM getDirectoryContents dirs- let objs = [ dir </> obj- | (objs',dir) <- zip objss dirs, obj <- objs',- let obj_ext = takeExtension obj,- '.':wanted_obj_ext == obj_ext ]- return objs- | otherwise =- return [ pref </> ModuleName.toFilePath x <.> wanted_obj_ext- | x <- libModules lib ]---- This copy-pasta is required because Distribution.Simple.Build does--- not export buildExe.-buildExe :: Verbosity -> Distribution.Simple.Setup.Flag (Maybe Int)- -> PackageDescription -> LocalBuildInfo- -> Executable -> ComponentLocalBuildInfo -> IO ()-buildExe verbosity numJobs pkg_descr lbi exe clbi =- case compilerFlavor (compiler lbi) of- GHC -> GHC.buildExe verbosity numJobs pkg_descr lbi exe clbi- JHC -> JHC.buildExe verbosity pkg_descr lbi exe clbi- LHC -> LHC.buildExe verbosity pkg_descr lbi exe clbi- UHC -> UHC.buildExe verbosity pkg_descr lbi exe clbi- _ -> die "Building is not supported with this compiler."- myBuildHook pkg_descr local_bld_info user_hooks bld_flags = do let compileC = do putStrLn "==Compiling C bindings=="@@ -158,53 +91,8 @@ clibraries <- getDirectoryContents fltkcdir when (null $ filter (Data.List.isInfixOf "fltkc") clibraries) compileC else compileC- let new_pkg_descr- = removeExecutables . addHeaders . addIncludeDirs . withFltkc (++) $ pkg_descr- new_local_bld_info = local_bld_info{localPkgDescr = new_pkg_descr}- (libs, nonlibs)- = partition- (\ c ->- case c of- (CLibName, _, _) -> True- _ -> False)- (componentsConfigs new_local_bld_info)- lib_lbi = new_local_bld_info{componentsConfigs = libs}- buildHook defaultUserHooks new_pkg_descr lib_lbi user_hooks bld_flags- let distPref = fromFlag (buildDistPref bld_flags)- dbFile = distPref </> "package.conf.inplace"- verbosity = fromFlag (buildVerbosity bld_flags)- with_in_place- = local_bld_info{withPackageDB =- withPackageDB local_bld_info ++ [SpecificPackageDB dbFile]- }- pref = buildDir local_bld_info- withAllComponentsInBuildOrder pkg_descr with_in_place $- \ comp clbi ->- case comp of- (CLib lib) -> do cobjs <- getObjectFileDirContents >>=- return .- map (combine objectFileDir) .- filter (\ f -> case buildOS of- Windows -> takeExtension f == ".obj"- _ -> takeExtension f == ".o")- hobjs <- getHaskellObjects lib with_in_place pref objExtension True- let staticObjectFiles = hobjs ++ cobjs- (arProg, _ ) <- requireProgram verbosity arProgram- (withPrograms with_in_place)- let vanillaLibFilePath- = pref </> mkLibName (head $ componentLibraries clbi)- Ar.createArLibArchive verbosity with_in_place vanillaLibFilePath- staticObjectFiles- (CExe exe) -> do preprocessComponent pkg_descr comp- with_in_place- False- verbosity- []- buildExe verbosity (buildNumJobs bld_flags) pkg_descr- with_in_place- exe- clbi- _ -> return ()+ let new_pkg_descr = withFltkc (++) pkg_descr+ buildHook defaultUserHooks new_pkg_descr local_bld_info user_hooks bld_flags copyCBindings :: PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO () copyCBindings pkg_descr lbi uhs flags = do@@ -217,7 +105,6 @@ case buildOS of Linux -> rawSystemExit (fromFlag $ copyVerbosity flags) "cp" ["c-lib/libfltkcdyn.so", libPref]- myCleanHook pd x uh cf = do rawSystemExit normal "make" ["clean"]
fltkhs.cabal view
@@ -1,5 +1,5 @@ name : fltkhs-version : 0.3.0.0+version : 0.3.0.1 synopsis : FLTK bindings description: Low level bindings for the FLTK GUI toolkit.@@ -121,7 +121,7 @@ base == 4.*, filepath, fltkhs,- parsec,+ parsec >= 3.1.6, mtl default-language: Haskell2010 ghc-Options: -Wall -threaded -fcontext-stack=300
src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs view
@@ -172,7 +172,6 @@ ) where import C2HS-import System.IO.Unsafe #c enum VersionInfo { MajorVersion = FL_MAJOR_VERSION,
src/Graphics/UI/FLTK/LowLevel/Table.chs view
@@ -111,10 +111,10 @@ CustomWidgetFuncs a -> CustomTableFuncs b -> IO (Ptr ())-tableCustomFunctionStruct draw' drawCell' customWidgetFuncs' customTableFuncs' =+tableCustomFunctionStruct draw'' drawCell' customWidgetFuncs' customTableFuncs' = do ptr <- virtualFuncs'- fillCustomWidgetFunctionStruct ptr draw' customWidgetFuncs'+ fillCustomWidgetFunctionStruct ptr draw'' customWidgetFuncs' fillCustomTableFunctionStruct ptr drawCell' customTableFuncs' return ptr @@ -127,10 +127,10 @@ -> CustomWidgetFuncs Table -- ^ Widget overrides -> CustomTableFuncs Table -- ^ Table overrides -> IO (Ref Table)-tableCustom rectangle label' draw' drawCell' customWidgetFuncs' customTableFuncs' =+tableCustom rectangle label' draw'' drawCell' customWidgetFuncs' customTableFuncs' = do let (x_pos, y_pos, width, height) = fromRectangle rectangle- ptr <- tableCustomFunctionStruct draw' (Just drawCell') customWidgetFuncs' customTableFuncs'+ ptr <- tableCustomFunctionStruct draw'' (Just drawCell') customWidgetFuncs' customTableFuncs' case label' of (Just l') -> tableNewWithLabel' x_pos y_pos width height l' ptr >>= toRef Nothing -> tableNew' x_pos y_pos width height ptr >>= toRef
src/Graphics/UI/FLTK/LowLevel/Tree.chs view
@@ -113,8 +113,8 @@ runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> nextWithItem' treePtr itemPtr >>= toMaybeRef {# fun Fl_Tree_next_item as nextItem' { id `Ptr ()',id `Ptr ()', id `CInt', cFromBool `Bool'} -> `Ptr ()' id #} instance (impl ~ (Ref TreeItem -> Maybe SearchDirection -> Bool -> IO (Maybe (Ref TreeItem))) ) => Op (NextItem ()) Tree orig impl where- runOp _ _ tree item dir visible =- withRef tree $ \treePtr -> withRef item $ \itemPtr -> nextItem' treePtr itemPtr (maybe 0 (fromIntegral . fromEnum) dir) visible+ runOp _ _ tree item dir visible' =+ withRef tree $ \treePtr -> withRef item $ \itemPtr -> nextItem' treePtr itemPtr (maybe 0 (fromIntegral . fromEnum) dir) visible' >>= toMaybeRef {# fun Fl_Tree_prev as prev' { id `Ptr ()' } -> `Ptr ()' id #} instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (Prev ()) Tree orig impl where
+ stack.yaml view
@@ -0,0 +1,31 @@+# For more information, see: https://github.com/commercialhaskell/stack/blob/master/doc/yaml_configuration.md++# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)+resolver: lts-3.8++# Local packages, usually specified by relative directory name+packages:+- '.'++# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags:+ fltkhs:+ fastcompile: true++# Control whether we use the GHC we find on the path+# system-ghc: true++# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: >= 0.1.4.0++# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64++# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]