aspell-pipe (empty) → 0.1

raw patch · 6 files changed

+250/−0 lines, 6 filesdep +basedep +processdep +textsetup-changed

Dependencies added: base, process, text

Files

ChangeLog.md +5/−0
LICENSE +30/−0
README.md +11/−0
Setup.hs +2/−0
aspell-pipe.cabal +30/−0
src/Text/Aspell.hs +172/−0

+ ChangeLog.md view

@@ -0,0 +1,5 @@++0.1+---++Initial release.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2017, Jonathan Daugherty.+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.++    * The names of the contributors may not 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+HOLDER 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.

+ README.md view

@@ -0,0 +1,11 @@++aspell-pipe+-----------++This package provides a simple interface to the `aspell` spell checker+tool. In particular, this library communicates with `aspell` using+its pipe interface rather than linking directly to the Aspell shared+library. This is because in some cases it is desirable to avoid a shared+library dependency and to deal gracefully with an absent spell checker.++To get started, see the Haddock documentation for `Text.Aspell`.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ aspell-pipe.cabal view

@@ -0,0 +1,30 @@+name:                aspell-pipe+version:             0.1+synopsis:            Pipe-based interface to the Aspell program+description:         A pipe-based interface to the Aspell program (no+                     dynamic linking required).+license:             BSD3+license-file:        LICENSE+author:              Jonathan Daugherty+maintainer:          jtd@galois.com+copyright:           2017 Jonathan Daugherty+category:            Text+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10++extra-doc-files:     README.md++source-repository    head+  type: git+  location: https://github.com/matterhorn-chat/aspell-pipe.git++library+  exposed-modules:+    Text.Aspell++  hs-source-dirs:      src+  default-language:    Haskell2010+  build-depends:       base >=4.8 && <4.9,+                       process >= 1.6,+                       text

+ src/Text/Aspell.hs view

