packages feed

brassica 0.1.0 → 0.1.1

raw patch · 7 files changed

+173/−22 lines, 7 filesdep +aesondep +attoparsec-aesondep +conduit-extraPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, attoparsec-aeson, conduit-extra

API changes (from Hackage documentation)

Files

ChangeLog.md view
@@ -1,7 +1,16 @@ # Brassica changelog -## Unreleased changes+## v0.1.1 +- Rewrote executables with a client/server architecture for better Windows support.+  The library remains unchanged.++## v0.1.0++- Add new syntax with `#` in lexicon to create word boundaries which can be manipulated by sound changes+- Web interface greatly improved using WebAssembly+- Allow synchronising scroll positions in GUI between input and output textboxes+- Add timeout to desktop GUI to abort long-running computations - Allow category backreferencing with `@n` before category - Allow forcing nondeterminism with `@?` before category - Add ‘input→output’ format for output words
README.md view
@@ -8,8 +8,9 @@ - Can be used interactively both [online](http://bradrn.com/brassica/index.html) and as a desktop application, or non-interactively in batch mode on the command-line or as a [Haskell library](https://hackage.haskell.org/package/brassica) - Natively supports the MDF dictionary format, also used by tools including [SIL Toolbox](https://software.sil.org/toolbox/) and [Lexique Pro](https://software.sil.org/lexiquepro/) - First-class support for multigraphs-- Easy control over rule application: apply sound changes sporadically, right-to-left, and in many more ways-- Live preview and control over output highlighting allows fast iteration through rules+- Easy control over rule application: apply sound changes sporadically, right-to-left, between words, and in many more ways+- Live preview and control over output highlighting let you try out sound changes quickly and easily+- Highlight and visualise results in numerous ways - Category operations allow phonetic rules to be written in both featural and character-based ways - Support for ‘features’ lets rules easily manipulate stress, tone and other suprasegmentals - Comes with a paradigm builder for quickly investigating inflectional and other patterns
brassica.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.0 name:               brassica-version:            0.1.0+version:            0.1.1 synopsis:           Featureful sound change applier description:   The Brassica library for the simulation of sound changes in historical linguistics and language construction.@@ -15,7 +15,7 @@ license:            BSD3 license-file:       LICENSE build-type:         Simple-extra-source-files:+extra-doc-files:   README.md   ChangeLog.md @@ -54,13 +54,18 @@  executable brassica   main-is:          Main.hs+  other-modules:    Server   hs-source-dirs:   cli   ghc-options:      -threaded -rtsopts -with-rtsopts=-N -Wall   build-depends:                     base >=4.7 && <5                   , brassica+                  , aeson ^>=2.2+                  , attoparsec-aeson ^>=2.2                   , bytestring >=0.10 && <0.12                   , conduit ^>=1.3+                  , conduit-extra ^>=1.3+                  , deepseq >=1.4 && <1.5                   , optparse-applicative ^>=0.17                   , text >=1.2 && <2.1 
cli/Main.hs view
@@ -13,27 +13,31 @@  import Brassica.SoundChange import Brassica.SoundChange.Frontend.Internal+import Server  main :: IO ()-main = do-    Options{..} <- execParser opts-    changesText <- unpack . decodeUtf8 <$> B.readFile rulesFile+main = execParser opts >>= \case+    Server -> serve+    Options{..} -> do+        changesText <- unpack . decodeUtf8 <$> B.readFile rulesFile -    case parseSoundChanges changesText of-        Left err ->-            putStrLn $ errorBundlePretty err-        Right rules ->-            withSourceFileIf inWordsFile $ \inC ->-            withSinkFileIf outWordsFile $ \outC ->-            runConduit $-                inC-                .| processWords (incrFor wordsFormat) rules wordsFormat outMode-                .| outC+        case parseSoundChanges changesText of+            Left err ->+                putStrLn $ errorBundlePretty err+            Right rules ->+                withSourceFileIf inWordsFile $ \inC ->+                withSinkFileIf outWordsFile $ \outC ->+                runConduit $+                    inC+                    .| processWords (incrFor wordsFormat) rules wordsFormat outMode+                    .| outC    where     opts = info (args <**> helper) fullDesc -    args = Options+    args = batchArgs <|> serverArgs+    serverArgs = flag' Server (long "server" <> help "Run server (for internal use only)")+    batchArgs = Options         <$> strArgument             (metavar "RULES" <> help "File containing sound changes")         <*> flag Raw MDF@@ -72,7 +76,9 @@     , outMode :: ApplicationMode     , inWordsFile :: Maybe String     , outWordsFile :: Maybe String-    } deriving (Show)+    }+    | Server+    deriving (Show)  processWords     :: (MonadIO m, MonadThrow m)
+ cli/Server.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}++module Server (serve) where++import Conduit (runConduit, (.|), stdinC, stdoutC, mapMC)+import Control.DeepSeq (force, NFData)+import Control.Exception (evaluate)+import Data.Aeson (Result(..), encode, fromJSON)+import Data.Aeson.Parser (json')+import Data.Aeson.TH (deriveJSON, defaultOptions, defaultTaggedObject, constructorTagModifier, sumEncoding, tagFieldName)+import Data.ByteString (toStrict)+import Data.Conduit.Attoparsec (conduitParser)+import GHC.Generics (Generic)+import System.IO (hSetBuffering, stdin, stdout, BufferMode(NoBuffering))+import System.Timeout++import Brassica.SoundChange+import Brassica.SoundChange.Frontend.Internal+import Brassica.Paradigm (applyParadigm, parseParadigm)++data Request+    = ReqRules+        { changes :: String+        , input :: String+        , report :: Bool+        , inFmt :: InputLexiconFormat+        , hlMode :: HighlightMode+        , outMode :: OutputMode+        , prev :: Maybe [Component PWord]+        }+    | ReqParadigm+        { pText :: String+        , input :: String+        }+    deriving (Show)++data Response+    = RespRules+        { prev :: Maybe [Component PWord]+        , output :: String+        }+    | RespParadigm+        { output :: String+        }+    | RespError String+    deriving (Show, Generic, NFData)++$(deriveJSON defaultOptions ''Component)+$(deriveJSON defaultOptions ''Grapheme)+$(deriveJSON defaultOptions ''InputLexiconFormat)+$(deriveJSON defaultOptions ''HighlightMode)+$(deriveJSON defaultOptions ''OutputMode)++$(deriveJSON defaultOptions{constructorTagModifier=drop 3, sumEncoding=defaultTaggedObject{tagFieldName="method"}} ''Request)+$(deriveJSON defaultOptions{constructorTagModifier=drop 4, sumEncoding=defaultTaggedObject{tagFieldName="method"}} ''Response)++serve :: IO ()+serve = do+    hSetBuffering stdin NoBuffering+    hSetBuffering stdout NoBuffering+    runConduit $+        stdinC+        .| conduitParser json'+        .| mapMC (action . snd)+        .| stdoutC+  where+    action req' = fmap ((<> "\ETB") . toStrict . encode) $+        case fromJSON req' of+            Error e -> pure $ RespError e+            Success req -> do+                result <-+                    timeout 5000000 $  -- 5 s+                    evaluate $ force $+                    dispatch req+                pure $ case result of+                    Nothing -> RespError "&lt;timeout&gt;"+                    Just resp -> resp++dispatch :: Request -> Response+dispatch r@(ReqRules{}) = parseTokeniseAndApplyRulesWrapper r+dispatch r@(ReqParadigm{}) = parseAndBuildParadigmWrapper r++parseTokeniseAndApplyRulesWrapper+    :: Request+    -> Response+parseTokeniseAndApplyRulesWrapper ReqRules{..} =+    let mode =+            if report+            then ReportRulesApplied+            else ApplyRules hlMode outMode+    in case parseSoundChanges changes of+        Left e -> RespError $ "<pre>" ++ errorBundlePretty e ++ "</pre>"+        Right statements ->+            let result' = parseTokeniseAndApplyRules statements input inFmt mode prev+            in case result' of+                ParseError e -> RespError $+                    "<pre>" ++ errorBundlePretty e ++ "</pre>"+                HighlightedWords result -> RespRules+                    (Just $ (fmap.fmap) fst result)+                    (escape $ detokeniseWords' highlightWord result)+                AppliedRulesTable items -> RespRules Nothing $+                    surroundTable $ concatMap (reportAsHtmlRows plaintext') items+  where+    highlightWord (s, False) = concatWithBoundary s+    highlightWord (s, True) = "<b>" ++ concatWithBoundary s ++ "</b>"++    surroundTable :: String -> String+    surroundTable s = "<table>" ++ s ++ "</table>"+parseTokeniseAndApplyRulesWrapper _ = error "parseTokeniseAndApplyRulesWrapper: unexpected request!"++parseAndBuildParadigmWrapper :: Request -> Response+parseAndBuildParadigmWrapper ReqParadigm{..} =+    case parseParadigm pText of+        Left e -> RespError $ "<pre>" ++ errorBundlePretty e ++ "</pre>"+        Right p -> RespParadigm $ escape $ unlines $ concatMap (applyParadigm p) $ lines input+parseAndBuildParadigmWrapper _ = error "parseAndBuildParadigmWrapper: unexpected request!"++escape :: String -> String+escape = concatMap $ \case+    '\n' -> "<br/>"+    -- '\t' -> "&#9;"  -- this doesn't seem to do anything - keeping it here in case I eventually figure out how to do tabs in Qt+    c    -> pure c
src/Brassica/Paradigm/Parse.hs view
@@ -86,6 +86,6 @@ -- | Parse a 'String' in Brassica paradigm syntax into a 'Paradigm'.
 -- Returns 'Left' if the input string is malformed.
 --
--- For details on the syntax, refer to <https://github.com/bradrn/brassica/blob/v0.1.0/Documentation.md#paradigm-builder>.
+-- For details on the syntax, refer to <https://github.com/bradrn/brassica/blob/v0.1.1/Documentation.md#paradigm-builder>.
 parseParadigm :: String -> Either (ParseErrorBundle String Void) Paradigm
 parseParadigm = runParser (many statement) ""
src/Brassica/SoundChange/Parse.hs view
@@ -275,7 +275,7 @@ -- | Parse a 'String' in Brassica sound change syntax into a -- 'Rule'. Returns 'Left' if the input string is malformed. ----- For details on the syntax, refer to <https://github.com/bradrn/brassica/blob/v0.1.0/Documentation.md#basic-rule-syntax>.+-- For details on the syntax, refer to <https://github.com/bradrn/brassica/blob/v0.1.1/Documentation.md#basic-rule-syntax>. parseRule :: String -> Either (ParseErrorBundle String Void) Rule parseRule = parseRuleWithCategories M.empty