packages feed

manatee-core 0.0.6 → 0.0.7

raw patch · 7 files changed

+296/−24 lines, 7 filesdep +ghcdep +ghc-paths

Dependencies added: ghc, ghc-paths

Files

Manatee/Core/Config.hs view
@@ -58,6 +58,10 @@ extensionGlobalKeymapPath :: FilePath extensionGlobalKeymapPath = "core/extensionGlobalKeymap" +-- | Customize path.+configPath :: FilePath+configPath = "config"+ -- | Write config file. writeConfig :: Binary a => FilePath -> a -> IO () writeConfig path config = do
+ Manatee/Core/Dynload.hs view
@@ -0,0 +1,229 @@+-- Author:     Andy Stewart <lazycat.manatee@gmail.com>+-- Maintainer: Andy Stewart <lazycat.manatee@gmail.com>+-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved.+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.++{-#Language ScopedTypeVariables#-}+{-# LANGUAGE DeriveDataTypeable #-}+module Manatee.Core.Dynload where++import Control.Concurrent+import Control.Monad+import Data.Maybe (fromMaybe)+import Data.Typeable+import DynFlags+import Exception+import GHC+import GHC.Paths (libdir)+import Manatee.Core.Config+import Manatee.Core.Types+import System.Directory+import System.FilePath++import Data.List+import System.Exit+import System.Process+import HscTypes+import OccName+import Module+import BinIface+import HscMain hiding (compileExpr)+import TcRnMonad++data EmptyCustomize = +    EmptyCustomize +    deriving Typeable++instance Customize EmptyCustomize where+  customizeConfigFile _ = ""+  customizeLoad       _ = []++-- | Empty customize new.+emptyCustomizeNew :: IO CustomizeWrap+emptyCustomizeNew = +  return (CustomizeWrap EmptyCustomize)++-- | Cast customize.+castCustomize :: Typeable b => CustomizeWrap -> b+castCustomize (CustomizeWrap c) =+    fromMaybe (error "castCustomize : impossible failed.") (cast c)+ +-- | Dynamic loading module in running program.+dynload :: (String, String, [(String, HValue -> IO ())]) -> IO ()+dynload (filepath, moduleName, loadList) = +   defaultErrorHandler defaultDynFlags $ +      runGhc (Just libdir) $ +        ghandle +          -- Avoid exception when dynamic loading.+          (\ (e :: SomeException) -> liftIO $ putStrLn $ "# " ++ show e)+          (do                   +             -- Set DynFlags.+             dFlags <- getSessionDynFlags +             setSessionDynFlags dFlags {ghcLink = LinkInMemory} -- this step is necessary+             -- Load module.+             target <- guessTarget filepath Nothing+             setTargets [target]+             r <- load (LoadUpTo (mkModuleName moduleName))+             -- Check.+             case r of+                 Failed ->+                     liftIO $ putStrLn $ "* Load module " ++ moduleName ++ " failed."+                 Succeeded -> do+                     liftIO $ putStrLn $ "* Load module " ++ moduleName ++ " success."+                     -- Find module.+                     m <- findModule (mkModuleName moduleName) Nothing+                     -- Set context.+                     setContext [] [m]+                     -- Load value.+                     forM_ loadList $ \ (symbolName, loadFun) -> +                         ghandle +                           -- Skip current symbol if get error when compileExpr.+                           (\ (e :: SomeException) -> +                             liftIO $ putStrLn $ "# Get error and skip symbol `" ++ symbolName ++ "`\n    " ++ show e)+                           (do+                             hValue <- compileExpr (moduleName ++ "." ++ symbolName)+                             liftIO $ loadFun hValue))++-- | Load user config.+loadConfig :: CustomizeWrap -> Bool -> IO ()+loadConfig (CustomizeWrap customize) isAsync = do+  -- Get configure directory.+  configDir <- getConfigDirectory+  -- Init.+  let configFile = customizeConfigFile customize+      filepath = configDir </> configPath </> configFile+      configLoad = customizeLoad customize+      load = do+        putStrLn $ "* Loading configure file : " ++ filepath+        dynload (filepath, "Config.User", configLoad)+  isExist <- doesFileExist filepath++  -- Try load user's configure file.+  if null configLoad+     -- Skip load if no customize option. +     then putStrLn "No customize option, skip load configure file."+     else if isExist+             -- Load config file.+             then if isAsync then forkIO load >> return () else load+             -- Skip load if no configure file exist.+             else putStrLn $ "Config file `" ++ filepath ++ "` no exist, use default customize option."++-- | Generate config file.+generateConfig :: String -> [String] -> IO ()+generateConfig configFile scanList = do+  -- Get directory.+  configDir <- getConfigDirectory+  let configHsFile = configDir </> configPath </> configFile+      configHiFile = replaceExtension configHsFile ".hi"+  isHsFileExist <- doesFileExist configHsFile+  isHiFileExist <- doesFileExist configHiFile+  -- Detect user configure file.+  scanUser <- +      if isHsFileExist+         then do +           processHandle <- runCommand ("ghc --make " ++ configHsFile)+           exitCode <- waitForProcess processHandle+           case exitCode of+             ExitSuccess -> return True+             ExitFailure _ -> do+                 putStrLn $ configHsFile ++ " compile failed, skip user's configure file."+                 return False+         else do +           putStrLn $ configHsFile ++ " no exist, skip scan user's configure file."+           return False+  -- Generate User.hs and Import.hs.+  if scanUser && isHiFileExist+     then do+       -- Copy user's configure file.+       readFile configHsFile >>= writeFile "./Config/User.hs"  +       -- Get export list.+       moduleInterface <- readBinIface' configHiFile+       let ifaceExport = mi_exports moduleInterface+           exports = map (\ (mod, items) -> +                            (Module.moduleNameString $ Module.moduleName mod+                            ,concatMap (\item -> +                                            case item of+                                              Avail name -> [occNameString name]+                                              AvailTC _ list -> +                                                  map occNameString list+                                       ) items)+                         ) ifaceExport+           (((_, exportList):_), _) = partition (\ (mName, _) -> mName == "Config.User") exports+       -- Generate Import.hs+       writeFile "./Config/Import.hs" $ generateImportString (filter (\x -> x `elem` scanList) exportList) scanList+     else do+       -- Generate User.hs and Import.hs+       writeFile "./Config/User.hs" emptyUserString+       writeFile "./Config/Import.hs" $ emptyImportString scanList++-- | Read binary interface file to get module information.+readBinIface' :: FilePath -> IO ModIface+readBinIface' hi_path = do+    e <- newHscEnv defaultCallbacks undefined+    initTcRnIf 'r' e undefined undefined (readBinIface IgnoreHiWay QuietBinIFaceReading hi_path)++-- | Concat improt, convert ["a","b","c"] to (a, b, c)+concatImport :: [String] -> String+concatImport []  = ""+concatImport [x] = x+concatImport (x:xs) = +  (x ++ ", ") ++ concatImport xs++-- | Emtpy user string.+emptyUserString :: String+emptyUserString = +    copyrightString+ ++ "module Config.User where"++-- | Emtpy import string.+emptyImportString :: [String] -> String+emptyImportString scanList = +    copyrightString+ ++ "module Config.Import "+ ++ "(" ++ concatImport scanList ++ ") where \n\n"+ ++ "import Config.Default"++-- | Generate import string.+generateImportString :: [String] -> [String] -> String+generateImportString [] scanList = +    emptyImportString scanList+generateImportString exportList scanList =+    copyrightString+ ++ "module Config.Import "+ ++ "(" ++ concatImport scanList ++ ") where \n\n"+ ++ "import Config.User (" ++ concatImport exportList ++ ")\n"+ ++ "import Config.Default hiding (" ++ concatImport exportList ++ ")\n"++-- | Copyright string.+copyrightString :: String+copyrightString = +     "-- Author:     Andy Stewart <lazycat.manatee@gmail.com>"+  ++ "\n-- Maintainer: Andy Stewart <lazycat.manatee@gmail.com>"+  ++ "\n-- "+  ++ "\n-- Copyright (C) 2010 Andy Stewart, all rights reserved."+  ++ "\n-- "+  ++ "\n-- This program is free software: you can redistribute it and/or modify"+  ++ "\n-- it under the terms of the GNU General Public License as published by"+  ++ "\n-- the Free Software Foundation, either version 3 of the License, or"+  ++ "\n-- any later version."+  ++ "\n-- "+  ++ "\n-- This program is distributed in the hope that it will be useful,"+  ++ "\n-- but WITHOUT ANY WARRANTY; without even the implied warranty of"+  ++ "\n-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the"+  ++ "\n-- GNU General Public License for more details."+  ++ "\n-- "+  ++ "\n-- You should have received a copy of the GNU General Public License"+  ++ "\n-- along with this program.  If not, see <http://www.gnu.org/licenses/>.\n\n"
Manatee/Core/Render.hs view
@@ -24,11 +24,13 @@ import Graphics.UI.Gtk hiding (Window, windowNew, Frame, frameNew, Signal, Frame, Variant, Action, plugNew, plugGetId, get) import Manatee.Core.DBus import Manatee.Core.Debug+import Manatee.Core.Dynload import Manatee.Core.Page import Manatee.Core.PageView import Manatee.Core.Types import Manatee.Toolkit.General.DBus import Manatee.Toolkit.General.Maybe+import Manatee.Toolkit.General.Process import Manatee.Toolkit.General.STM import Manatee.Toolkit.General.Set hiding (mapM) import Manatee.Toolkit.General.State@@ -41,21 +43,21 @@ import qualified Data.Set as Set  -- | Irc client render process.-startupRender :: PageBufferNewFun -> IO ()-startupRender bufferNewFun = do+startupRender :: PageBufferNewFun -> CustomizeNewFun -> IO ()+startupRender bufferNewFun customizeNewFun = do   -- Get program arguments.   args <- getArgs    case args of     [x] ->          case (read x :: SpawnProcessArgs) of-          arg@(SpawnRenderProcessArgs {}) -> renderMain arg bufferNewFun+          arg@(SpawnRenderProcessArgs {}) -> renderMain arg bufferNewFun customizeNewFun           _ -> return ()     _ -> return ()      -- | Render process main entry.-renderMain :: SpawnProcessArgs -> PageBufferNewFun -> IO ()-renderMain (SpawnRenderProcessArgs pageId pType sId pagePath options) bufferNewFun = do+renderMain :: SpawnProcessArgs -> PageBufferNewFun -> CustomizeNewFun -> IO ()+renderMain (SpawnRenderProcessArgs pageId pType sId pagePath options) bufferNewFun customizeNewFun = do   -- Init.   unsafeInitGUIForThreadedRTS @@ -65,17 +67,18 @@   -- Get render process id.   processId <- getProcessID -  -- Make client name.-  let clientName = mkRenderClientName processId-   -- Create client.+  let clientName = mkRenderClientName processId   client <- mkSessionClientWithName clientName +  -- Load user's configure file.+  customizeWrap <- customizeNewFun+   -- Create page buffer.-  bufferWrap <- bufferNewFun pagePath options client pageId +  bufferWrap <- bufferNewFun pagePath options client pageId customizeWrap    -- Build render client for listen dbus signal.-  mkRenderClient client bufferWrap processId pageList pType+  mkRenderClient client bufferWrap customizeWrap processId pageList pType    -- Create first page.   renderPageNew client bufferWrap pageList processId (pageId, pType, sId) True@@ -84,8 +87,8 @@   mainGUI  -- | Build render client for listen dbus signal.-mkRenderClient :: Client -> PageBufferWrap -> ProcessID -> TVar PageList -> PageType -> IO ()-mkRenderClient client bufferWrap processId pageList pType = +mkRenderClient :: Client -> PageBufferWrap -> CustomizeWrap -> ProcessID -> TVar PageList -> PageType -> IO ()+mkRenderClient client bufferWrap customizeWrap processId pageList pType =    -- Build match rule.   mkRenderMatchRules client      [(CloneRenderPage,          renderHandleClonePage client bufferWrap pageList processId pType)@@ -93,7 +96,10 @@     ,(FocusRenderPage,          renderHandleFocusPage pageList)     ,(PageViewKeyPress,         renderHandleKeyPress pageList)     ,(DestroyRenderPage,        renderHandleDestroyPage pageList)-    ,(ExitRenderProcess,        renderHandleExitProcess client processId)]+    ,(ExitRenderProcess,        renderHandleExitProcess client processId)+    ,(UpdateConfig,             renderHandleUpdateConfig customizeWrap)+    ,(InstallConfig,            renderHandleInstallConfig bufferWrap)+    ]  -- | Handle clone render page signal. renderHandleClonePage :: Client -> PageBufferWrap -> TVar PageList -> ProcessID -> PageType -> RenderSignalArgs -> IO ()@@ -208,3 +214,15 @@    -- Quit process.   mainQuit++-- | Handle update config signal.+renderHandleUpdateConfig :: CustomizeWrap -> RenderSignalArgs -> IO ()+renderHandleUpdateConfig customizeWrap _ = +  loadConfig customizeWrap True++-- | Handle install config signal.+renderHandleInstallConfig :: PageBufferWrap -> RenderSignalArgs -> IO ()+renderHandleInstallConfig (PageBufferWrap buffer) _ = do+  packageName <- pageBufferPackageName buffer+  runCommand_ ("cabal install " ++ packageName ++ " --reinstall")+
Manatee/Core/Types.hs view
@@ -34,6 +34,7 @@ import Data.Set import Data.Text.Lazy (Text) import Data.Typeable+import GHC (HValue) import Graphics.UI.Gtk hiding (on, get, Action, Statusbar, statusbarNew, Window, Frame, frameNew, Plug) import Graphics.UI.Gtk.Gdk.SerializedEvent import Language.Haskell.TH@@ -146,11 +147,12 @@     pageBufferClient            :: a -> Client     pageBufferCreateView        :: a -> PagePlugId -> IO PageViewWrap     pageBufferMode              :: a -> PageMode+    pageBufferPackageName       :: a -> IO String  data PageBufferWrap = forall a . PageBuffer a => PageBufferWrap a  -- | Page buffer new function.-type PageBufferNewFun = FilePath -> [String] -> Client -> PageId -> IO PageBufferWrap+type PageBufferNewFun = FilePath -> [String] -> Client -> PageId -> CustomizeWrap -> IO PageBufferWrap   -- | PageView class. class Typeable a => PageView a where@@ -194,6 +196,14 @@  type PageViewKeymap = forall a . PageView a => Map Text (a -> IO ()) +class Typeable a => Customize a where+  customizeConfigFile   :: a -> FilePath+  customizeLoad         :: a -> [(String, HValue -> IO ())]++data CustomizeWrap = forall a . Customize a => CustomizeWrap a++type CustomizeNewFun = IO CustomizeWrap+ data AnythingInteractiveType = GlobalSearch                              | GlobalInteractive                              | LocalInteractive@@ -273,6 +283,8 @@                   | AnythingViewKeyPress                   | AnythingViewChangeCandidate                   | AnythingViewChangeInteractiveType+                  | UpdateConfig+                  | InstallConfig                     deriving (Show, Eq, Ord)  data RenderSignalArgs = CloneRenderPageArgs PageId SignalBoxId@@ -284,6 +296,8 @@                       | AnythingViewKeyPressArgs Text String String AnythingKeyPressId Bool                       | AnythingViewChangeCandidateArgs [String]                       | AnythingViewChangeInteractiveTypeArgs AnythingInteractiveType+                      | UpdateConfigArgs+                      | InstallConfigArgs                         deriving (Show, Eq, Ord)  data DaemonBroadcastMember = ExitDaemonProcess
Manatee/Toolkit/General/Time.hs view
@@ -76,9 +76,9 @@ -- | Convert seconds to (day/hour/min/second) time. secondToDaytime :: Int -> String secondToDaytime seconds =-       showTime day  "d"-    ++ showTime hour "h"-    ++ showTime min  "m"+       showTime day  "d "+    ++ showTime hour "h "+    ++ showTime min  "m "     ++ showTime sec  "s"     where sec  = seconds `mod` 60           min  = seconds `mod` 3600  `div` 60
Manatee/Toolkit/Gtk/Multiline.hs view
@@ -821,7 +821,9 @@             textBufferPlaceCursor tb nti  -- | Toggle selection.-textViewToggleSelectionMark :: TextViewClass self => self -> IO ()  +-- Return True if selection active.+-- Otherwise, return False. +textViewToggleSelectionMark :: TextViewClass self => self -> IO Bool textViewToggleSelectionMark tv = do   -- Get text buffer.   tb <- textViewGetBuffer tv@@ -831,8 +833,12 @@    -- Toggle selection iter.   if selectionActive -     then textViewCancelSelectionMark tv-     else textViewSetSelectionMark tv+     then do+       textViewCancelSelectionMark tv+       return False+     else do+       textViewSetSelectionMark tv+       return True  -- | Exchange selection mark. textViewExchangeSelectionMark :: TextViewClass self => self -> IO ()
manatee-core.cabal view
@@ -1,5 +1,5 @@ name:			manatee-core-version:		0.0.6+version:		0.0.7 Cabal-Version:	>= 1.6 license:		GPL-3 license-file:	LICENSE@@ -7,10 +7,10 @@ synopsis:		The core of Manatee. description:    manatee-core is core package of Manatee (Haskell/Gtk+ Integrated Live Environment)   .- Video at (Select 720p HD) at : <http://www.youtube.com/watch?v=weS6zys3U8k> <http://v.youku.com/v_show/id_XMjI2MDMzODI4.html>- .  To provide basic communication protocol and toolkit.  .+ Video at (Select 720p HD) at : <http://www.youtube.com/watch?v=weS6zys3U8k> <http://www.youtube.com/watch?v=A3DgKDVkyeM> <http://v.youku.com/v_show/id_XMjI2MDMzODI4.html>+ .  Screenshots at : <http://goo.gl/MkVw>  .  Manual at : <http://haskell.org/haskellwiki/Manatee>@@ -39,10 +39,11 @@                     filepath >= 1.1.0.3, unix >= 2.4.0.0, process >= 1.0.1.2, array >= 0.3.0.0,                     old-time >= 1.0.0.3, glib >= 0.12.0, time >= 1.1.4, gtksourceview2 >= 0.12.0,                     Cabal >= 1.8.0.2, old-locale >= 1.0.0.2, datetime >= 0.2, bytestring, split, dataenc,-                    derive, gconf >= 0.12.0, binary, directory, haskell-src-exts+                    derive, gconf >= 0.12.0, binary, directory, haskell-src-exts, ghc, ghc-paths      exposed-modules:          Manatee.Core.DBus          Manatee.Core.Debug+         Manatee.Core.Dynload          Manatee.Core.Interactive          Manatee.Core.FileOpenRule          Manatee.Core.Page