aspell-pipe 0.2 → 0.3
raw patch · 3 files changed
+118/−23 lines, 3 filesdep ~processPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: process
API changes (from Hackage documentation)
+ Text.Aspell: aspellDictionaries :: IO (Either String [Text])
Files
- ChangeLog.md +14/−0
- aspell-pipe.cabal +2/−2
- src/Text/Aspell.hs +102/−21
ChangeLog.md view
@@ -1,4 +1,18 @@ +0.3+---++API changes:+ * Added 'aspellDictionaries' to obtain the list of installed+ dictionaries.++Other changes:+ * startAspell now gracefully handles Aspell startup failures by+ reporting Aspell's standard error output in the event of a failed+ startup. It also sanity-checks the Aspell pipe mode identification+ string. (Fixes #2, #3.)++ 0.2 ---
aspell-pipe.cabal view
@@ -1,5 +1,5 @@ name: aspell-pipe-version: 0.2+version: 0.3 synopsis: Pipe-based interface to the Aspell program description: A pipe-based interface to the Aspell program (no dynamic linking required).@@ -26,5 +26,5 @@ hs-source-dirs: src default-language: Haskell2010 build-depends: base >=4.8 && <5,- process >= 1.6,+ process >= 1.3, text
src/Text/Aspell.hs view
@@ -18,11 +18,14 @@ , stopAspell , askAspell , aspellIdentification+ , aspellDictionaries ) where import qualified Control.Exception as E-import Control.Monad (forM)+import Control.Monad (forM, when, void)+import Control.Concurrent (forkIO, killThread)+import Control.Concurrent.MVar (takeMVar, newEmptyMVar, putMVar) import Data.Monoid ((<>)) import Data.Maybe (fromJust) import Text.Read (readMaybe)@@ -79,31 +82,101 @@ -- 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- }+ optResult <- checkOptions options+ case optResult of+ Just e -> return $ Left e+ Nothing -> tryConvert $ do+ let proc = (P.proc aspellCommand ("-a" : (concat $ optionToArgs <$> options)))+ { P.std_in = P.CreatePipe+ , P.std_out = P.CreatePipe+ , P.std_err = P.CreatePipe+ } - 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+ (Just inH, Just outH, Just errH, ph) <- P.createProcess proc++ -- Set up an mvar to hold the first available aspell output.+ -- In this we store the first available stdout or stderr+ -- line; if aspell dies immediately then we can expect a+ -- stderr read (the error message), but on success we expect+ -- a stdout read (the identification string). We fork two+ -- threads: one to read stdout, one stderr. Whichever one+ -- gets a result first tells us whether Aspell started+ -- successfully. If the stderr thread wins, the stdout+ -- thread will get an exception on hGetLine due to stdout+ -- being closed, so we have to handle that. If the stdout+ -- thread wins, the stderr thread will block forever and we+ -- need to kill it.+ initialResult <- newEmptyMVar++ void $ forkIO $ do+ identResult <- E.try $ T.hGetLine outH+ case identResult of+ -- A failure means aspell died, so the stderr thread+ -- should have something to read.+ Left (_::E.SomeException) -> return ()+ Right ident -> putMVar initialResult $ Right ident++ errThread <- forkIO $ do+ err <- T.hGetLine errH+ putMVar initialResult $ Left err++ status <- takeMVar initialResult+ case status of+ Left e -> error $ "Error starting aspell: " <> show e Right ident -> do- let as = Aspell { aspellProcessHandle = ph- , aspellStdin = inH- , aspellStdout = outH- , aspellIdentification = ident- }+ killThread errThread - -- Enable terse mode with aspell to improve performance.- T.hPutStrLn inH "!"+ -- Now that aspell has started and we got an+ -- identification string, we need to make sure it+ -- looks legitimate before we proceed.+ case validIdent ident of+ False -> error $ "Unexpected identification string: " <> show ident+ True -> do+ let as = Aspell { aspellProcessHandle = ph+ , aspellStdin = inH+ , aspellStdout = outH+ , aspellIdentification = ident+ } - return $ Right as+ -- Enable terse mode with aspell to improve performance.+ T.hPutStrLn inH "!" + return as++validIdent :: T.Text -> Bool+validIdent s =+ "@(#) International Ispell Version" `T.isPrefixOf` s &&+ "but really Aspell" `T.isInfixOf` s++checkOptions :: [AspellOption] -> IO (Maybe String)+checkOptions [] = return Nothing+checkOptions (o:os) = do+ result <- checkOption o+ case result of+ Nothing -> checkOptions os+ Just msg -> return $ Just msg++aspellCommand :: String+aspellCommand = "aspell"++checkOption :: AspellOption -> IO (Maybe String)+checkOption (UseDictionary d) = do+ -- Get the list of installed dictionaries and check whether the+ -- desired dictionary is included.+ dictListResult <- aspellDictionaries+ case dictListResult of+ Left msg -> return $ Just msg+ Right dictList ->+ case d `elem` dictList of+ True -> return Nothing+ False -> return $ Just $ "Requested dictionary " <> show d <> " is not installed"++-- | Obtain the list of installed Aspell dictionaries.+aspellDictionaries :: IO (Either String [T.Text])+aspellDictionaries =+ tryConvert $+ (T.pack <$>) <$> lines <$> P.readProcess aspellCommand ["dicts"] ""+ optionToArgs :: AspellOption -> [String] optionToArgs (UseDictionary d) = ["-d", T.unpack d] @@ -170,3 +243,11 @@ False -> do rest <- readLinesUntil h f return $ line : rest++tryConvert :: IO a -> IO (Either String a)+tryConvert act = do+ result <- E.try act+ return $ either (Left . showException) Right result++showException :: E.SomeException -> String+showException = show