From bd426616111f264c3c5e6101719ceae419e48e1b Mon Sep 17 00:00:00 2001 From: ianwookim Date: Sat, 17 Dec 2011 02:44:00 +0000 Subject: [PATCH] refactor out Builder.hs to xournal-builder package.. Custom build supporting pkg-config check for gtk+-2.0 --- Config.hs | 91 ++++++++++++++++++++++ Setup.lhs | 13 ++-- hxournal.cabal | 11 ++- lib/Application/HXournal/Builder.hs | 75 ------------------ lib/Application/HXournal/Coroutine/File.hs | 2 +- lib/Application/HXournal/Job.hs | 5 +- 6 files changed, 109 insertions(+), 88 deletions(-) create mode 100644 Config.hs delete mode 100644 lib/Application/HXournal/Builder.hs diff --git a/Config.hs b/Config.hs new file mode 100644 index 0000000..d1f1e13 --- /dev/null +++ b/Config.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Config where + +import Data.List +import Data.Maybe + +import Control.Applicative +import Control.Monad + + +import Distribution.Simple +import Distribution.Simple.BuildPaths + +import Distribution.Simple.Setup +import Distribution.PackageDescription +import Distribution.Simple.LocalBuildInfo + +import Distribution.System + +import System.Exit +import System.Process + +import System.FilePath +import System.Directory + +import System.Info + +myConfigHook :: UserHooks +myConfigHook = simpleUserHooks { + confHook = hookfunction +} + +hookfunction :: (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags + -> IO LocalBuildInfo +hookfunction x cflags = do + binfo <- confHook simpleUserHooks x cflags + let pkg_descr = localPkgDescr binfo + r_pbi <- config binfo + let newbinfo = + case r_pbi of + Just pbi -> binfo { localPkgDescr = + updatePackageDescription pbi pkg_descr } + Nothing -> do + let r_lib = library pkg_descr + case r_lib of + Just lib -> + let binfo2 = libBuildInfo lib + newlib = lib { libBuildInfo = binfo2 { cSources = [] }} + in binfo {localPkgDescr = pkg_descr {library = Just newlib}} + Nothing -> error "some library setting is wrong." + return newbinfo + + +config :: LocalBuildInfo -> IO (Maybe HookedBuildInfo) +config bInfo = do + (excode,out,err) <- readProcessWithExitCode "pkg-config" ["--cflags", "gtk+-2.0"] "" + incdirs <- case excode of + ExitSuccess -> return . extractIncDir $ out + _ -> error $ ("failure when running pkg-config --cflags gtk+-2.0 :\n" ++ err) + + + let Just lib = library . localPkgDescr $ bInfo + buildinfo = libBuildInfo lib + let hbi = emptyBuildInfo { extraLibs = extraLibs buildinfo + , extraLibDirs = extraLibDirs buildinfo + , includeDirs = incdirs ++ includeDirs buildinfo + } + let (r :: Maybe HookedBuildInfo) = Just (Just hbi, []) + -- putStrLn $ show hbi + return r + +-- data CFlagsOptionSet = CFlagsOptionSet { +-- includedirs :: [String] +-- others :: [String] +-- } + +extractIncDir :: String -> [String] +extractIncDir = (mapMaybe parseCFlags) . words + +parseCFlags :: String -> Maybe String +parseCFlags [] = Nothing +parseCFlags str@(x:xs) = + case x of + '-' -> if null xs + then Nothing + else let (y:ys) = xs + in case y of + 'I' -> Just ys + _ -> Nothing + _ -> Nothing \ No newline at end of file diff --git a/Setup.lhs b/Setup.lhs index c2e69c6..de9e0b1 100644 --- a/Setup.lhs +++ b/Setup.lhs @@ -1,10 +1,9 @@ #! /usr/bin/env runhaskell - +> > import Distribution.Simple > import Distribution.PackageDescription -> --import System.Process -> main = defaultMain -> --main = defaultMainWithHooks testUserHooks -> --testUserHooks = simpleUserHooks { -> -- preConf = \_ _ -> runCommand "cd rootcode; make; cd .." >>return emptyHookedBuildInfo -> -- } +> import Config +> +> main :: IO () +> main = defaultMainWithHooks myConfigHook +> diff --git a/hxournal.cabal b/hxournal.cabal index e3ded3f..e7d14bd 100644 --- a/hxournal.cabal +++ b/hxournal.cabal @@ -9,11 +9,12 @@ Author: Ian-Woo Kim Maintainer: Ian-Woo Kim Category: Application Tested-with: GHC == 7.0.3 -Build-Type: Simple +Build-Type: Custom Cabal-Version: >= 1.8 data-files: template/*.html.st resource/*.png CHANGES + Config.hs Source-repository head type: git location: https://www.github.com/wavewave/hxournal @@ -46,9 +47,9 @@ Library xournal-types == 0.1.*, xournal-parser >= 0.2.999 && < 0.4, xournal-render >= 0.2.999 && < 0.4, + xournal-builder == 0.1.*, containers == 0.4.*, template-haskell == 2.*, - blaze-builder == 0.3.*, bytestring == 0.9.*, double-conversion == 0.2.*, fclabels == 1.0.*, @@ -56,6 +57,7 @@ Library configurator == 0.1.* -- >= 0.1 && < 0.3 + -- blaze-builder == 0.3.*, Exposed-Modules: Application.HXournal.ProgType Application.HXournal.Job @@ -95,9 +97,12 @@ Library Application.HXournal.Util.Verbatim Application.HXournal.Draw Application.HXournal.Device - Application.HXournal.Builder Application.HXournal.Accessor Application.HXournal.Config + + -- Application.HXournal.Builder + + Other-Modules: Paths_hxournal c-sources: diff --git a/lib/Application/HXournal/Builder.hs b/lib/Application/HXournal/Builder.hs deleted file mode 100644 index e35282e..0000000 --- a/lib/Application/HXournal/Builder.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Application.HXournal.Builder where - -import Data.Xournal.Simple -import qualified Data.ByteString as S -import qualified Data.ByteString.Lazy as L -import Blaze.ByteString.Builder -import Blaze.ByteString.Builder.Char8 (fromChar) -import Data.Double.Conversion.ByteString -import Data.Monoid -import Data.Strict.Tuple - -infixl 4 <> - -(<>) :: Monoid a => a -> a -> a -(<>) = mappend - - -builder :: Xournal -> L.ByteString -builder = toLazyByteString . fromXournal - -fromXournal :: Xournal -> Builder -fromXournal xoj = fromByteString "\n\n" - <> fromTitle (xoj_title xoj) <> mconcat (map fromPage (xoj_pages xoj)) - <> fromByteString "\n" - -fromTitle :: S.ByteString -> Builder -fromTitle title = fromByteString "" - <> fromByteString title - <> fromByteString "\n" - - -fromPage :: Page -> Builder -fromPage page = fromByteString " fromByteString (toFixed 2 w) - <> fromByteString "\" height=\"" - <> fromByteString (toFixed 2 h) - <> fromByteString "\">\n" - <> fromBackground (page_bkg page) - <> mconcat (map fromLayer (page_layers page)) - <> fromByteString "\n" - where Dim w h = page_dim page - -fromBackground :: Background -> Builder -fromBackground bkg = fromByteString " fromByteString (bkg_type bkg) - <> fromByteString "\" color=\"" - <> fromByteString (bkg_color bkg) - <> fromByteString "\" style=\"" - <> fromByteString (bkg_style bkg) - <> fromByteString "\"/>\n" - - -fromLayer :: Layer -> Builder -fromLayer layer = fromByteString "\n" - <> mconcat (map fromStroke (layer_strokes layer)) - <> fromByteString "\n" - -fromStroke :: Stroke -> Builder -fromStroke stroke = fromByteString " fromByteString (stroke_tool stroke) - <> fromByteString "\" color=\"" - <> fromByteString (stroke_color stroke) - <> fromByteString "\" width=\"" - <> fromByteString (toFixed 2 (stroke_width stroke)) - <> fromByteString "\">\n" - <> mconcat (map fromCoord (stroke_data stroke)) - <> fromByteString "\n\n" - -fromCoord :: Pair Double Double -> Builder -fromCoord (x :!: y) = fromByteString (toFixed 2 x) - <> fromChar ' ' - <> fromByteString (toFixed 2 y) - <> fromChar ' ' diff --git a/lib/Application/HXournal/Coroutine/File.hs b/lib/Application/HXournal/Coroutine/File.hs index fbe1a0e..c7552d7 100644 --- a/lib/Application/HXournal/Coroutine/File.hs +++ b/lib/Application/HXournal/Coroutine/File.hs @@ -7,7 +7,7 @@ import Application.HXournal.Accessor import Application.HXournal.ModelAction.File import Application.HXournal.Coroutine.Draw import Application.HXournal.ModelAction.Window -import Application.HXournal.Builder +import Text.Xournal.Builder import Control.Monad.Trans import Control.Applicative import Data.Xournal.Generic diff --git a/lib/Application/HXournal/Job.hs b/lib/Application/HXournal/Job.hs index 0b518f9..f89df22 100644 --- a/lib/Application/HXournal/Job.hs +++ b/lib/Application/HXournal/Job.hs @@ -3,7 +3,7 @@ module Application.HXournal.Job where import Application.HXournal.GUI -import Application.HXournal.Builder +-- import Application.HXournal.Builder import qualified Data.ByteString.Lazy as L import Text.Xournal.Parse @@ -12,9 +12,10 @@ startJob mfname = do putStrLn "job started" startGUI mfname +{- startTestBuilder :: FilePath -> IO () startTestBuilder fname = do putStrLn fname xojcontent <- read_xojgz fname L.writeFile "mytest.xoj" $ builder xojcontent - +-}