Shellac-haskeline (empty) → 0.1

raw patch · 4 files changed

+162/−0 lines, 4 filesdep +Shellacdep +basedep +haskelinesetup-changed

Dependencies added: Shellac, base, haskeline, mtl

Files

LICENSE +23/−0
Setup.lhs +4/−0
Shellac-haskeline.cabal +22/−0
System/Console/Shell/Backend/Haskeline.hs +113/−0

+ LICENSE view

@@ -0,0 +1,23 @@+Copyright 2007-2008, Judah Jacobson.+All Rights Reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistribution of source code must retain the above copyright notice,+this list of conditions and the following disclamer.++- Redistribution in binary form must reproduce the above copyright notice,+this list of conditions and the following disclamer in the documentation+and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE AUTHOR 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 AUTHOR OR THE 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.lhs view

@@ -0,0 +1,4 @@+> import Distribution.Simple++> main :: IO ()+> main = defaultMain

+ Shellac-haskeline.cabal view

@@ -0,0 +1,22 @@+Name:           Shellac-haskeline+Cabal-Version:  >=1.2+Version:        0.1+Category:       User Interfaces+License:        BSD3+License-File:   LICENSE+Copyright:      (c) Judah Jacobson+Author:         Judah Jacobson+Maintainer:     Judah Jacobson <judah.jacobson@gmail.com>+Category:       User Interfaces+Synopsis:       Haskeline backend module for Shellac+Description:    This module provides a backend for Shellac using the Haskeline library.  It+                provides rich line editing capabilities, command completion and command+                history features.+Stability:      Experimental+Build-Type:     Simple++Library+    Build-depends: base>=3 && <5, Shellac==0.9.*, haskeline==0.5.*, mtl==1.1.*+    Exposed-Modules:+                System.Console.Shell.Backend.Haskeline+    ghc-options: -Wall

+ System/Console/Shell/Backend/Haskeline.hs view

@@ -0,0 +1,113 @@+module System.Console.Shell.Backend.Haskeline+                    (haskelineBackend,+                    ShellacState) where++import System.Console.Shell.Backend+import System.Console.Haskeline hiding (completeFilename)+import qualified System.Console.Haskeline as H+import qualified System.Console.Haskeline.History as History+import System.Console.Haskeline.IO+import System.IO+import Data.IORef+import Control.Monad.State+import Data.Maybe(fromMaybe)++data ShellacState = ShellacState {+                        inputState :: InputState,+                        wordBreakChars  :: IORef String,+                        completer :: IORef CompletionFunction,+                        defaultCompleter :: IORef (Maybe (String -> IO [String]))+                    }++initShellacState :: IO ShellacState+initShellacState = do+    wbcsRef <- newIORef filenameWordBreakChars+    complRef <- newIORef (wrapHaskelineCompleter listFiles)+    dcomplRef <- newIORef Nothing+    let completionWrapper = \line -> do+        wbcs <- readIORef wbcsRef+        compl <- readIORef complRef+        dcompl <- readIORef dcomplRef+        wrapShellacCompleter wbcs compl dcompl line+    is <- initializeInput Settings {complete = completionWrapper,+                        autoAddHistory = False,+                        historyFile = Nothing}+    return ShellacState {inputState = is, wordBreakChars = wbcsRef,+                completer = complRef, defaultCompleter = dcomplRef}+        +queryInputState :: ShellacState -> (InputT IO a) -> IO a+queryInputState = queryInput . inputState++--------------+haskelineBackend :: ShellBackend ShellacState+haskelineBackend = ShBackend {+            initBackend = initShellacState,+            shutdownBackend = closeInput . inputState,+            outputString = \ss -> queryInputState ss . outputter,+            flushOutput = \_ -> hFlush stdout,+            getSingleChar = \ss pre -> queryInputState ss $ getInputChar pre,+            getInput = \ss pre -> queryInputState ss $ getInputLine pre,+            addHistory = \ss line -> queryInputState ss +                    $ modify $ History.addHistory line,+            setWordBreakChars = \ss -> writeIORef (wordBreakChars ss),+            getWordBreakChars = readIORef . wordBreakChars,+            onCancel = cancelInput . inputState,+            setAttemptedCompletionFunction = \ss -> writeIORef (completer ss),+            setDefaultCompletionFunction = \ss -> writeIORef (defaultCompleter ss),+            completeFilename = \_ -> fmap (map replacement) . listFiles,+            completeUsername = \_ _ -> return [],+            clearHistoryState = \ss -> queryInputState ss $ put History.emptyHistory,+            setMaxHistoryEntries = \ss n -> let+                        stifle = if n < 0 then Nothing else Just n+                        in queryInputState ss $ modify $ History.stifleHistory stifle,+            getMaxHistoryEntries = \ss -> queryInputState ss $ gets+                                    $ fromMaybe (-1) . History.stifleAmount,+            readHistory = \ss file -> History.readHistory file +                                >>= queryInputState ss . put,+            writeHistory = \ss file -> queryInputState ss get +                                        >>= History.writeHistory file+            }+++outputter :: BackendOutput -> InputT IO ()+outputter (RegularOutput str) = outputStr str+outputter (InfoOutput str) = outputStr str+-- TODO: support unicode here.+outputter (ErrorOutput str) = liftIO $ hPutStr stderr str+++wrapShellacCompleter :: String -> CompletionFunction -> Maybe (String -> IO [String])+                            -> CompletionFunc IO+wrapShellacCompleter breakChars f mg (left,right) = do+    let (rword,rleft') = break (`elem` breakChars) left+    let (left', word) = (reverse rleft', reverse rword)+    result <- f (left',word,right)+    completions <- case result of+                        Nothing -> case mg of+                            Nothing -> return []+                            Just g -> g word+                        Just (str,[]) -> return [str]+                        Just (_,alts) -> return alts+    return (rleft', map makeCompletion completions)++-- a hack to avoid adding a trailing space to completed folders.+-- I could go a little further and test whether it corresponds to an+-- actual file.+makeCompletion :: String -> Completion+makeCompletion "" = simpleCompletion ""+makeCompletion s = (simpleCompletion s) {+                isFinished = not (last s `elem` "/\\")+                    }++longestPrefix :: [String] -> String+longestPrefix = foldl1 commonPrefix+    where+        commonPrefix (x:xs) (y:ys) | x==y = x : commonPrefix xs ys+        commonPrefix _ _ = ""++wrapHaskelineCompleter :: (String -> IO [Completion]) -> CompletionFunction+wrapHaskelineCompleter f (_,w,_) = do+    ws <- fmap (map replacement) (f w)+    return $ case ws of+        [] -> Nothing+        _ -> Just (longestPrefix ws,ws)