@@ -0,0 +1,172 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | A pipe-based interface to Aspell.+--+-- This interface is beneficial when dynamic linking against the Aspell+-- library would be undesirable, e.g., for binary portability reasons.+--+-- This implementation is based on the description of the Aspell pipe+-- protocol at+--+-- http://aspell.net/man-html/Through-A-Pipe.html+module Text.Aspell+  ( Aspell+  , AspellResponse(..)+  , Mistake(..)+  , AspellOption(..)+  , startAspell+  , stopAspell+  , askAspell+  , aspellIdentification+  )+where++import qualified Control.Exception as E+import Control.Monad (forM)+import Data.Monoid ((<>))+import Data.Maybe (fromJust)+import Text.Read (readMaybe)+import System.IO (Handle, hFlush)+import qualified Data.Text as T+import qualified Data.Text.IO as T++import qualified System.Process as P++-- | A handle to a running Aspell instance.+data Aspell =+    Aspell { aspellProcessHandle  :: P.ProcessHandle+           , aspellStdin          :: Handle+           , aspellStdout         :: Handle+           , aspellIdentification :: T.Text+           }++instance Show Aspell where+    show as = mconcat [ "Aspell<"+                      , T.unpack (aspellIdentification as)+                      , ">"+                      ]++-- | The kind of responses we can get from Aspell.+data AspellResponse =+    AllCorrect+    -- ^ The input had no spelling mistakes.+    | Mistakes [Mistake]+    -- ^ The input had the specified mistakes.+    deriving (Eq, Show)++-- | A spelling mistake.+data Mistake =+    Mistake { mistakeWord         :: T.Text+            -- ^ The original word in misspelled form.+            , mistakeNearMisses   :: Int+            -- ^ The number of alternative correct spellings that were+            -- counted.+            , mistakeOffset       :: Int+            -- ^ The offset, starting at zero, in the original input+            -- where this misspelling occurred.+            , mistakeAlternatives :: [T.Text]+            -- ^ The correct spelling alternatives.+            }+            deriving (Show, Eq)++-- | An Aspell option.+data AspellOption =+    UseDictionary T.Text+    -- ^ Use the specified dictionary (see aspell -d).+    deriving (Show, Eq)++-- | Start Aspell with the specified options. Returns either an error+-- message on failure or an Aspell handle on success.+startAspell :: [AspellOption] -> IO (Either String Aspell)+startAspell options = do+    let proc = (P.proc "aspell" ("-a" : (concat $ optionToArgs <$> options)))+               { P.std_in = P.CreatePipe+               , P.std_out = P.CreatePipe+               , P.std_err = P.NoStream+               }++    result <- E.try $ P.createProcess proc+    case result of+        Left (e::E.SomeException) -> return $ Left $ show e+        Right (Just inH, Just outH, Nothing, ph) -> do+            identResult <- E.try $ T.hGetLine outH+            case identResult of+                Left (e::E.SomeException) -> return $ Left $ show e+                Right ident -> do+                    let as = Aspell { aspellProcessHandle  = ph+                                    , aspellStdin          = inH+                                    , aspellStdout         = outH+                                    , aspellIdentification = ident+                                    }++                    -- Enable terse mode with aspell to improve performance.+                    T.hPutStrLn inH "!"++                    return $ Right as++optionToArgs :: AspellOption -> [String]+optionToArgs (UseDictionary d) = ["-d", T.unpack d]++-- | Stop a running Aspell instance.+stopAspell :: Aspell -> IO ()+stopAspell = P.terminateProcess . aspellProcessHandle++-- | Submit user input to Aspell for spell-checking. Returns an+-- AspellResponse for each line of user input.+askAspell :: Aspell -> T.Text -> IO [AspellResponse]+askAspell as t = do+    -- Send the user's input. Prefix with "^" to ensure that the line is+    -- checked even if it contains metacharacters.+    forM (T.lines t) $ \theLine -> do+        T.hPutStrLn (aspellStdin as) ("^" <> theLine)+        hFlush (aspellStdin as)++        -- Read lines until we get an empty one, which indicates that aspell+        -- is done with the request.+        resultLines <- readLinesUntil (aspellStdout as) T.null++        case resultLines of+            [] -> return AllCorrect+            _ -> return $ Mistakes $ parseMistake <$> resultLines++parseMistake :: T.Text -> Mistake+parseMistake t+    | "&" `T.isPrefixOf` t = parseWithAlternatives t+    | "#" `T.isPrefixOf` t = parseWithoutAlternatives t++parseWithAlternatives :: T.Text -> Mistake+parseWithAlternatives t =+    let (header, altsWithColon) = T.breakOn ": " t+        altsStr = T.drop 2 altsWithColon+        ["&", orig, nearMissesStr, offsetStr] = T.words header+        alts = T.splitOn ", " altsStr+        offset = fromJust $ readMaybe $ T.unpack offsetStr+        nearMisses = fromJust $ readMaybe $ T.unpack nearMissesStr+    in Mistake { mistakeWord = orig+               , mistakeNearMisses = nearMisses+               -- Aspell's offset starts at 1 here because of the "^"+               -- we included in the input. Here we adjust the offset+               -- so that it's relative to the beginning of the user's+               -- input, not our protocol input.+               , mistakeOffset = offset - 1+               , mistakeAlternatives = alts+               }++parseWithoutAlternatives :: T.Text -> Mistake+parseWithoutAlternatives t =+    let ["#", orig, offsetStr] = T.words t+        offset = fromJust $ readMaybe $ T.unpack offsetStr+    in Mistake { mistakeWord = orig+               , mistakeNearMisses = 0+               , mistakeOffset = offset+               , mistakeAlternatives = []+               }++readLinesUntil :: Handle -> (T.Text -> Bool) -> IO [T.Text]+readLinesUntil h f = do+    line <- T.hGetLine h+    case f line of+        True -> return []+        False -> do+            rest <- readLinesUntil h f+            return $ line : rest