diff --git a/.github/workflows/cabal.yml b/.github/workflows/cabal.yml index 6d751fa..0b4d291 100644 --- a/.github/workflows/cabal.yml +++ b/.github/workflows/cabal.yml @@ -14,6 +14,20 @@ on: - synchronize jobs: + check-format: + if: "!contains(github.event.pull_request.labels.*.name, 'ignore-server-format-checks')" + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + - name: Check format + run: | + ORMOLU_VERSION="0.5.0.0" + ORMOLU_URL="https://github.com/tweag/ormolu/releases/download/${ORMOLU_VERSION}/ormolu-Linux.zip" + echo "Downloading from ${ORMOLU_URL}" + curl --fail --location --output ormolu.zip "${ORMOLU_URL}" + unzip ormolu.zip + ./ormolu --mode check $(git ls-files '*.hs') + build-test: runs-on: ubuntu-latest diff --git a/app/Main.hs b/app/Main.hs index 20d9f70..06427f9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,24 +1,26 @@ {-# LANGUAGE NumDecimals #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} + module Main where -import CofreeBot -import CofreeBot.Bot.Behaviors.Calculator.Language -import Control.Monad -import Control.Monad.Except ( ExceptT - , runExceptT - ) -import Control.Monad.IO.Class ( liftIO ) -import GHC.Conc ( threadDelay ) -import Network.Matrix.Client -import qualified Options.Applicative as Opt -import OptionsParser -import System.Environment.XDG.BaseDir ( getUserCacheDir ) -import System.Process.Typed +import CofreeBot +import CofreeBot.Bot.Behaviors.Calculator.Language +import Control.Monad +import Control.Monad.Except + ( ExceptT, + runExceptT, + ) +import Control.Monad.IO.Class (liftIO) +import GHC.Conc (threadDelay) +import Network.Matrix.Client +import Options.Applicative qualified as Opt +import OptionsParser +import System.Environment.XDG.BaseDir (getUserCacheDir) +import System.Process.Typed main :: IO () main = do - command <- Opt.execParser parserInfo + command <- Opt.execParser parserInfo xdgCache <- getUserCacheDir "cofree-bot" case command of @@ -32,15 +34,15 @@ main = do bot process = let calcBot = - liftSimpleBot - $ simplifySessionBot printCalcOutput statementP - $ sessionize mempty - $ calculatorBot - helloBot = helloMatrixBot - coinFlipBot' = liftSimpleBot $ simplifyCoinFlipBot coinFlipBot - ghciBot' = liftSimpleBot $ ghciBot process + liftSimpleBot $ + simplifySessionBot printCalcOutput statementP $ + sessionize mempty $ + calculatorBot + helloBot = helloMatrixBot + coinFlipBot' = liftSimpleBot $ simplifyCoinFlipBot coinFlipBot + ghciBot' = liftSimpleBot $ ghciBot process magic8BallBot' = liftSimpleBot $ simplifyMagic8BallBot magic8BallBot - in calcBot + in calcBot /.\ coinFlipBot' /.\ helloBot /.\ ghciBot' @@ -52,8 +54,13 @@ cliMain :: IO () cliMain = withProcessWait_ ghciConfig $ \process -> do void $ threadDelay 1e6 void $ hGetOutput (getStdout process) - void $ loop $ annihilate repl $ flip fixBot mempty $ simplifyMatrixBot $ bot - process + void $ + loop $ + annihilate repl $ + flip fixBot mempty $ + simplifyMatrixBot $ + bot + process unsafeCrashInIO :: Show e => ExceptT e IO a -> IO a unsafeCrashInIO = runExceptT >=> either (fail . show) pure @@ -62,10 +69,10 @@ matrixMain :: ClientSession -> String -> IO () matrixMain session xdgCache = withProcessWait_ ghciConfig $ \process -> do void $ threadDelay 1e6 void $ hGetOutput (getStdout process) - unsafeCrashInIO - $ loop - $ annihilate (matrix session xdgCache) - $ batch - $ flip fixBot mempty - $ hoistBot liftIO - $ bot process + unsafeCrashInIO $ + loop $ + annihilate (matrix session xdgCache) $ + batch $ + flip fixBot mempty $ + hoistBot liftIO $ + bot process diff --git a/app/OptionsParser.hs b/app/OptionsParser.hs index 8d70496..6fcb355 100644 --- a/app/OptionsParser.hs +++ b/app/OptionsParser.hs @@ -1,8 +1,8 @@ module OptionsParser where -import qualified Data.Text as T -import Network.Matrix.Client -import qualified Options.Applicative as Opt +import Data.Text qualified as T +import Network.Matrix.Client +import Options.Applicative qualified as Opt --------------------- --- Login Command --- @@ -18,61 +18,80 @@ parseLogin = <*> parseInitialDeviceName parseUsername :: Opt.Parser Username -parseUsername = Username <$> Opt.strOption - ( Opt.long "username" - <> Opt.metavar "STRING" - <> Opt.help - "The fully qualified user ID or just local part of the user ID, to log in." - ) +parseUsername = + Username + <$> Opt.strOption + ( Opt.long "username" + <> Opt.metavar "STRING" + <> Opt.help + "The fully qualified user ID or just local part of the user ID, to log in." + ) parsePassword :: Opt.Parser LoginSecret -parsePassword = Password <$> Opt.strOption - (Opt.long "password" <> Opt.metavar "STRING" <> Opt.help - "The user's password." - ) +parsePassword = + Password + <$> Opt.strOption + ( Opt.long "password" + <> Opt.metavar "STRING" + <> Opt.help + "The user's password." + ) parseDeviceId :: Opt.Parser (Maybe DeviceId) -parseDeviceId = Opt.optional $ DeviceId <$> Opt.strOption - ( Opt.long "device_id" - <> Opt.metavar "STRING" - <> Opt.help - "ID of the client device. If this does not correspond to a known client device, a new device will be created. The server will auto-generate a device_id if this is not specified." - ) +parseDeviceId = + Opt.optional $ + DeviceId + <$> Opt.strOption + ( Opt.long "device_id" + <> Opt.metavar "STRING" + <> Opt.help + "ID of the client device. If this does not correspond to a known client device, a new device will be created. The server will auto-generate a device_id if this is not specified." + ) parseInitialDeviceName :: Opt.Parser (Maybe InitialDeviceDisplayName) parseInitialDeviceName = - Opt.optional $ InitialDeviceDisplayName <$> Opt.strOption - ( Opt.long "initial_device_name" - <> Opt.metavar "STRING" - <> Opt.help - "A display name to assign to the newly-created device. Ignored if device_id corresponds to a known device." - ) + Opt.optional $ + InitialDeviceDisplayName + <$> Opt.strOption + ( Opt.long "initial_device_name" + <> Opt.metavar "STRING" + <> Opt.help + "A display name to assign to the newly-created device. Ignored if device_id corresponds to a known device." + ) --------------------- --- Token Command --- --------------------- data TokenCredentials = TokenCredentials - { matrixToken :: MatrixToken - , matrixServer :: MatrixServer + { matrixToken :: MatrixToken, + matrixServer :: MatrixServer } -newtype MatrixServer = MatrixServer { getMatrixServer :: T.Text } +newtype MatrixServer = MatrixServer {getMatrixServer :: T.Text} parseTokenCredentials :: Opt.Parser TokenCredentials parseTokenCredentials = TokenCredentials <$> parseToken <*> parseServer parseToken :: Opt.Parser MatrixToken -parseToken = MatrixToken <$> Opt.strOption - (Opt.long "auth_token" <> Opt.metavar "MATRIX_AUTH_TOKEN" <> Opt.help - "Matrix authentication token" - ) +parseToken = + MatrixToken + <$> Opt.strOption + ( Opt.long "auth_token" + <> Opt.metavar "MATRIX_AUTH_TOKEN" + <> Opt.help + "Matrix authentication token" + ) parseServer :: Opt.Parser MatrixServer -parseServer = fmap MatrixServer $ Opt.strOption - (Opt.long "homeserver" <> Opt.metavar "MATRIX_HOMESERVER" <> Opt.help - "Matrix Homeserver" - ) +parseServer = + fmap MatrixServer $ + Opt.strOption + ( Opt.long "homeserver" + <> Opt.metavar "MATRIX_HOMESERVER" + <> Opt.help + "Matrix Homeserver" + ) ------------------- --- Main Parser --- @@ -81,25 +100,31 @@ parseServer = fmap MatrixServer $ Opt.strOption data Command = LoginCmd LoginCredentials | TokenCmd TokenCredentials | CLI mainParser :: Opt.Parser Command -mainParser = Opt.subparser - ( Opt.command - "gen-token" - (Opt.info (fmap LoginCmd parseLogin) - (Opt.progDesc "Generate a token from a username/password") - ) - <> Opt.command - "run" - (Opt.info (fmap TokenCmd parseTokenCredentials) - (Opt.progDesc "Run the bot with an auth token") - ) - <> Opt.command - "cli" - (Opt.info (pure CLI) (Opt.progDesc "Run the bot in the CLI")) - ) +mainParser = + Opt.subparser + ( Opt.command + "gen-token" + ( Opt.info + (fmap LoginCmd parseLogin) + (Opt.progDesc "Generate a token from a username/password") + ) + <> Opt.command + "run" + ( Opt.info + (fmap TokenCmd parseTokenCredentials) + (Opt.progDesc "Run the bot with an auth token") + ) + <> Opt.command + "cli" + (Opt.info (pure CLI) (Opt.progDesc "Run the bot in the CLI")) + ) parserInfo :: Opt.ParserInfo Command -parserInfo = Opt.info - (mainParser Opt.<**> Opt.helper) - (Opt.fullDesc <> Opt.progDesc "Print a greeting for TARGET" <> Opt.header - "hello - a test for optparse-applicative" - ) +parserInfo = + Opt.info + (mainParser Opt.<**> Opt.helper) + ( Opt.fullDesc + <> Opt.progDesc "Print a greeting for TARGET" + <> Opt.header + "hello - a test for optparse-applicative" + ) diff --git a/cofree-bot.cabal b/cofree-bot.cabal index 51917b0..9b35533 100644 --- a/cofree-bot.cabal +++ b/cofree-bot.cabal @@ -85,6 +85,7 @@ library CofreeBot.Bot.Context CofreeBot.Utils CofreeBot.Utils.ListT + Parsing build-depends: , aeson diff --git a/flake.nix b/flake.nix index 39f8086..1a60462 100644 --- a/flake.nix +++ b/flake.nix @@ -42,6 +42,11 @@ cofree-bot = hfinal.callCabal2nix "cofree-bot" ./. { }; }; }; + + scripts = import ./nix/scripts.nix { + s = pkgs.writeShellScriptBin; + ormolu = pkgs.ormolu; + }; in rec { @@ -55,8 +60,9 @@ ghcid haskell.compiler.${compiler} haskell.packages.${compiler}.haskell-language-server + ormolu zlib - ]; + ] ++ (builtins.attrValues scripts); }; packages = flake-utils.lib.flattenTree { @@ -72,6 +78,13 @@ src = ./.; hooks = { nixpkgs-fmt.enable = true; + ormolu = { + name = "ormolu"; + entry = "${pkgs.ormolu}/bin/ormolu --mode inplace $(git ls-files '*.hs')"; + files = "\\.l?hs$"; + language = "system"; + pass_filenames = false; + }; cabal-fmt.enable = true; }; }; diff --git a/nix/scripts.nix b/nix/scripts.nix new file mode 100644 index 0000000..485396f --- /dev/null +++ b/nix/scripts.nix @@ -0,0 +1,5 @@ +{ s, ormolu }: + +{ + format = s "format" "${ormolu}/bin/ormolu --mode inplace $(git ls-files '*.hs')"; +} diff --git a/src/CofreeBot.hs b/src/CofreeBot.hs index 23a1d99..8e99f56 100644 --- a/src/CofreeBot.hs +++ b/src/CofreeBot.hs @@ -1,11 +1,12 @@ module CofreeBot - ( module Behaviors - , module Bot - , module Context - , module Utils - ) where + ( module Behaviors, + module Bot, + module Context, + module Utils, + ) +where -import CofreeBot.Bot as Bot -import CofreeBot.Bot.Behaviors as Behaviors -import CofreeBot.Bot.Context as Context -import CofreeBot.Utils as Utils +import CofreeBot.Bot as Bot +import CofreeBot.Bot.Behaviors as Behaviors +import CofreeBot.Bot.Context as Context +import CofreeBot.Utils as Utils diff --git a/src/CofreeBot/Bot.hs b/src/CofreeBot/Bot.hs index 9554c7f..af8666c 100644 --- a/src/CofreeBot/Bot.hs +++ b/src/CofreeBot/Bot.hs @@ -1,77 +1,86 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ViewPatterns #-} + module CofreeBot.Bot ( -- * Bot - KBot - , Bot(..) - , invmapBot - , mapMaybeBot - , nudge - , nudgeLeft - , nudgeRight - , (/\) - , (/.\) - , (/+\) - , (\/) - , pureStatelessBot - , emptyBot - , hoistBot - , liftEffect - , -- * Behavior - Behavior(..) - , fixBot - , batch - , -- * Env - Env(..) - , fixEnv - , -- * Server - Server(..) - , annihilate - , loop - , -- * Matrix Bot - MatrixBot - , matrix - , simplifyMatrixBot - , liftSimpleBot - , -- * Text Bot - TextBot - , repl - ) where + KBot, + Bot (..), + invmapBot, + mapMaybeBot, + nudge, + nudgeLeft, + nudgeRight, + (/\), + (/.\), + (/+\), + (\/), + pureStatelessBot, + emptyBot, + hoistBot, + liftEffect, + + -- * Behavior + Behavior (..), + fixBot, + batch, + + -- * Env + Env (..), + fixEnv, + + -- * Server + Server (..), + annihilate, + loop, + + -- * Matrix Bot + MatrixBot, + matrix, + simplifyMatrixBot, + liftSimpleBot, + + -- * Text Bot + TextBot, + repl, + ) +where -------------------------------------------------------------------------------- -import CofreeBot.Utils -import CofreeBot.Utils.ListT -import qualified Control.Arrow as Arrow -import Control.Exception ( catch - , throwIO - ) -import Control.Lens ( (^.) - , _Just - , ifolded - , view - ) -import Control.Monad -import Control.Monad.Except -import Control.Monad.Reader -import Control.Monad.State -import Data.Bifunctor ( Bifunctor(..) ) -import Data.Fix ( Fix(..) ) -import Data.Foldable ( asum ) -import Data.Functor ( (<&>) ) -import Data.Kind -import qualified Data.Map.Strict as Map -import Data.Profunctor -import Data.Profunctor.Traversing -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Data.These -import Network.Matrix.Client -import Network.Matrix.Client.Lens -import System.Directory ( createDirectoryIfMissing ) -import System.IO -import System.IO.Error ( isDoesNotExistError ) -import System.Random +import CofreeBot.Utils +import CofreeBot.Utils.ListT +import Control.Arrow qualified as Arrow +import Control.Exception + ( catch, + throwIO, + ) +import Control.Lens + ( ifolded, + view, + (^.), + _Just, + ) +import Control.Monad +import Control.Monad.Except +import Control.Monad.Reader +import Control.Monad.State +import Data.Bifunctor (Bifunctor (..)) +import Data.Fix (Fix (..)) +import Data.Foldable (asum) +import Data.Functor ((<&>)) +import Data.Kind +import Data.Map.Strict qualified as Map +import Data.Profunctor +import Data.Profunctor.Traversing +import Data.Text qualified as T +import Data.Text.IO qualified as T +import Data.These +import Network.Matrix.Client +import Network.Matrix.Client.Lens +import System.Directory (createDirectoryIfMissing) +import System.IO +import System.IO.Error (isDoesNotExistError) +import System.Random -------------------------------------------------------------------------------- @@ -80,61 +89,61 @@ type KBot = (Type -> Type) -> Type -> Type -> Type -> Type -- | A 'Bot' maps from some input type 'i' and a state 's' to an -- output type 'o' and a state 's' type Bot :: KBot -newtype Bot m s i o = Bot { runBot :: s -> i -> ListT m (o, s) } +newtype Bot m s i o = Bot {runBot :: s -> i -> ListT m (o, s)} deriving (Functor, Applicative, Monad, MonadState s, MonadReader i, MonadIO) - via StateT s (ReaderT i (ListT m)) + via StateT s (ReaderT i (ListT m)) instance Functor f => Profunctor (Bot f s) where dimap f g (Bot bot) = do Bot $ \s i -> fmap (Arrow.first g) $ bot s (f i) instance Functor f => Strong (Bot f s) where - first' (Bot bot) = Bot $ \s (a, c) -> fmap (Arrow.first (, c)) $ bot s a + first' (Bot bot) = Bot $ \s (a, c) -> fmap (Arrow.first (,c)) $ bot s a -------------------------------------------------------------------------------- -- | The fixed point of a 'Bot'. --- +-- -- Notice that the @s@ parameter has disapeared. This allows us to -- hide the state threading when interpreting a 'Bot' with some 'Env'. -- -- See 'annihilate' for how this interaction occurs in practice. -newtype Behavior m i o = Behavior { runBehavior :: i -> ListT m (o, (Behavior m i o)) } +newtype Behavior m i o = Behavior {runBehavior :: i -> ListT m (o, (Behavior m i o))} -instance Functor m => Profunctor (Behavior m) - where +instance Functor m => Profunctor (Behavior m) where dimap f g (Behavior b) = Behavior $ dimap f (fmap (bimap g (dimap f g))) b -instance Monad m => Choice (Behavior m) - where - left' (Behavior b) = Behavior $ either - (fmap (bimap Left left') . b) - (pure . (, left' (Behavior b)) . Right) +instance Monad m => Choice (Behavior m) where + left' (Behavior b) = + Behavior $ + either + (fmap (bimap Left left') . b) + (pure . (,left' (Behavior b)) . Right) -instance Functor m => Strong (Behavior m) - where - first' (Behavior b) = Behavior $ \(a, c) -> fmap (bimap (, c) first') (b a) +instance Functor m => Strong (Behavior m) where + first' (Behavior b) = Behavior $ \(a, c) -> fmap (bimap (,c) first') (b a) -instance Monad m => Traversing (Behavior m) - where +instance Monad m => Traversing (Behavior m) where -- TODO: write wander instead for efficiency traverse' b = Behavior $ \is -> - fmap (uncurry (,) . fmap traverse') $ flip runStateT b $ traverse - (\i -> StateT $ \(Behavior b') -> - fmap (\(responses, nextState) -> (responses, nextState)) $ b' i - ) - is + fmap (uncurry (,) . fmap traverse') $ + flip runStateT b $ + traverse + ( \i -> StateT $ \(Behavior b') -> + fmap (\(responses, nextState) -> (responses, nextState)) $ b' i + ) + is -- | Generate the fixed point of @Bot m s i o@ by recursively -- construction an @s -> Behavior m i o@ action and tupling it with -- the output @o@ from its parent action. -fixBot :: forall m s i o . Functor m => Bot m s i o -> s -> Behavior m i o +fixBot :: forall m s i o. Functor m => Bot m s i o -> s -> Behavior m i o fixBot (Bot b) = go - where - go :: s -> Behavior m i o - go s = Behavior $ \i -> second go <$> b s i + where + go :: s -> Behavior m i o + go s = Behavior $ \i -> second go <$> b s i -- | Batch process a list of inputs @i@ with a single 'Behavior', -- interleaving the effects, and collecting the resulting outputs @o@. @@ -158,11 +167,10 @@ batch (Behavior b) = Behavior $ fmap (fmap batch) . asum . fmap b -- prior 'Bot' output @o@ to produce the new state @s'@. -- 4. Repeat from step 2 with @s'@ and @i'@. type Env :: KBot -newtype Env m s o i = Env { runEnv :: s -> m (i, [o] -> s) } +newtype Env m s o i = Env {runEnv :: s -> m (i, [o] -> s)} deriving (Functor) -instance Functor m => Profunctor (Env m s) - where +instance Functor m => Profunctor (Env m s) where dimap f g (Env env) = Env $ fmap (fmap (bimap g (lmap (fmap f)))) env -------------------------------------------------------------------------------- @@ -171,22 +179,21 @@ instance Functor m => Profunctor (Env m s) -- out the @s@ parameter to hide the state threading. -- -- See 'annihilate' for how this interaction occurs in practice. -newtype Server m o i = Server { runServer :: m (i, [o] -> Server m o i) } +newtype Server m o i = Server {runServer :: m (i, [o] -> Server m o i)} deriving (Functor) -instance Functor m => Profunctor (Server m) - where +instance Functor m => Profunctor (Server m) where dimap f g (Server serve) = Server $ fmap (bimap g (dimap (fmap f) (dimap f g))) serve -- | Generate the fixed point of @Env m s o i@ by recursively -- construction an @s -> Server m o i@ action and tupling it with -- the output @i@ from its parent action. -fixEnv :: forall m s o i . Functor m => Env m s o i -> s -> Server m o i +fixEnv :: forall m s o i. Functor m => Env m s o i -> s -> Server m o i fixEnv (Env b) = go - where - go :: s -> Server m o i - go s = Server $ fmap (fmap (fmap go)) $ b s + where + go :: s -> Server m o i + go s = Server $ fmap (fmap (fmap go)) $ b s -------------------------------------------------------------------------------- -- Operations @@ -199,17 +206,20 @@ invmapBot f g (Bot b) = Bot $ \s i -> (b (g s) i) <&> bimap id f -- | Given the sum of two bots, produce a bot who receives the sum of -- the inputs to the input bots and produces a wedge product of their -- outputs. -nudge - :: Monad m => Bot m s i o \/ Bot m s i' o' -> Bot m s (i \/ i') (o \*/ o') -nudge = either - (\(Bot b) -> Bot $ \s -> either - (fmap (fmap (Arrow.first (Just . Left))) $ b s) - (const $ pure $ (,) Nothing s) - ) - (\(Bot b) -> Bot $ \s -> either - (const $ pure $ (,) Nothing s) - (fmap (fmap (Arrow.first (Just . Right))) $ b s) - ) +nudge :: + Monad m => Bot m s i o \/ Bot m s i' o' -> Bot m s (i \/ i') (o \*/ o') +nudge = + either + ( \(Bot b) -> Bot $ \s -> + either + (fmap (fmap (Arrow.first (Just . Left))) $ b s) + (const $ pure $ (,) Nothing s) + ) + ( \(Bot b) -> Bot $ \s -> + either + (const $ pure $ (,) Nothing s) + (fmap (fmap (Arrow.first (Just . Right))) $ b s) + ) -- | Nudge a bot into the left side of a bot with a summed input and -- wedge product output. @@ -223,32 +233,35 @@ nudgeRight = nudge . Right -- | Tuple the states and outputs of two bots who operate on the same -- input @i@. -infixr /\ +infixr 9 /\ + (/\) :: Monad m => Bot m s i o -> Bot m s' i o' -> Bot m (s /\ s') i (o /\ o') (/\) (Bot b1) (Bot b2) = Bot $ \(s, s') i -> do - (nextState , responses ) <- b1 s i + (nextState, responses) <- b1 s i (nextState', responses') <- b2 s' i pure $ (,) (nextState, nextState') (responses, responses') -- | Runs two bots on the same input and then interleaves their output. -infixr /+\ -(/+\) - :: Monad m => Bot m s i o -> Bot m s' i o' -> Bot m (s /\ s') i (o /+\ o') +infixr 9 /+\ + +(/+\) :: + Monad m => Bot m s i o -> Bot m s' i o' -> Bot m (s /\ s') i (o /+\ o') (/+\) (Bot b1) (Bot b2) = Bot $ \(s, s') i -> do interleaveListT (b1 s i) (b2 s' i) <&> \case - This (o , _s ) -> (This o, (s, s')) - That (o', _s') -> (That o', (s, s')) + This (o, _s) -> (This o, (s, s')) + That (o', _s') -> (That o', (s, s')) These (o, _s) (o', _s') -> (These o o', (s, s')) -- | Runs two bots on the same input and then interleaves their -- output, sequencing if they both return an output for the same -- input. -infixr /.\ +infixr 9 /.\ + (/.\) :: Monad m => Bot m s i o -> Bot m s' i o -> Bot m (s /\ s') i o (/.\) (Bot b1) (Bot b2) = Bot $ \(s1, s2) i -> do interleaveListT (b1 s1 i) (b2 s2 i) >>= \case - This (o , s1') -> pure (o, (s1', s2)) - That (o', s2') -> pure (o', (s1, s2')) + This (o, s1') -> pure (o, (s1', s2)) + That (o', s2') -> pure (o', (s1, s2')) These (o, s1') (o', s2') -> toListT [(o, (s1', s2)), (o', (s1', s2'))] -- | Sum the inputs and outputs of two bots who operate on the same @@ -257,7 +270,8 @@ infixr /.\ -- This allows us to combine the behaviors of two bots such that only -- one or the other bot will be executed depending on the input -- provided. -infixr \/ +infixr 9 \/ + (\/) :: Monad m => Bot m s i o -> Bot m s i' o' -> Bot m s (i \/ i') (o \/ o') (\/) (Bot b1) (Bot b2) = Bot $ \s -> either (fmap (first Left) . b1 s) (fmap (first Right) . b2 s) @@ -277,7 +291,7 @@ emptyBot = Bot $ \_ _ -> emptyListT -- | Lift a monad morphism from @m@ to @n@ into a monad morphism from -- @Bot m s i o@ to @Bot n s i o@ -hoistBot :: Functor n => (forall x . m x -> n x) -> Bot m s i o -> Bot n s i o +hoistBot :: Functor n => (forall x. m x -> n x) -> Bot m s i o -> Bot n s i o hoistBot f (Bot b) = Bot $ \s i -> hoistListT f $ b s i -- | Lift a monadic effect @m o@ into a @Bot m s i o@. @@ -294,61 +308,64 @@ liftMatrixIO :: (MonadIO m, MonadError MatrixError m) => MatrixIO x -> m x liftMatrixIO m = liftEither =<< liftIO m readFileMaybe :: String -> IO (Maybe T.Text) -readFileMaybe path = fmap Just (T.readFile path) - `catch` \e -> if isDoesNotExistError e then pure Nothing else throwIO e +readFileMaybe path = + fmap Just (T.readFile path) + `catch` \e -> if isDoesNotExistError e then pure Nothing else throwIO e -- | A Matrix 'Server' for connecting a 'Bot' to the Matrix protocol. -matrix - :: forall m - . (MonadError MatrixError m, MonadIO m) - => ClientSession - -> FilePath - -> Server m (RoomID, Event) [(RoomID, Event)] +matrix :: + forall m. + (MonadError MatrixError m, MonadIO m) => + ClientSession -> + FilePath -> + Server m (RoomID, Event) [(RoomID, Event)] matrix session cache = Server $ do -- Setup cache liftIO $ createDirectoryIfMissing True cache - since <- liftIO $ readFileMaybe $ cache <> "/since_file" + since <- liftIO $ readFileMaybe $ cache <> "/since_file" -- Log in - userId <- liftMatrixIO $ getTokenOwner session + userId <- liftMatrixIO $ getTokenOwner session filterId <- liftMatrixIO $ createFilter session userId messageFilter -- Start looping runServer $ go filterId since - - where - go :: FilterID -> Maybe T.Text -> Server m (RoomID, Event) [(RoomID, Event)] - go filterId since = Server $ do - -- Get conversation events - syncResult <- liftMatrixIO - $ sync session (Just filterId) since (Just Online) (Just 1000) - - -- Unpack sync result - let newSince :: T.Text - newSince = syncResult ^. _srNextBatch - - roomsMap :: Map.Map T.Text JoinedRoomSync - roomsMap = syncResult ^. _srRooms . _Just . _srrJoin . ifolded - - roomEvents :: Map.Map T.Text [RoomEvent] - roomEvents = roomsMap <&> view (_jrsTimeline . _tsEvents . _Just) - - events :: [(RoomID, Event)] - events = Map.foldMapWithKey - (\rid es -> fmap ((RoomID rid, ) . view _reContent) es) - roomEvents - - pure $ (events, ) $ \outputs -> Server $ do - -- Send the bot's responses - gen <- newStdGen - let txnIds = TxnID . T.pack . show <$> randoms @Int gen - liftIO $ zipWithM_ (uncurry $ sendMessage session) outputs txnIds - - -- Update since file - liftIO $ writeFile (cache <> "/since_file") (T.unpack newSince) - - -- Do it again - runServer $ go filterId (Just newSince) + where + go :: FilterID -> Maybe T.Text -> Server m (RoomID, Event) [(RoomID, Event)] + go filterId since = Server $ do + -- Get conversation events + syncResult <- + liftMatrixIO $ + sync session (Just filterId) since (Just Online) (Just 1000) + + -- Unpack sync result + let newSince :: T.Text + newSince = syncResult ^. _srNextBatch + + roomsMap :: Map.Map T.Text JoinedRoomSync + roomsMap = syncResult ^. _srRooms . _Just . _srrJoin . ifolded + + roomEvents :: Map.Map T.Text [RoomEvent] + roomEvents = roomsMap <&> view (_jrsTimeline . _tsEvents . _Just) + + events :: [(RoomID, Event)] + events = + Map.foldMapWithKey + (\rid es -> fmap ((RoomID rid,) . view _reContent) es) + roomEvents + + pure $ + (events,) $ \outputs -> Server $ do + -- Send the bot's responses + gen <- newStdGen + let txnIds = TxnID . T.pack . show <$> randoms @Int gen + liftIO $ zipWithM_ (uncurry $ sendMessage session) outputs txnIds + + -- Update since file + liftIO $ writeFile (cache <> "/since_file") (T.unpack newSince) + + -- Do it again + runServer $ go filterId (Just newSince) -- | Map the input and output of a 'MatrixBot' to allow for simple -- 'T.Text' I/O. @@ -384,25 +401,27 @@ repl = Server $ do hFlush stdout (T.pack -> input) <- liftIO getLine - pure $ (input, ) $ \outputs -> Server $ do - forM_ outputs $ \output -> do - -- Print the bot's responses - liftIO $ putStrLn $ T.unpack $ ">>> " <> output + pure $ + (input,) $ \outputs -> Server $ do + forM_ outputs $ \output -> do + -- Print the bot's responses + liftIO $ putStrLn $ T.unpack $ ">>> " <> output - -- Do it again - runServer repl + -- Do it again + runServer repl -- | Collapse a @Server m o i@ with a @Bahavior m i o@ to create a -- monadic action @m@. annihilate :: Monad m => Server m o i -> Behavior m i o -> Fix m annihilate (Server server) b@(Behavior botBehavior) = Fix $ do (i, nextServer) <- server - xs <- fromListT $ botBehavior i - let o = fmap fst $ xs + xs <- fromListT $ botBehavior i + let o = fmap fst $ xs server' = nextServer o - pure $ annihilate server' $ case xs of - [] -> b - _ -> snd $ last xs + pure $ + annihilate server' $ case xs of + [] -> b + _ -> snd $ last xs loop :: Monad m => Fix m -> m x loop (Fix x) = x >>= loop diff --git a/src/CofreeBot/Bot/Behaviors.hs b/src/CofreeBot/Bot/Behaviors.hs index 0e2af75..a162e2b 100644 --- a/src/CofreeBot/Bot/Behaviors.hs +++ b/src/CofreeBot/Bot/Behaviors.hs @@ -1,20 +1,18 @@ module CofreeBot.Bot.Behaviors - ( module Calculator - , module CoinFlip - , module GHCI - , module Hello - , module Jitsi - , module Magic8Ball - , module Updog - ) where + ( module Calculator, + module CoinFlip, + module GHCI, + module Hello, + module Jitsi, + module Magic8Ball, + module Updog, + ) +where -import CofreeBot.Bot.Behaviors.Calculator - as Calculator -import CofreeBot.Bot.Behaviors.CoinFlip - as CoinFlip -import CofreeBot.Bot.Behaviors.GHCI as GHCI -import CofreeBot.Bot.Behaviors.Hello as Hello -import CofreeBot.Bot.Behaviors.Jitsi as Jitsi -import CofreeBot.Bot.Behaviors.Magic8Ball - as Magic8Ball -import CofreeBot.Bot.Behaviors.Updog as Updog +import CofreeBot.Bot.Behaviors.Calculator as Calculator +import CofreeBot.Bot.Behaviors.CoinFlip as CoinFlip +import CofreeBot.Bot.Behaviors.GHCI as GHCI +import CofreeBot.Bot.Behaviors.Hello as Hello +import CofreeBot.Bot.Behaviors.Jitsi as Jitsi +import CofreeBot.Bot.Behaviors.Magic8Ball as Magic8Ball +import CofreeBot.Bot.Behaviors.Updog as Updog diff --git a/src/CofreeBot/Bot/Behaviors/Calculator.hs b/src/CofreeBot/Bot/Behaviors/Calculator.hs index b29233b..17184a8 100644 --- a/src/CofreeBot/Bot/Behaviors/Calculator.hs +++ b/src/CofreeBot/Bot/Behaviors/Calculator.hs @@ -1,18 +1,19 @@ module CofreeBot.Bot.Behaviors.Calculator - ( calculatorBot - , simplifyCalculatorBot - , printCalcOutput - ) where + ( calculatorBot, + simplifyCalculatorBot, + printCalcOutput, + ) +where -------------------------------------------------------------------------------- -import CofreeBot.Bot -import CofreeBot.Bot.Behaviors.Calculator.Language -import CofreeBot.Utils -import Control.Monad.Reader -import Control.Monad.State -import Data.Profunctor -import qualified Data.Text as T +import CofreeBot.Bot +import CofreeBot.Bot.Behaviors.Calculator.Language +import CofreeBot.Utils +import Control.Monad.Reader +import Control.Monad.State +import Data.Profunctor +import Data.Text qualified as T -------------------------------------------------------------------------------- @@ -29,15 +30,15 @@ parseErrorBot = pureStatelessBot $ \ParseError {..} -> <> parseError <> "\"." -simplifyCalculatorBot - :: Monad m - => Bot m s Program (Either CalcError CalcResp) - -> Bot m s T.Text T.Text +simplifyCalculatorBot :: + Monad m => + Bot m s Program (Either CalcError CalcResp) -> + Bot m s T.Text T.Text simplifyCalculatorBot bot = dimap parseProgram indistinct $ parseErrorBot \/ rmap printCalcOutput bot printCalcOutput :: Either CalcError CalcResp -> T.Text printCalcOutput = \case - Left err -> T.pack $ show err - Right Ack -> "*variable saved*" + Left err -> T.pack $ show err + Right Ack -> "*variable saved*" Right (Log e n) -> T.pack $ show e <> " = " <> show n diff --git a/src/CofreeBot/Bot/Behaviors/Calculator/Language.hs b/src/CofreeBot/Bot/Behaviors/Calculator/Language.hs index cbb8fbd..754e153 100644 --- a/src/CofreeBot/Bot/Behaviors/Calculator/Language.hs +++ b/src/CofreeBot/Bot/Behaviors/Calculator/Language.hs @@ -1,23 +1,25 @@ {-# OPTIONS -fdefer-typed-holes -Wno-orphans #-} -{-# language RankNTypes #-} +{-# LANGUAGE RankNTypes #-} + module CofreeBot.Bot.Behaviors.Calculator.Language where -import CofreeBot.Utils -import Control.Applicative -import Control.Monad.Error.Class -import Control.Monad.Except -import Control.Monad.RWS.Class -import Control.Monad.State -import Data.Attoparsec.Text as A -import Data.Bifunctor -import Data.Char ( isAlpha - , isDigit - ) -import Data.Foldable -import Data.Functor -import qualified Data.List.NonEmpty as NE -import qualified Data.Map.Strict as Map -import qualified Data.Text as T +import CofreeBot.Utils +import Control.Applicative +import Control.Monad.Error.Class +import Control.Monad.Except +import Control.Monad.RWS.Class +import Control.Monad.State +import Data.Attoparsec.Text as A +import Data.Bifunctor +import Data.Char + ( isAlpha, + isDigit, + ) +import Data.Foldable +import Data.Functor +import Data.List.NonEmpty qualified as NE +import Data.Map.Strict qualified as Map +import Data.Text qualified as T -------------------------------------------------------------------------------- -- Utils @@ -48,7 +50,7 @@ data Expr data Statement = Let T.Text Expr | StdOut Expr - deriving Show + deriving (Show) type Program = NE.NonEmpty Statement @@ -73,24 +75,26 @@ varNameP = fmap (uncurry T.cons) $ letter |*| A.takeWhile (liftA2 (||) isAlpha isDigit) exprP :: Parser Expr -exprP = asum - [ fmap (uncurry Add) $ (exprP `infixOp` exprP) $ "+" - , fmap (uncurry Mult) $ (exprP `infixOp` exprP) $ "*" - , Neg <$> ("-" *> exprP) - , fmap Val $ decimal - , fmap Var $ varNameP - ] +exprP = + asum + [ fmap (uncurry Add) $ (exprP `infixOp` exprP) $ "+", + fmap (uncurry Mult) $ (exprP `infixOp` exprP) $ "*", + Neg <$> ("-" *> exprP), + fmap Val $ decimal, + fmap Var $ varNameP + ] statementP :: Parser Statement -statementP = asum - [ varNameP - |*| some space - |*| ":=" - |*| some space - |*| exprP - <&> \(var :& _ :& _ :& _ :& expr) -> Let var expr - , StdOut <$> exprP - ] +statementP = + asum + [ varNameP + |*| some space + |*| ":=" + |*| some space + |*| exprP + <&> \(var :& _ :& _ :& _ :& expr) -> Let var expr, + StdOut <$> exprP + ] programP :: Parser Program programP = @@ -107,8 +111,8 @@ programP = -- $> parseOnly programP "x := ((11 + 12) + 13)\nx + 1" data ParseError = ParseError - { parseInput :: T.Text - , parseError :: T.Text + { parseInput :: T.Text, + parseError :: T.Text } parseProgram :: T.Text -> Either ParseError Program @@ -120,7 +124,7 @@ parseProgram txt = first (ParseError txt . T.pack) $ parseOnly programP txt data CalcResp = Log Expr Int | Ack data CalcError = LookupError T.Text - deriving Show + deriving (Show) type CalcState = Map.Map T.Text Int @@ -129,10 +133,10 @@ eval :: Expr -> ExceptT CalcError (State CalcState) Int eval = \case Var var -> maybe (throwError $ LookupError var) pure =<< gets (Map.lookup var) - Val n -> pure n - Add x y -> liftA2 (+) (eval x) (eval y) + Val n -> pure n + Add x y -> liftA2 (+) (eval x) (eval y) Mult x y -> liftA2 (*) (eval x) (eval y) - Neg x -> fmap negate (eval x) + Neg x -> fmap negate (eval x) -- | Interpret a language statement into response. interpretStatement :: Statement -> ExceptT CalcError (State CalcState) CalcResp diff --git a/src/CofreeBot/Bot/Behaviors/CoinFlip.hs b/src/CofreeBot/Bot/Behaviors/CoinFlip.hs index 6c01d03..478932e 100644 --- a/src/CofreeBot/Bot/Behaviors/CoinFlip.hs +++ b/src/CofreeBot/Bot/Behaviors/CoinFlip.hs @@ -2,14 +2,14 @@ module CofreeBot.Bot.Behaviors.CoinFlip where -------------------------------------------------------------------------------- -import CofreeBot.Bot -import CofreeBot.Utils.ListT ( emptyListT ) -import Control.Monad.Reader -import Data.Attoparsec.Text -import Data.Bifunctor ( bimap ) -import Data.Profunctor -import qualified Data.Text as T -import System.Random +import CofreeBot.Bot +import CofreeBot.Utils.ListT (emptyListT) +import Control.Monad.Reader +import Data.Attoparsec.Text +import Data.Bifunctor (bimap) +import Data.Profunctor +import Data.Text qualified as T +import System.Random -------------------------------------------------------------------------------- @@ -17,20 +17,20 @@ coinFlipBot :: Bot IO () () Bool coinFlipBot = do randomIO -simplifyCoinFlipBot :: forall s . Bot IO s () Bool -> TextBot IO s +simplifyCoinFlipBot :: forall s. Bot IO s () Bool -> TextBot IO s simplifyCoinFlipBot b = do t <- ask case to t of - Left _err -> Bot $ pure $ const emptyListT - Right _ -> dimap (const ()) from $ b - where - to :: T.Text -> Either T.Text () - to = fmap (bimap T.pack id) $ parseOnly parseCoinFlipCommand + Left _err -> Bot $ pure $ const emptyListT + Right _ -> dimap (const ()) from $ b + where + to :: T.Text -> Either T.Text () + to = fmap (bimap T.pack id) $ parseOnly parseCoinFlipCommand - from :: Bool -> T.Text - from = \case - True -> "Coin Flip Result: True" - False -> "Coin Flip Result: False" + from :: Bool -> T.Text + from = \case + True -> "Coin Flip Result: True" + False -> "Coin Flip Result: False" parseCoinFlipCommand :: Parser () parseCoinFlipCommand = "flip a coin" *> pure () diff --git a/src/CofreeBot/Bot/Behaviors/GHCI.hs b/src/CofreeBot/Bot/Behaviors/GHCI.hs index e4ba760..cd66b49 100644 --- a/src/CofreeBot/Bot/Behaviors/GHCI.hs +++ b/src/CofreeBot/Bot/Behaviors/GHCI.hs @@ -1,23 +1,25 @@ {-# LANGUAGE NumDecimals #-} + module CofreeBot.Bot.Behaviors.GHCI - ( ghciBot - , ghciConfig - , hGetOutput - ) where + ( ghciBot, + ghciConfig, + hGetOutput, + ) +where -------------------------------------------------------------------------------- -import CofreeBot.Bot -import CofreeBot.Utils -import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.Loops ( whileM ) -import Data.Attoparsec.Text as A -import Data.Profunctor -import qualified Data.Text as T -import GHC.Conc ( threadDelay ) -import System.IO -import System.Process.Typed +import CofreeBot.Bot +import CofreeBot.Utils +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Loops (whileM) +import Data.Attoparsec.Text as A +import Data.Profunctor +import Data.Text qualified as T +import GHC.Conc (threadDelay) +import System.IO +import System.Process.Typed -------------------------------------------------------------------------------- @@ -26,9 +28,9 @@ hGetOutput handle = whileM (hReady handle) (hGetChar handle) ghciBot' :: Process Handle Handle () -> Bot IO () T.Text T.Text ghciBot' p = - mapMaybeBot (either (const Nothing) Just . parseOnly ghciInputParser) - $ Bot - $ \s i -> do + mapMaybeBot (either (const Nothing) Just . parseOnly ghciInputParser) $ + Bot $ + \s i -> do o <- liftIO $ do hPutStrLn (getStdin p) $ T.unpack i hFlush (getStdin p) @@ -38,16 +40,18 @@ ghciBot' p = ghciBot :: Process Handle Handle () -> Bot IO () T.Text T.Text ghciBot p = - dimap (distinguish (/= "ghci: :q")) indistinct - $ pureStatelessBot (const $ "I'm Sorry Dave") - \/ ghciBot' p + dimap (distinguish (/= "ghci: :q")) indistinct $ + pureStatelessBot (const $ "I'm Sorry Dave") + \/ ghciBot' p ghciConfig :: ProcessConfig Handle Handle () -ghciConfig = setStdin createPipe $ setStdout createPipe $ shell - "docker run -i --rm haskell 2>&1" +ghciConfig = + setStdin createPipe $ + setStdout createPipe $ + shell + "docker run -i --rm haskell 2>&1" ghciInputParser :: Parser T.Text ghciInputParser = do void $ "ghci: " T.pack <$> many1 anyChar - diff --git a/src/CofreeBot/Bot/Behaviors/Hello.hs b/src/CofreeBot/Bot/Behaviors/Hello.hs index d06dff5..43bdc56 100644 --- a/src/CofreeBot/Bot/Behaviors/Hello.hs +++ b/src/CofreeBot/Bot/Behaviors/Hello.hs @@ -1,15 +1,16 @@ -- | The Simplest Bot. This module serves as an introductory example -- for bot construction. module CofreeBot.Bot.Behaviors.Hello - ( helloSimpleBot - , helloMatrixBot - ) where + ( helloSimpleBot, + helloMatrixBot, + ) +where -------------------------------------------------------------------------------- -import CofreeBot.Bot -import CofreeBot.Utils.ListT ( emptyListT ) -import qualified Data.Text as T +import CofreeBot.Bot +import CofreeBot.Utils.ListT (emptyListT) +import Data.Text qualified as T -------------------------------------------------------------------------------- @@ -18,7 +19,7 @@ import qualified Data.Text as T helloSimpleBot :: Monad m => TextBot m s helloSimpleBot = Bot $ \s msg -> let name = "cofree-bot" - in if name `T.isInfixOf` msg + in if name `T.isInfixOf` msg then pure ("Are you talking to me, punk?", s) else emptyListT diff --git a/src/CofreeBot/Bot/Behaviors/Jitsi.hs b/src/CofreeBot/Bot/Behaviors/Jitsi.hs index 5846515..1742465 100644 --- a/src/CofreeBot/Bot/Behaviors/Jitsi.hs +++ b/src/CofreeBot/Bot/Behaviors/Jitsi.hs @@ -1,16 +1,17 @@ module CofreeBot.Bot.Behaviors.Jitsi - ( jitsiBot - ) where + ( jitsiBot, + ) +where -------------------------------------------------------------------------------- -import CofreeBot.Bot -import CofreeBot.Bot.Behaviors.Jitsi.Dictionary -import CofreeBot.Utils ( indistinct ) -import Data.Profunctor -import qualified Data.Text as T -import qualified Data.Vector as V -import System.Random +import CofreeBot.Bot +import CofreeBot.Bot.Behaviors.Jitsi.Dictionary +import CofreeBot.Utils (indistinct) +import Data.Profunctor +import Data.Text qualified as T +import Data.Vector qualified as V +import System.Random -------------------------------------------------------------------------------- @@ -22,18 +23,18 @@ pickRandomElement vs = do jitsiBot' :: IO T.Text jitsiBot' = do adjective <- pickRandomElement adjectives - noun <- pickRandomElement pluralNouns - verb <- pickRandomElement verbs - adverb <- pickRandomElement adverbs + noun <- pickRandomElement pluralNouns + verb <- pickRandomElement verbs + adverb <- pickRandomElement adverbs let url = "https://meet.jit.si/" <> adjective <> noun <> verb <> adverb pure $ url jitsiBot :: TextBot IO () jitsiBot = dimap - (\i -> + ( \i -> if (i == "🍐" || i == "pair" || i == "pair") then Right () else Left () - ) - indistinct - $ emptyBot - \/ liftEffect jitsiBot' + ) + indistinct + $ emptyBot + \/ liftEffect jitsiBot' diff --git a/src/CofreeBot/Bot/Behaviors/Jitsi/Dictionary.hs b/src/CofreeBot/Bot/Behaviors/Jitsi/Dictionary.hs index b68cfdc..73ed4af 100644 --- a/src/CofreeBot/Bot/Behaviors/Jitsi/Dictionary.hs +++ b/src/CofreeBot/Bot/Behaviors/Jitsi/Dictionary.hs @@ -1,5591 +1,5592 @@ {-# LANGUAGE OverloadedLists #-} + module CofreeBot.Bot.Behaviors.Jitsi.Dictionary where -import qualified Data.Text as T -import qualified Data.Vector as V +import Data.Text qualified as T +import Data.Vector qualified as V pluralNouns :: V.Vector T.Text pluralNouns = - [ "Abilities" - , "Absences" - , "Abundances" - , "Academics" - , "Academies" - , "Accents" - , "Acceptances" - , "Accesses" - , "Accidents" - , "Accommodations" - , "Accomplishments" - , "Accordances" - , "Accountabilities" - , "Accountants" - , "Accounts" - , "Accumulations" - , "Accuracies" - , "Accusations" - , "Accused" - , "Achievements" - , "Acids" - , "Acquisitions" - , "Acres" - , "Actions" - , "Activations" - , "Activists" - , "Activities" - , "Actors" - , "Actresses" - , "Acts" - , "Adaptations" - , "Addictions" - , "Additions" - , "Addresses" - , "Adjustments" - , "Administrations" - , "Administrators" - , "Admissions" - , "Adolescents" - , "Adoptions" - , "Ads" - , "Adults" - , "Advances" - , "Advantages" - , "Adventures" - , "Advertisements" - , "Advertisings" - , "Advice" - , "Advocates" - , "Affairs" - , "Affections" - , "Aftermaths" - , "Afternoons" - , "Agencies" - , "Agendas" - , "Agents" - , "Ages" - , "Aggressions" - , "Agreements" - , "Agricultures" - , "Aides" - , "Alarms" - , "Albums" - , "Alerts" - , "Aliens" - , "Alignments" - , "Allegations" - , "Alliances" - , "Allies" - , "Allocations" - , "Allowances" - , "Alternatives" - , "Aluminium" - , "Amateurs" - , "Ambassadors" - , "Ambitions" - , "Ambulances" - , "Amendments" - , "Amounts" - , "Analogies" - , "Analyses" - , "Analysts" - , "Ancestors" - , "Anchors" - , "Angels" - , "Angers" - , "Angles" - , "Animals" - , "Animations" - , "Ankles" - , "Anniversaries" - , "Announcements" - , "Answers" - , "Anxieties" - , "Apartments" - , "Apologies" - , "Apparatus" - , "Appeals" - , "Appearances" - , "Appetites" - , "Apples" - , "Applicants" - , "Applications" - , "Appointments" - , "Appreciations" - , "Approaches" - , "Approvals" - , "Apps" - , "Aprils" - , "Architects" - , "Architectures" - , "Archives" - , "Areas" - , "Arenas" - , "Arguments" - , "Armies" - , "Arrangements" - , "Arrays" - , "Arrests" - , "Arrivals" - , "Arrows" - , "Articles" - , "Artists" - , "Arts" - , "Artworks" - , "Ashes" - , "Aspects" - , "Aspirations" - , "Assaults" - , "Assemblies" - , "Assertions" - , "Assessments" - , "Assets" - , "Assignments" - , "Assistances" - , "Assistants" - , "Associations" - , "Assumptions" - , "Assurances" - , "Asylums" - , "Athletes" - , "Atmospheres" - , "Attachments" - , "Attacks" - , "Attempts" - , "Attendances" - , "Attentions" - , "Attitudes" - , "Attorneys" - , "Attractions" - , "Attributes" - , "Auctions" - , "Audiences" - , "Audits" - , "Augusts" - , "Aunts" - , "Authorities" - , "Authors" - , "Autonomies" - , "Autos" - , "Autumns" - , "Availabilities" - , "Averages" - , "Awards" - , "Awarenesses" - , "Babies" - , "Backdrops" - , "Backgrounds" - , "Backings" - , "Backs" - , "Backups" - , "Bacterias" - , "Badges" - , "Bags" - , "Bails" - , "Balances" - , "Ballets" - , "Balloons" - , "Ballots" - , "Balls" - , "Bananas" - , "Bands" - , "Banks" - , "Banners" - , "Bans" - , "Bargains" - , "Barrels" - , "Barriers" - , "Bars" - , "Baseballs" - , "Basements" - , "Bases" - , "Basketballs" - , "Baskets" - , "Basses" - , "Bathrooms" - , "Baths" - , "Bats" - , "Batteries" - , "Battlefields" - , "Battles" - , "Bays" - , "Beaches" - , "Beams" - , "Beans" - , "Bears" - , "Beasts" - , "Beats" - , "Beauties" - , "Bedrooms" - , "Beds" - , "Beefs" - , "Beers" - , "Bees" - , "Beginnings" - , "Behalves" - , "Behaviours" - , "Beings" - , "Beliefs" - , "Bells" - , "Belts" - , "Benches" - , "Benchmarks" - , "Bends" - , "Beneficiaries" - , "Benefits" - , "Bests" - , "Bets" - , "Betters" - , "Biases" - , "Bicycles" - , "Bids" - , "Bikes" - , "Bills" - , "Bins" - , "Biographies" - , "Biologies" - , "Birds" - , "Birthdays" - , "Births" - , "Biscuits" - , "Bishops" - , "Bites" - , "Bits" - , "Blades" - , "Blames" - , "Blankets" - , "Blanks" - , "Blasts" - , "Blends" - , "Blessings" - , "Blocks" - , "Blogs" - , "Bloods" - , "Blows" - , "Blues" - , "Boards" - , "Boats" - , "Bonds" - , "Bones" - , "Bonus" - , "Bookings" - , "Books" - , "Booms" - , "Boosts" - , "Boots" - , "Borders" - , "Bosses" - , "Bottles" - , "Boundaries" - , "Bowls" - , "Bows" - , "Boxes" - , "Brains" - , "Branches" - , "Brands" - , "Breaches" - , "Breads" - , "Breakdowns" - , "Breakfasts" - , "Breaks" - , "Breakthroughs" - , "Breathings" - , "Breaths" - , "Breeds" - , "Brethren" - , "Bricks" - , "Brides" - , "Bridges" - , "Broadbands" - , "Broadcasters" - , "Broadcasts" - , "Browsers" - , "Brushes" - , "Bubbles" - , "Bucks" - , "Buddies" - , "Budgets" - , "Buffers" - , "Bugs" - , "Buildings" - , "Bulks" - , "Bullets" - , "Bunches" - , "Burdens" - , "Bureaucracies" - , "Burials" - , "Burns" - , "Buses" - , "Bushes" - , "Businesses" - , "Businessmen" - , "Butters" - , "Buttons" - , "Cabinets" - , "Cabins" - , "Cables" - , "Cafes" - , "Cakes" - , "Calculations" - , "Calls" - , "Calms" - , "Cameras" - , "Campaigns" - , "Campings" - , "Camps" - , "Campus" - , "Canals" - , "Candidates" - , "Candles" - , "Cans" - , "Canvas" - , "Capabilities" - , "Capacities" - , "Capitalisms" - , "Capitals" - , "Caps" - , "Captains" - , "Captures" - , "Carbons" - , "Cards" - , "Careers" - , "Cares" - , "Cargoes" - , "Carpets" - , "Carriages" - , "Carrots" - , "Cars" - , "Cartoons" - , "Cases" - , "Cashes" - , "Casinos" - , "Castles" - , "Casts" - , "Catalogues" - , "Catches" - , "Categories" - , "Cats" - , "Cattle" - , "Causes" - , "Cautions" - , "Caves" - , "Cds" - , "Ceilings" - , "Celebrations" - , "Celebrities" - , "Cells" - , "Cemeteries" - , "Centres" - , "Cents" - , "Centuries" - , "Ceremonies" - , "Certainties" - , "Certificates" - , "Chains" - , "Chairmen" - , "Chairs" - , "Challenges" - , "Chambers" - , "Champions" - , "Championships" - , "Chances" - , "Changes" - , "Channels" - , "Chaos" - , "Chapters" - , "Characteristics" - , "Characters" - , "Charges" - , "Charities" - , "Charms" - , "Charters" - , "Charts" - , "Chases" - , "Chats" - , "Cheats" - , "Checks" - , "Cheeks" - , "Cheers" - , "Cheeses" - , "Chefs" - , "Chemicals" - , "Chemistries" - , "Chests" - , "Chickens" - , "Chiefs" - , "Childhoods" - , "Chips" - , "Chocolates" - , "Choices" - , "Choirs" - , "Chunks" - , "Churches" - , "Cigarettes" - , "Cinemas" - , "Circles" - , "Circuits" - , "Circulations" - , "Circumstances" - , "Cities" - , "Citizens" - , "Citizenships" - , "Civilians" - , "Civilizations" - , "Claims" - , "Clarities" - , "Clashes" - , "Classes" - , "Classics" - , "Classifications" - , "Classrooms" - , "Clauses" - , "Clerks" - , "Clicks" - , "Clients" - , "Cliffs" - , "Climates" - , "Climbs" - , "Clinics" - , "Clips" - , "Clocks" - , "Closes" - , "Closures" - , "Clothes" - , "Clothings" - , "Cloths" - , "Clouds" - , "Clubs" - , "Clues" - , "Clusters" - , "Coaches" - , "Coalitions" - , "Coals" - , "Coasts" - , "Coats" - , "Cocktails" - , "Codes" - , "Coffees" - , "Coincidences" - , "Coins" - , "Colds" - , "Collaborations" - , "Collapses" - , "Colleagues" - , "Collections" - , "Collectors" - , "Colleges" - , "Collisions" - , "Colonies" - , "Colours" - , "Columnists" - , "Columns" - , "Combats" - , "Combinations" - , "Comedies" - , "Comforts" - , "Comics" - , "Commanders" - , "Commands" - , "Commentaries" - , "Commentators" - , "Comments" - , "Commerces" - , "Commercials" - , "Commissioners" - , "Commissions" - , "Commitments" - , "Committees" - , "Commodities" - , "Communications" - , "Communities" - , "Companies" - , "Companions" - , "Comparisons" - , "Compassions" - , "Compensations" - , "Competences" - , "Competitions" - , "Competitors" - , "Complaints" - , "Completions" - , "Complexes" - , "Complexities" - , "Compliances" - , "Complications" - , "Components" - , "Composers" - , "Compositions" - , "Compounds" - , "Compromises" - , "Computers" - , "Concentrations" - , "Conceptions" - , "Concepts" - , "Concerns" - , "Concerts" - , "Concessions" - , "Conclusions" - , "Concretes" - , "Conditions" - , "Conducts" - , "Conferences" - , "Confessions" - , "Confidences" - , "Configurations" - , "Confirmations" - , "Conflicts" - , "Confrontations" - , "Confusions" - , "Congregations" - , "Connections" - , "Consciences" - , "Consciousnesses" - , "Consensus" - , "Consents" - , "Consequences" - , "Conservations" - , "Conservatives" - , "Considerations" - , "Consistencies" - , "Conspiracies" - , "Constituencies" - , "Constitutions" - , "Constraints" - , "Constructions" - , "Consultants" - , "Consultations" - , "Consumers" - , "Consumptions" - , "Contacts" - , "Containers" - , "Contempts" - , "Contenders" - , "Contentions" - , "Contents" - , "Contests" - , "Contexts" - , "Continents" - , "Contractors" - , "Contracts" - , "Contradictions" - , "Contraries" - , "Contrasts" - , "Contributions" - , "Contributors" - , "Controls" - , "Controversies" - , "Conveniences" - , "Conventions" - , "Conversations" - , "Conversions" - , "Convictions" - , "Cookers" - , "Cookings" - , "Cooks" - , "Coordinations" - , "Coordinators" - , "Copies" - , "Coppers" - , "Cops" - , "Copyrights" - , "Cores" - , "Corners" - , "Corporations" - , "Corrections" - , "Correlations" - , "Correspondences" - , "Correspondents" - , "Corridors" - , "Corruptions" - , "Costs" - , "Costumes" - , "Cottages" - , "Cottons" - , "Councillors" - , "Councils" - , "Counsellings" - , "Counsellors" - , "Counterparts" - , "Counters" - , "Counties" - , "Countries" - , "Countrysides" - , "Counts" - , "Couples" - , "Coups" - , "Courages" - , "Courses" - , "Courtesies" - , "Courts" - , "Cousins" - , "Coverages" - , "Covers" - , "Cows" - , "Cracks" - , "Crafts" - , "Crashes" - , "Creams" - , "Creations" - , "Creativities" - , "Creators" - , "Creatures" - , "Credibilities" - , "Credits" - , "Crews" - , "Cries" - , "Crises" - , "Criteria" - , "Criticisms" - , "Critics" - , "Critiques" - , "Crops" - , "Crosses" - , "Crowds" - , "Crowns" - , "Cruises" - , "Crystals" - , "Cues" - , "Cults" - , "Cultures" - , "Cupboards" - , "Cups" - , "Cures" - , "Curiosities" - , "Currencies" - , "Currents" - , "Curricula" - , "Curtains" - , "Custodies" - , "Customers" - , "Customs" - , "Cuts" - , "Cuttings" - , "Cycles" - , "Dads" - , "Dairies" - , "Damages" - , "Dams" - , "Dancers" - , "Dances" - , "Dancings" - , "Dangers" - , "Darknesses" - , "Darks" - , "Databases" - , "Dates" - , "Daughters" - , "Dawns" - , "Days" - , "Deadlines" - , "Dealers" - , "Deals" - , "Debates" - , "Debris" - , "Debts" - , "Debuts" - , "Decades" - , "Decembers" - , "DecisionMakings" - , "Decisions" - , "Decks" - , "Declarations" - , "Declines" - , "Decorations" - , "Decreases" - , "Dedications" - , "Deeds" - , "Defaults" - , "Defeats" - , "Defects" - , "Defences" - , "Defenders" - , "Deficiencies" - , "Deficits" - , "Definitions" - , "Degrees" - , "Delays" - , "Delegates" - , "Delegations" - , "Delights" - , "Deliveries" - , "Demands" - , "Democracies" - , "Demons" - , "Demonstrations" - , "Denials" - , "Densities" - , "Dentists" - , "Departments" - , "Departures" - , "Dependences" - , "Deployments" - , "Deposits" - , "Depressions" - , "Depths" - , "Deputies" - , "Descents" - , "Descriptions" - , "Deserts" - , "Designers" - , "Designs" - , "Desires" - , "Desks" - , "Desktops" - , "Destinations" - , "Destructions" - , "Details" - , "Detections" - , "Detectives" - , "Detentions" - , "Determinations" - , "Developments" - , "Devices" - , "Devils" - , "Diagnoses" - , "Diagrams" - , "Dialogues" - , "Diamonds" - , "Diaries" - , "Dictators" - , "Dictionaries" - , "Diets" - , "Differences" - , "Difficulties" - , "Dignities" - , "Dilemmas" - , "Dimensions" - , "Dinners" - , "Diplomats" - , "Directions" - , "Directories" - , "Directors" - , "Dirts" - , "Disabilities" - , "Disadvantages" - , "Disagreements" - , "Disappointments" - , "Disciplines" - , "Disclosures" - , "Discounts" - , "Discourses" - , "Discoveries" - , "Discretions" - , "Discs" - , "Discussions" - , "Dishes" - , "Disks" - , "Dislikes" - , "Dismissals" - , "Disorders" - , "Displays" - , "Disposals" - , "Disputes" - , "Disruptions" - , "Distances" - , "Distinctions" - , "Distresses" - , "Distributions" - , "Districts" - , "Diversities" - , "Dives" - , "Divides" - , "Divisions" - , "Divorces" - , "Doctors" - , "Doctrines" - , "Documentaries" - , "Documentations" - , "Documents" - , "Dogs" - , "Dollars" - , "Domains" - , "Dominances" - , "Donations" - , "Donors" - , "Doors" - , "Doses" - , "Dots" - , "Doubts" - , "Downloads" - , "Downtowns" - , "Dozens" - , "Drafts" - , "Dramas" - , "Drawings" - , "Dreams" - , "Dresses" - , "Drinks" - , "Drivers" - , "Drives" - , "Drivings" - , "Drops" - , "Droughts" - , "Drums" - , "Duos" - , "Durations" - , "Dusts" - , "Duties" - , "Dvds" - , "Dynamics" - , "Earnings" - , "Ears" - , "Earthquakes" - , "Earths" - , "Eases" - , "Easts" - , "Echoes" - , "Economics" - , "Economies" - , "Economists" - , "Edges" - , "Editions" - , "Editors" - , "Educations" - , "Educators" - , "Effectivenesses" - , "Effects" - , "Efficiencies" - , "Efforts" - , "Eggs" - , "Egos" - , "Elbows" - , "Elections" - , "Electricities" - , "Electronics" - , "Elements" - , "Elephants" - , "Elites" - , "Emails" - , "Embarrassments" - , "Embassies" - , "Emergences" - , "Emergencies" - , "Emissions" - , "Emotions" - , "Emphases" - , "Empires" - , "Employees" - , "Employers" - , "Employments" - , "Encounters" - , "Encouragements" - , "Endeavours" - , "Endings" - , "Endorsements" - , "Ends" - , "Enemies" - , "Energies" - , "Enforcements" - , "Engagements" - , "Engineerings" - , "Engineers" - , "Engines" - , "Enquiries" - , "Enterprises" - , "Entertainments" - , "Enthusiasms" - , "Enthusiasts" - , "Entities" - , "Entrances" - , "Entrepreneurs" - , "Entries" - , "Envelopes" - , "Environments" - , "Epidemics" - , "Episodes" - , "Equalities" - , "Equals" - , "Equations" - , "Equipment" - , "Equivalents" - , "Eras" - , "Errors" - , "Escapes" - , "Essays" - , "Essences" - , "Establishments" - , "Estates" - , "Estimates" - , "Ethics" - , "Euros" - , "Evaluations" - , "Evenings" - , "Events" - , "Evidence" - , "Evils" - , "Evolutions" - , "Examinations" - , "Examples" - , "Exams" - , "Excellences" - , "Exceptions" - , "Excesses" - , "Exchanges" - , "Excitements" - , "Exclusions" - , "Excuses" - , "Executives" - , "Exercises" - , "Exhibitions" - , "Exhibits" - , "Exiles" - , "Existences" - , "Exits" - , "Expansions" - , "Expectations" - , "Expeditions" - , "Expenditures" - , "Expenses" - , "Experiences" - , "Experiments" - , "Expertises" - , "Experts" - , "Explanations" - , "Exploitations" - , "Explorations" - , "Explosions" - , "Explosives" - , "Exports" - , "Exposures" - , "Expressions" - , "Extensions" - , "Extents" - , "Extracts" - , "Extras" - , "Extremes" - , "Eyes" - , "Fabrics" - , "Faces" - , "Facilities" - , "Factions" - , "Factories" - , "Factors" - , "Facts" - , "Faculties" - , "Failures" - , "Fairnesses" - , "Faiths" - , "Falls" - , "Fames" - , "Families" - , "Fans" - , "Fantasies" - , "Fares" - , "Farmers" - , "Farmings" - , "Farms" - , "Fashions" - , "Fates" - , "Fats" - , "Faults" - , "Favourites" - , "Favours" - , "Fears" - , "Feathers" - , "Feats" - , "Features" - , "Februaries" - , "Feedbacks" - , "Feeds" - , "Feelings" - , "Feels" - , "Fees" - , "Feet" - , "Feminists" - , "Fences" - , "Festivals" - , "Fevers" - , "Fibres" - , "Fictions" - , "Fields" - , "Fightings" - , "Fights" - , "Figures" - , "Files" - , "FilmMakers" - , "Films" - , "Filters" - , "Finals" - , "Finances" - , "Findings" - , "Fines" - , "Fingers" - , "Finishes" - , "Firefighters" - , "Fires" - , "Fireworks" - , "Firms" - , "Firsts" - , "Fish" - , "Fishings" - , "Fitnesses" - , "Fits" - , "Fixes" - , "Fixtures" - , "Flags" - , "Flames" - , "Flashes" - , "Flats" - , "Flavours" - , "Flaws" - , "Fleets" - , "Fleshes" - , "Flexibilities" - , "Flies" - , "Flights" - , "Floods" - , "Floors" - , "Flours" - , "Flowers" - , "Flows" - , "Fluids" - , "Flus" - , "Flyings" - , "Foci" - , "Folds" - , "Folks" - , "Followings" - , "Foods" - , "Fools" - , "Footages" - , "Footballs" - , "Forces" - , "Forecasts" - , "Foreigners" - , "Forests" - , "Forks" - , "Formations" - , "Formats" - , "Forms" - , "Formulae" - , "Fortunes" - , "Forums" - , "Fossils" - , "Foundations" - , "Founders" - , "Fractions" - , "Fragments" - , "Frames" - , "Frameworks" - , "Franchises" - , "Frauds" - , "Freedoms" - , "Frequencies" - , "Fridays" - , "Fridges" - , "Friends" - , "Friendships" - , "Frogs" - , "Fronts" - , "Fruits" - , "Frustrations" - , "Fuels" - , "Functions" - , "Fundings" - , "Fundraisings" - , "Funds" - , "Funerals" - , "Funs" - , "Furnitures" - , "Furs" - , "Futures" - , "Gains" - , "Galleries" - , "Gallons" - , "Gamblings" - , "Games" - , "Gamings" - , "Gaps" - , "Garages" - , "Gardens" - , "Gases" - , "Gates" - , "Gatherings" - , "Gazes" - , "Gears" - , "Genders" - , "Generations" - , "Genes" - , "Genius" - , "Genres" - , "Gentlemen" - , "Geographies" - , "Gestures" - , "Ghosts" - , "Giants" - , "Gifts" - , "Gigs" - , "Glances" - , "Glasses" - , "Glimpses" - , "Globalizations" - , "Globes" - , "Glories" - , "Gloves" - , "Goals" - , "Gods" - , "Goes" - , "Gold" - , "Golfs" - , "Goodbyes" - , "Goodnesses" - , "Goods" - , "Governances" - , "Governments" - , "Governors" - , "Graces" - , "Grades" - , "Graduates" - , "Grains" - , "Grandfathers" - , "Grandmothers" - , "Grandparents" - , "Grants" - , "Graphics" - , "Grasps" - , "Grasses" - , "Graves" - , "Gravities" - , "Greenhouses" - , "Greens" - , "Greys" - , "Grids" - , "Griefs" - , "Grins" - , "Grips" - , "Groceries" - , "Grounds" - , "Groups" - , "Growths" - , "Guarantees" - , "Guards" - , "Guerrillas" - , "Guesses" - , "Guests" - , "Guidances" - , "Guidelines" - , "Guides" - , "Guilts" - , "Guitars" - , "Guts" - , "Guys" - , "Gyms" - , "Habitats" - , "Habits" - , "Hairs" - , "Halls" - , "Halts" - , "Halves" - , "Handfuls" - , "Handles" - , "Handlings" - , "Hands" - , "Happinesses" - , "Harassments" - , "Harbours" - , "Hardwares" - , "Harmonies" - , "Harms" - , "Harvests" - , "Hats" - , "Hazards" - , "Headaches" - , "Headlines" - , "Headquarters" - , "Heads" - , "Healthcares" - , "Healths" - , "Hearings" - , "Hearts" - , "Heatings" - , "Heats" - , "Heavens" - , "Heels" - , "Heights" - , "Helicopters" - , "Hellos" - , "Hells" - , "Helmets" - , "Helps" - , "Herbs" - , "Heritages" - , "Heroes" - , "Hierarchies" - , "Highlights" - , "Highs" - , "Highways" - , "Hills" - , "Hints" - , "Hips" - , "Hires" - , "Historians" - , "Histories" - , "Hits" - , "Hobbies" - , "Hockeys" - , "Holds" - , "Holes" - , "Holidays" - , "Homelands" - , "Homes" - , "Homework" - , "Honesties" - , "Honours" - , "Hooks" - , "Hopes" - , "Horizons" - , "Horns" - , "Horrors" - , "Horses" - , "Hospitals" - , "Hosts" - , "Hotels" - , "Hours" - , "Households" - , "Houses" - , "Housings" - , "Humanities" - , "Humans" - , "Humours" - , "Hungers" - , "Huntings" - , "Hunts" - , "Hurricanes" - , "Hurries" - , "Hurts" - , "Hydrogens" - , "Hypotheses" - , "Ices" - , "Icons" - , "Ideals" - , "Ideas" - , "Identifications" - , "Identities" - , "Ideologies" - , "Ids" - , "Ignorances" - , "Illusions" - , "Illustrations" - , "Imageries" - , "Images" - , "Imaginations" - , "Immigrations" - , "Impacts" - , "Implementations" - , "Implications" - , "Importances" - , "Imports" - , "Impressions" - , "Imprisonments" - , "Improvements" - , "Inabilities" - , "Incentives" - , "Inches" - , "Incidences" - , "Incidents" - , "Inclusions" - , "Incomes" - , "Increases" - , "Independences" - , "Indications" - , "Indicators" - , "Indices" - , "Indictments" - , "Individuals" - , "Industries" - , "Inequalities" - , "Infections" - , "Inflations" - , "Influences" - , "Information" - , "Infos" - , "Infrastructures" - , "Ingredients" - , "Inhabitants" - , "Initiatives" - , "Injections" - , "Injuries" - , "Injustices" - , "Inks" - , "Innovations" - , "Inputs" - , "Inquiries" - , "Insects" - , "Insertions" - , "Insiders" - , "Insides" - , "Insights" - , "Inspections" - , "Inspectors" - , "Inspirations" - , "Installations" - , "Instances" - , "Instincts" - , "Institutes" - , "Institutions" - , "Instructions" - , "Instructors" - , "Instruments" - , "Insults" - , "Insurances" - , "Intakes" - , "Integrations" - , "Integrities" - , "Intellectuals" - , "Intelligences" - , "Intensities" - , "Intentions" - , "Intents" - , "Interactions" - , "Interests" - , "Interfaces" - , "Interferences" - , "Interiors" - , "Interpretations" - , "Intervals" - , "Interventions" - , "Interviews" - , "Introductions" - , "Invasions" - , "Inventions" - , "Investigations" - , "Investigators" - , "Investments" - , "Investors" - , "Invitations" - , "Involvements" - , "Ironies" - , "Irons" - , "Islands" - , "Isolations" - , "Issues" - , "Items" - , "Its" - , "Jackets" - , "Jails" - , "Jams" - , "Januaries" - , "Jazzes" - , "Jeans" - , "Jets" - , "Jewelleries" - , "Jobs" - , "Joints" - , "Jokes" - , "Journalisms" - , "Journalists" - , "Journals" - , "Journeys" - , "Joys" - , "Judgements" - , "Judges" - , "Juices" - , "Julies" - , "Jumps" - , "Junctions" - , "Junes" - , "Juries" - , "Jurisdictions" - , "Justices" - , "Justifications" - , "Keyboards" - , "Keys" - , "Kicks" - , "Kidneys" - , "Kilometres" - , "Kinds" - , "Kingdoms" - , "Kings" - , "Kisses" - , "Kitchens" - , "Kits" - , "Knees" - , "Knives" - , "Knocks" - , "Knowledges" - , "Labels" - , "Laboratories" - , "Labours" - , "Labs" - , "Lacks" - , "Ladders" - , "Lakes" - , "Lamps" - , "Landings" - , "Landlords" - , "Landmarks" - , "Lands" - , "Landscapes" - , "Lanes" - , "Languages" - , "Laps" - , "Laptops" - , "Lasers" - , "Lasts" - , "Latests" - , "Laughs" - , "Laughters" - , "Launches" - , "Lawns" - , "Laws" - , "Lawsuits" - , "Lawyers" - , "Layers" - , "Layouts" - , "Leaders" - , "Leaderships" - , "Leads" - , "Leaflets" - , "Leagues" - , "Leaks" - , "Leaps" - , "Learnings" - , "Leathers" - , "Leaves" - , "Lectures" - , "Lefts" - , "Legacies" - , "Legends" - , "Legislations" - , "Legislatures" - , "Legs" - , "Leisures" - , "Lemons" - , "Lengths" - , "Lens" - , "Lessons" - , "Letters" - , "Levels" - , "Liberals" - , "Liberations" - , "Liberties" - , "Libraries" - , "Licences" - , "Lies" - , "Lifestyles" - , "Lifetimes" - , "Lifts" - , "Lightings" - , "Lights" - , "Likelihoods" - , "Likes" - , "Limbs" - , "Limitations" - , "Limits" - , "LineUps" - , "Lines" - , "Links" - , "Lions" - , "Lips" - , "Liquids" - , "Listeners" - , "Listings" - , "Lists" - , "Literacies" - , "Literatures" - , "Litres" - , "Litters" - , "Livers" - , "Lives" - , "Livings" - , "Loads" - , "Loans" - , "Lobbies" - , "Locals" - , "Locations" - , "Locks" - , "Logics" - , "Logos" - , "Logs" - , "Looks" - , "Loops" - , "Lords" - , "Lorries" - , "Losses" - , "Lotteries" - , "Loves" - , "Lows" - , "Loyalties" - , "Luck" - , "Lunches" - , "Lungs" - , "Luxuries" - , "Lyrics" - , "Machineries" - , "Machines" - , "Magazines" - , "Magics" - , "Magistrates" - , "Magnitudes" - , "Mails" - , "Mainlands" - , "Mainstreams" - , "Maintenances" - , "Majorities" - , "MakeUps" - , "Makes" - , "Makings" - , "Malls" - , "Managements" - , "Managers" - , "Mandates" - , "Manipulations" - , "Manners" - , "Manufacturings" - , "Manuscripts" - , "Maps" - , "Marathons" - , "Marches" - , "Margins" - , "Markers" - , "Marketings" - , "Marketplaces" - , "Markets" - , "Marks" - , "Marriages" - , "Masks" - , "Masses" - , "Masters" - , "Matches" - , "Materials" - , "Mates" - , "Mathematics" - , "Maths" - , "Matters" - , "Maximums" - , "Mayors" - , "Mays" - , "Meals" - , "Meanings" - , "Means" - , "Meantimes" - , "Measurements" - , "Measures" - , "Meats" - , "Mechanics" - , "Mechanisms" - , "Medals" - , "Media" - , "Medications" - , "Medicines" - , "Meditations" - , "Meetings" - , "Melodies" - , "Members" - , "Memberships" - , "Memoirs" - , "Memorials" - , "Memories" - , "Memos" - , "Mentions" - , "Mentors" - , "Menus" - , "Merchants" - , "Mercies" - , "Mergers" - , "Merits" - , "Messages" - , "Messes" - , "Metals" - , "Metaphors" - , "Methodologies" - , "Methods" - , "Metres" - , "Mice" - , "Middles" - , "Midnights" - , "Midsts" - , "Migrations" - , "Miles" - , "Milks" - , "Mills" - , "Minds" - , "Minerals" - , "Miners" - , "Mines" - , "Minimums" - , "Minings" - , "Ministers" - , "Ministries" - , "Minutes" - , "Miracles" - , "Mirrors" - , "Miseries" - , "Missiles" - , "Missions" - , "Mistakes" - , "Mixes" - , "Mixtures" - , "Mobiles" - , "Mobilities" - , "Mobs" - , "Modes" - , "Modifications" - , "Momenta" - , "Moments" - , "Mondays" - , "Moneys" - , "Monitors" - , "Monkeys" - , "Monks" - , "Monopolies" - , "Monsters" - , "Months" - , "Monuments" - , "Moods" - , "Moons" - , "Moralities" - , "Morals" - , "Mornings" - , "Mortgages" - , "Mothers" - , "Motions" - , "Motivations" - , "Motives" - , "Motorcycles" - , "Motorists" - , "Motors" - , "Mountains" - , "Mouths" - , "Movements" - , "Moves" - , "Movies" - , "Muds" - , "Mums" - , "Muscles" - , "Museums" - , "Music" - , "Musicals" - , "Musicians" - , "Mysteries" - , "Myths" - , "Nails" - , "Names" - , "Narratives" - , "Nationals" - , "Nations" - , "Natures" - , "Navigations" - , "Necessities" - , "Necks" - , "Needles" - , "Needs" - , "Negatives" - , "Neglects" - , "Negotiations" - , "Neighbourhoods" - , "Neighbours" - , "Nerves" - , "Nests" - , "Nets" - , "Networks" - , "News" - , "Newsletters" - , "Newspapers" - , "Niches" - , "Nightmares" - , "Nights" - , "Noises" - , "Nominations" - , "Nominees" - , "Nonsenses" - , "Noons" - , "Normals" - , "Norms" - , "Norths" - , "Noses" - , "Notebooks" - , "Notes" - , "Notices" - , "Notions" - , "Novelists" - , "Novels" - , "Novembers" - , "Numbers" - , "Nurseries" - , "Nurses" - , "Nursings" - , "Nutritions" - , "Nuts" - , "Obesities" - , "Objections" - , "Objectives" - , "Objects" - , "Obligations" - , "Observations" - , "Observers" - , "Obsessions" - , "Obstacles" - , "Occasions" - , "Occupations" - , "Occurrences" - , "Oceans" - , "Octobers" - , "Odds" - , "Offences" - , "Offerings" - , "Offers" - , "Officers" - , "Offices" - , "Officials" - , "Offspring" - , "Oils" - , "Onions" - , "Openings" - , "Operas" - , "Operations" - , "Operators" - , "Opinions" - , "Opponents" - , "Opportunities" - , "Opposites" - , "Oppositions" - , "Optimisms" - , "Options" - , "Oranges" - , "Orchestras" - , "Orders" - , "Organizations" - , "Organizers" - , "Organs" - , "Orientations" - , "Originals" - , "Origins" - , "Outbreaks" - , "Outcomes" - , "Outfits" - , "Outings" - , "Outlets" - , "Outlines" - , "Outlooks" - , "Outputs" - , "Outrages" - , "Outsiders" - , "Outsides" - , "Ovens" - , "Owners" - , "Ownerships" - , "Oxygens" - , "Paces" - , "Packages" - , "Packets" - , "Packs" - , "Pads" - , "Pages" - , "Pains" - , "Painters" - , "Paintings" - , "Paints" - , "Pairs" - , "Palaces" - , "Palms" - , "Panels" - , "Panics" - , "Pans" - , "Pants" - , "Papers" - , "Parades" - , "Paragraphs" - , "Parallels" - , "Parameters" - , "Parents" - , "Parishes" - , "Parkings" - , "Parks" - , "Parliaments" - , "Participants" - , "Participations" - , "Parties" - , "Partners" - , "Partnerships" - , "Parts" - , "Passages" - , "Passengers" - , "Passes" - , "Passings" - , "Passions" - , "Passports" - , "Passwords" - , "Pastors" - , "Pasts" - , "Patches" - , "Patents" - , "Paths" - , "Pathways" - , "Patiences" - , "Patients" - , "Patrols" - , "Patrons" - , "Patterns" - , "Pauses" - , "Payments" - , "Pays" - , "Peaces" - , "Peaks" - , "Peasants" - , "Peers" - , "Penalties" - , "Pencils" - , "Pennies" - , "Pens" - , "Pensions" - , "People" - , "Peoples" - , "Peppers" - , "Percentages" - , "Perceptions" - , "Performances" - , "Periods" - , "Permissions" - , "Permits" - , "Personalities" - , "Personnels" - , "Perspectives" - , "Petitions" - , "Petrols" - , "Pets" - , "Phases" - , "Phenomena" - , "Philosophers" - , "Philosophies" - , "Phones" - , "Photographers" - , "Photographies" - , "Photographs" - , "Photos" - , "Phrases" - , "Physicians" - , "Physics" - , "Pianos" - , "Picks" - , "Pictures" - , "Pieces" - , "Pigs" - , "Piles" - , "Pills" - , "Pilots" - , "Pinks" - , "Pins" - , "Pioneers" - , "Pipelines" - , "Pipes" - , "Pirates" - , "Pitches" - , "Pities" - , "Pits" - , "Placements" - , "Places" - , "Planes" - , "Planets" - , "Plannings" - , "Plans" - , "Plants" - , "Plastics" - , "Plates" - , "Platforms" - , "Players" - , "Plays" - , "Pleas" - , "Pleasures" - , "Pledges" - , "Plots" - , "Plugs" - , "Plus" - , "Pockets" - , "Poems" - , "Poetries" - , "Poets" - , "Points" - , "Poisons" - , "Poles" - , "Police" - , "Policemen" - , "Policies" - , "Politicians" - , "Politics" - , "Polls" - , "Pollutions" - , "Ponds" - , "Pools" - , "Pops" - , "Popularities" - , "Populations" - , "Portfolios" - , "Portions" - , "Portraits" - , "Ports" - , "Positions" - , "Positives" - , "Possessions" - , "Possibilities" - , "Posters" - , "Posts" - , "Potatoes" - , "Potentials" - , "Pots" - , "Pounds" - , "Poverties" - , "Powders" - , "Powers" - , "Practices" - , "Practitioners" - , "Praises" - , "Prayers" - , "Precedents" - , "Precisions" - , "Predators" - , "Predecessors" - , "Predictions" - , "Preferences" - , "Pregnancies" - , "Prejudices" - , "Premises" - , "Premiums" - , "Preparations" - , "Prescriptions" - , "Presences" - , "Presentations" - , "Presents" - , "Preservations" - , "Presidencies" - , "Presidents" - , "Presses" - , "Pressures" - , "Prevalences" - , "Preventions" - , "Preys" - , "Prices" - , "Prides" - , "Priests" - , "Princes" - , "Princesses" - , "Principals" - , "Principles" - , "Printers" - , "Printings" - , "Prints" - , "Priorities" - , "Prisons" - , "Privacies" - , "Privatizations" - , "Privileges" - , "Prizes" - , "Probabilities" - , "Probes" - , "Problems" - , "Procedures" - , "Proceedings" - , "Proceeds" - , "Processes" - , "Processings" - , "Processors" - , "Producers" - , "Produces" - , "Productions" - , "Productivities" - , "Products" - , "Professionals" - , "Professions" - , "Professors" - , "Profiles" - , "Profits" - , "Programmes" - , "Programmings" - , "Programs" - , "Progresses" - , "Projections" - , "Projects" - , "Promises" - , "Promotions" - , "Proofs" - , "Propagandas" - , "Properties" - , "Proportions" - , "Proposals" - , "Propositions" - , "Prosecutions" - , "Prosecutors" - , "Prospects" - , "Prosperities" - , "Protections" - , "Proteins" - , "Protesters" - , "Protests" - , "Protocols" - , "Provinces" - , "Provisions" - , "Psychologies" - , "Psychologists" - , "Publications" - , "Publicities" - , "Publics" - , "Publishings" - , "Pubs" - , "Pulls" - , "Pulses" - , "Pumps" - , "Punches" - , "Punishments" - , "Punks" - , "Pupils" - , "Purchases" - , "Purples" - , "Purposes" - , "Pursuits" - , "Pushes" - , "Puzzles" - , "Qualifications" - , "Qualities" - , "Quantities" - , "Quarters" - , "Queens" - , "Queries" - , "Questionnaires" - , "Questions" - , "Quests" - , "Queues" - , "Quotas" - , "Quotations" - , "Quotes" - , "Races" - , "Racings" - , "Radars" - , "Radiations" - , "Radios" - , "Rages" - , "Raids" - , "Rails" - , "Railways" - , "Rains" - , "Rallies" - , "Ranges" - , "Rankings" - , "Ranks" - , "Rates" - , "Ratings" - , "Ratios" - , "Rats" - , "Rays" - , "Reaches" - , "Reactions" - , "Readers" - , "Readings" - , "Realities" - , "Realizations" - , "Realms" - , "Rears" - , "Reasonings" - , "Reasons" - , "Rebellions" - , "Rebels" - , "Receipts" - , "Receivers" - , "Receptions" - , "Recessions" - , "Recipes" - , "Recipients" - , "Recognitions" - , "Recommendations" - , "Reconstructions" - , "Recordings" - , "Records" - , "Recoveries" - , "Recruitments" - , "Recruits" - , "Reductions" - , "Referees" - , "References" - , "Referendums" - , "Reflections" - , "Reforms" - , "Refusals" - , "Regards" - , "Regimes" - , "Regions" - , "Registers" - , "Registrations" - , "Regrets" - , "Regulations" - , "Regulators" - , "Rehabilitations" - , "Reigns" - , "Rejections" - , "Relations" - , "Relationships" - , "Relatives" - , "Releases" - , "Relevances" - , "Reliabilities" - , "Reliefs" - , "Religions" - , "Remainders" - , "Remains" - , "Remarks" - , "Remedies" - , "Reminders" - , "Removals" - , "Rentals" - , "Rents" - , "Repairs" - , "Repeats" - , "Replacements" - , "Replies" - , "Reporters" - , "Reportings" - , "Reports" - , "Representations" - , "Representatives" - , "Reproductions" - , "Republics" - , "Reputations" - , "Requests" - , "Requirements" - , "Rescues" - , "Researchers" - , "Researches" - , "Reservations" - , "Reserves" - , "Residences" - , "Residents" - , "Residues" - , "Resignations" - , "Resistances" - , "Resolutions" - , "Resorts" - , "Resources" - , "Respects" - , "Responses" - , "Responsibilities" - , "Restaurants" - , "Restorations" - , "Restraints" - , "Restrictions" - , "Rests" - , "Results" - , "Retails" - , "Retirements" - , "Retreats" - , "Returns" - , "Revelations" - , "Revenges" - , "Revenues" - , "Reverses" - , "Reviews" - , "Revisions" - , "Revivals" - , "Revolutions" - , "Rewards" - , "Rhetorics" - , "Rhythms" - , "Rices" - , "Rides" - , "Rifles" - , "Rights" - , "Rings" - , "Riots" - , "Rises" - , "Risks" - , "Rituals" - , "Rivals" - , "Rivers" - , "Roads" - , "Robberies" - , "Robots" - , "Rockets" - , "Rocks" - , "Rods" - , "Roles" - , "Rolls" - , "Romances" - , "Roofs" - , "Rooms" - , "Roots" - , "Ropes" - , "Roses" - , "Rotations" - , "Rounds" - , "Routes" - , "Routines" - , "Rows" - , "Rubbers" - , "Rubbishes" - , "Rugbies" - , "Ruins" - , "Rules" - , "Rulings" - , "Rumours" - , "Runners" - , "Runnings" - , "Runs" - , "Rushes" - , "Sacrifices" - , "Safeties" - , "Sailings" - , "Sailors" - , "Sails" - , "Saints" - , "Sakes" - , "Salads" - , "Salaries" - , "Sales" - , "Salts" - , "Samples" - , "Sanctions" - , "Sands" - , "Sandwiches" - , "Satellites" - , "Satisfactions" - , "Saturdays" - , "Sauces" - , "Savings" - , "Says" - , "Scales" - , "Scandals" - , "Scares" - , "Scenarios" - , "Scenes" - , "Schedules" - , "Schemes" - , "Scholars" - , "Scholarships" - , "Schools" - , "Sciences" - , "Scientists" - , "Scopes" - , "Scores" - , "Scratches" - , "Screams" - , "Screenings" - , "Screens" - , "Screws" - , "Scripts" - , "Scrutinies" - , "Sculptures" - , "Seals" - , "Searches" - , "Seas" - , "Seasons" - , "Seats" - , "Seconds" - , "Secretaries" - , "Secrets" - , "Sections" - , "Sectors" - , "Securities" - , "Seeds" - , "Seekers" - , "Segments" - , "Selections" - , "Selves" - , "Seminars" - , "Senators" - , "Sensations" - , "Senses" - , "Sensitivities" - , "Sentences" - , "Sentiments" - , "Separations" - , "Septembers" - , "Sequences" - , "Series" - , "Servants" - , "Services" - , "Sessions" - , "SetUps" - , "Sets" - , "Settings" - , "Settlements" - , "Settlers" - , "Shades" - , "Shadows" - , "Shakes" - , "Shames" - , "Shapes" - , "Shareholders" - , "Shares" - , "Sheep" - , "Sheets" - , "Shells" - , "Shelters" - , "Shelves" - , "Shifts" - , "Shippings" - , "Ships" - , "Shirts" - , "Shocks" - , "Shoes" - , "Shootings" - , "Shoots" - , "Shoppings" - , "Shops" - , "Shores" - , "Shortages" - , "Shots" - , "Shoulders" - , "Shouts" - , "Showers" - , "Shows" - , "Siblings" - , "Sides" - , "Sighs" - , "Sights" - , "Signals" - , "Signatures" - , "Significances" - , "Signs" - , "Silences" - , "Silks" - , "Silver" - , "Similarities" - , "Simulations" - , "Singers" - , "Singings" - , "Singles" - , "Sins" - , "Sirs" - , "Sites" - , "Situations" - , "Sizes" - , "Sketches" - , "Skies" - , "Skiings" - , "Skills" - , "Skins" - , "Skirts" - , "Skis" - , "Skulls" - , "Sleeps" - , "Slices" - , "Slides" - , "Slogans" - , "Slopes" - , "Slots" - , "Smartphones" - , "Smells" - , "Smiles" - , "Smokes" - , "Smokings" - , "Snakes" - , "Snows" - , "Soaps" - , "Soccers" - , "Societies" - , "Socks" - , "Softwares" - , "Soils" - , "Soldiers" - , "Solicitors" - , "Solidarities" - , "Solids" - , "Solos" - , "Solutions" - , "Songs" - , "Sons" - , "Sorts" - , "Souls" - , "Sounds" - , "Soups" - , "Sources" - , "Sovereignties" - , "Spaces" - , "Spams" - , "Spans" - , "Speakers" - , "Specialists" - , "Species" - , "Specifications" - , "Specimens" - , "Spectacles" - , "Spectators" - , "Spectra" - , "Speculations" - , "Speeches" - , "Speeds" - , "Spellings" - , "Spells" - , "Spendings" - , "Spheres" - , "Spices" - , "Spiders" - , "Spies" - , "Spines" - , "Spins" - , "Spirits" - , "Spites" - , "Splits" - , "Spokesmen" - , "Spokespeople" - , "Sponsors" - , "Sponsorships" - , "Spoons" - , "Sports" - , "Spotlights" - , "Spots" - , "Spouses" - , "Spreads" - , "Springs" - , "Squads" - , "Squares" - , "Stabilities" - , "Stadiums" - , "Staffs" - , "Stages" - , "Stairs" - , "Stakes" - , "Stalls" - , "Stamps" - , "Stances" - , "Standards" - , "Stands" - , "Stars" - , "Starts" - , "Statements" - , "States" - , "Stations" - , "Statistics" - , "Statues" - , "Status" - , "Stays" - , "Steams" - , "Steels" - , "Stems" - , "Steps" - , "Stereotypes" - , "Sticks" - , "Stimuli" - , "Stocks" - , "Stomachs" - , "Stones" - , "Stops" - , "Storages" - , "Stores" - , "Stories" - , "Storms" - , "Strains" - , "Strands" - , "Strangers" - , "Strategies" - , "Streams" - , "Streets" - , "Strengths" - , "Stresses" - , "Stretches" - , "Strikes" - , "T.Texts" - , "Strips" - , "Strokes" - , "Structures" - , "Struggles" - , "Students" - , "Studies" - , "Studios" - , "Stuffs" - , "Styles" - , "Subjects" - , "Submissions" - , "Subscribers" - , "Subscriptions" - , "Subsidies" - , "Substances" - , "Substitutes" - , "Substitutions" - , "Suburbs" - , "Successes" - , "Successions" - , "Successors" - , "Sufferings" - , "Sugars" - , "Suggestions" - , "Suites" - , "Suits" - , "Summaries" - , "Summers" - , "Summits" - , "Sums" - , "Sundays" - , "Suns" - , "Supermarkets" - , "Supervisions" - , "Supervisors" - , "Supplements" - , "Supplies" - , "Supporters" - , "Supports" - , "Surfaces" - , "Surgeons" - , "Surgeries" - , "Surges" - , "Surplus" - , "Surprises" - , "Surveillances" - , "Surveys" - , "Survivals" - , "Survivors" - , "Suspects" - , "Suspensions" - , "Suspicions" - , "Sweaters" - , "Sweets" - , "Swimmings" - , "Swims" - , "Swings" - , "Switches" - , "Swords" - , "Symbols" - , "Sympathies" - , "Symptoms" - , "Syndromes" - , "Syntheses" - , "Systems" - , "TShirts" - , "Tables" - , "Tablets" - , "Tackles" - , "Tactics" - , "Tags" - , "Tails" - , "Talents" - , "Tales" - , "Talks" - , "Tanks" - , "Tapes" - , "Taps" - , "Targets" - , "Tasks" - , "Tastes" - , "Taxes" - , "Taxis" - , "Taxpayers" - , "Teachers" - , "Teachings" - , "Teams" - , "Tears" - , "Teas" - , "Techniques" - , "Technologies" - , "Teenagers" - , "Teens" - , "Teeth" - , "Telephones" - , "Televisions" - , "Temperatures" - , "Temples" - , "Tenants" - , "Tendencies" - , "Tennis" - , "Tensions" - , "Tents" - , "Tenures" - , "Terminals" - , "Terms" - , "Terrains" - , "Territories" - , "Testimonies" - , "Testings" - , "Tests" - , "Textbooks" - , "Texts" - , "Textures" - , "Thanks" - , "Theatres" - , "Thefts" - , "Themes" - , "Theologies" - , "Theories" - , "Therapies" - , "Therapists" - , "Theses" - , "Thieves" - , "Things" - , "Thinkings" - , "Thirds" - , "Thoughts" - , "Threads" - , "Threats" - , "Thresholds" - , "Throats" - , "Thumbs" - , "Thursdays" - , "Tickets" - , "Tides" - , "Ties" - , "Timbers" - , "Times" - , "Timings" - , "Tins" - , "Tips" - , "Tissues" - , "Titles" - , "Tobaccos" - , "Todays" - , "Toes" - , "Toilets" - , "Tolerances" - , "Tolls" - , "Tomatoes" - , "Tomorrows" - , "Tones" - , "Tongues" - , "Tonights" - , "Tonnes" - , "Tons" - , "Tools" - , "Topics" - , "Tops" - , "Tortoises" - , "Totals" - , "Touches" - , "Tourisms" - , "Tourists" - , "Tournaments" - , "Tours" - , "Towels" - , "Towers" - , "Towns" - , "Toys" - , "Traces" - , "Tracks" - , "Trademarks" - , "Trades" - , "Tradings" - , "Traditions" - , "Traffics" - , "Tragedies" - , "Trailers" - , "Trails" - , "Trainers" - , "Trainings" - , "Trains" - , "Traits" - , "Transactions" - , "Transcripts" - , "Transfers" - , "Transformations" - , "Transitions" - , "Transits" - , "Translations" - , "Transmissions" - , "Transparencies" - , "Transportations" - , "Transports" - , "Traps" - , "Traumas" - , "Travellers" - , "Travels" - , "Treasures" - , "Treaties" - , "Treatments" - , "Trees" - , "Trends" - , "Trials" - , "Tribes" - , "Tribunals" - , "Tributes" - , "Tricks" - , "Tries" - , "Triggers" - , "Trios" - , "Trips" - , "Triumphs" - , "Troops" - , "Trophies" - , "Troubles" - , "Trousers" - , "Trucks" - , "Trustees" - , "Trusts" - , "Truths" - , "Tsunamis" - , "Tubes" - , "Tuesdays" - , "Tuitions" - , "Tunes" - , "Tunnels" - , "Turnouts" - , "Turnovers" - , "Turns" - , "Tvs" - , "Twists" - , "Types" - , "Tyres" - , "Umbrellas" - , "Uncertainties" - , "Uncles" - , "Undergraduates" - , "Understandings" - , "Underwears" - , "Unemployments" - , "Uniforms" - , "Unions" - , "Unities" - , "Units" - , "Universes" - , "Universities" - , "Updates" - , "Upgrades" - , "Usages" - , "Users" - , "Uses" - , "Utilities" - , "Vacations" - , "Vacuums" - , "Validities" - , "Valleys" - , "Values" - , "Vans" - , "Variables" - , "Variations" - , "Varieties" - , "Vegetables" - , "Vehicles" - , "Veins" - , "Ventures" - , "Venues" - , "Verdicts" - , "Verses" - , "Versions" - , "Vessels" - , "Veterans" - , "Vices" - , "Victories" - , "Videos" - , "Viewers" - , "Viewpoints" - , "Views" - , "Villagers" - , "Villages" - , "Violations" - , "Violences" - , "Virtues" - , "Viruses" - , "Visas" - , "Visions" - , "Visitors" - , "Visits" - , "Vitamins" - , "Voices" - , "Volumes" - , "Volunteers" - , "Votes" - , "Votings" - , "Vulnerabilities" - , "Wages" - , "Waiters" - , "Waits" - , "Walks" - , "Walls" - , "Wards" - , "Warehouses" - , "Warfares" - , "Warmings" - , "Warnings" - , "Warrants" - , "Warriors" - , "Washes" - , "Washings" - , "Wastes" - , "Watches" - , "Waters" - , "Waves" - , "Ways" - , "Weaknesses" - , "Wealths" - , "Weathers" - , "Webs" - , "Websites" - , "Weddings" - , "Wednesdays" - , "Weeds" - , "Weekends" - , "Weeks" - , "Weights" - , "Welcomes" - , "Welfares" - , "WellBeings" - , "Wells" - , "Wests" - , "Wheat" - , "Wheels" - , "Whispers" - , "Wholes" - , "Widows" - , "Widths" - , "Wildlives" - , "Willingnesses" - , "Wills" - , "Windows" - , "Winds" - , "Wines" - , "Wings" - , "Winners" - , "Wins" - , "Winters" - , "Wires" - , "Wisdoms" - , "Wishes" - , "Withdrawals" - , "Witnesses" - , "Wits" - , "Wonders" - , "Woods" - , "Wools" - , "Words" - , "Workers" - , "Workforces" - , "Workouts" - , "Workplaces" - , "Works" - , "Workshops" - , "Worlds" - , "Worms" - , "Worries" - , "Worses" - , "Worships" - , "Worsts" - , "Worths" - , "Wounds" - , "Wrists" - , "Writers" - , "Writings" - , "Wrongs" - , "Yards" - , "Years" - , "Yellows" - , "Yesterdays" - , "Yields" - , "Zones" + [ "Abilities", + "Absences", + "Abundances", + "Academics", + "Academies", + "Accents", + "Acceptances", + "Accesses", + "Accidents", + "Accommodations", + "Accomplishments", + "Accordances", + "Accountabilities", + "Accountants", + "Accounts", + "Accumulations", + "Accuracies", + "Accusations", + "Accused", + "Achievements", + "Acids", + "Acquisitions", + "Acres", + "Actions", + "Activations", + "Activists", + "Activities", + "Actors", + "Actresses", + "Acts", + "Adaptations", + "Addictions", + "Additions", + "Addresses", + "Adjustments", + "Administrations", + "Administrators", + "Admissions", + "Adolescents", + "Adoptions", + "Ads", + "Adults", + "Advances", + "Advantages", + "Adventures", + "Advertisements", + "Advertisings", + "Advice", + "Advocates", + "Affairs", + "Affections", + "Aftermaths", + "Afternoons", + "Agencies", + "Agendas", + "Agents", + "Ages", + "Aggressions", + "Agreements", + "Agricultures", + "Aides", + "Alarms", + "Albums", + "Alerts", + "Aliens", + "Alignments", + "Allegations", + "Alliances", + "Allies", + "Allocations", + "Allowances", + "Alternatives", + "Aluminium", + "Amateurs", + "Ambassadors", + "Ambitions", + "Ambulances", + "Amendments", + "Amounts", + "Analogies", + "Analyses", + "Analysts", + "Ancestors", + "Anchors", + "Angels", + "Angers", + "Angles", + "Animals", + "Animations", + "Ankles", + "Anniversaries", + "Announcements", + "Answers", + "Anxieties", + "Apartments", + "Apologies", + "Apparatus", + "Appeals", + "Appearances", + "Appetites", + "Apples", + "Applicants", + "Applications", + "Appointments", + "Appreciations", + "Approaches", + "Approvals", + "Apps", + "Aprils", + "Architects", + "Architectures", + "Archives", + "Areas", + "Arenas", + "Arguments", + "Armies", + "Arrangements", + "Arrays", + "Arrests", + "Arrivals", + "Arrows", + "Articles", + "Artists", + "Arts", + "Artworks", + "Ashes", + "Aspects", + "Aspirations", + "Assaults", + "Assemblies", + "Assertions", + "Assessments", + "Assets", + "Assignments", + "Assistances", + "Assistants", + "Associations", + "Assumptions", + "Assurances", + "Asylums", + "Athletes", + "Atmospheres", + "Attachments", + "Attacks", + "Attempts", + "Attendances", + "Attentions", + "Attitudes", + "Attorneys", + "Attractions", + "Attributes", + "Auctions", + "Audiences", + "Audits", + "Augusts", + "Aunts", + "Authorities", + "Authors", + "Autonomies", + "Autos", + "Autumns", + "Availabilities", + "Averages", + "Awards", + "Awarenesses", + "Babies", + "Backdrops", + "Backgrounds", + "Backings", + "Backs", + "Backups", + "Bacterias", + "Badges", + "Bags", + "Bails", + "Balances", + "Ballets", + "Balloons", + "Ballots", + "Balls", + "Bananas", + "Bands", + "Banks", + "Banners", + "Bans", + "Bargains", + "Barrels", + "Barriers", + "Bars", + "Baseballs", + "Basements", + "Bases", + "Basketballs", + "Baskets", + "Basses", + "Bathrooms", + "Baths", + "Bats", + "Batteries", + "Battlefields", + "Battles", + "Bays", + "Beaches", + "Beams", + "Beans", + "Bears", + "Beasts", + "Beats", + "Beauties", + "Bedrooms", + "Beds", + "Beefs", + "Beers", + "Bees", + "Beginnings", + "Behalves", + "Behaviours", + "Beings", + "Beliefs", + "Bells", + "Belts", + "Benches", + "Benchmarks", + "Bends", + "Beneficiaries", + "Benefits", + "Bests", + "Bets", + "Betters", + "Biases", + "Bicycles", + "Bids", + "Bikes", + "Bills", + "Bins", + "Biographies", + "Biologies", + "Birds", + "Birthdays", + "Births", + "Biscuits", + "Bishops", + "Bites", + "Bits", + "Blades", + "Blames", + "Blankets", + "Blanks", + "Blasts", + "Blends", + "Blessings", + "Blocks", + "Blogs", + "Bloods", + "Blows", + "Blues", + "Boards", + "Boats", + "Bonds", + "Bones", + "Bonus", + "Bookings", + "Books", + "Booms", + "Boosts", + "Boots", + "Borders", + "Bosses", + "Bottles", + "Boundaries", + "Bowls", + "Bows", + "Boxes", + "Brains", + "Branches", + "Brands", + "Breaches", + "Breads", + "Breakdowns", + "Breakfasts", + "Breaks", + "Breakthroughs", + "Breathings", + "Breaths", + "Breeds", + "Brethren", + "Bricks", + "Brides", + "Bridges", + "Broadbands", + "Broadcasters", + "Broadcasts", + "Browsers", + "Brushes", + "Bubbles", + "Bucks", + "Buddies", + "Budgets", + "Buffers", + "Bugs", + "Buildings", + "Bulks", + "Bullets", + "Bunches", + "Burdens", + "Bureaucracies", + "Burials", + "Burns", + "Buses", + "Bushes", + "Businesses", + "Businessmen", + "Butters", + "Buttons", + "Cabinets", + "Cabins", + "Cables", + "Cafes", + "Cakes", + "Calculations", + "Calls", + "Calms", + "Cameras", + "Campaigns", + "Campings", + "Camps", + "Campus", + "Canals", + "Candidates", + "Candles", + "Cans", + "Canvas", + "Capabilities", + "Capacities", + "Capitalisms", + "Capitals", + "Caps", + "Captains", + "Captures", + "Carbons", + "Cards", + "Careers", + "Cares", + "Cargoes", + "Carpets", + "Carriages", + "Carrots", + "Cars", + "Cartoons", + "Cases", + "Cashes", + "Casinos", + "Castles", + "Casts", + "Catalogues", + "Catches", + "Categories", + "Cats", + "Cattle", + "Causes", + "Cautions", + "Caves", + "Cds", + "Ceilings", + "Celebrations", + "Celebrities", + "Cells", + "Cemeteries", + "Centres", + "Cents", + "Centuries", + "Ceremonies", + "Certainties", + "Certificates", + "Chains", + "Chairmen", + "Chairs", + "Challenges", + "Chambers", + "Champions", + "Championships", + "Chances", + "Changes", + "Channels", + "Chaos", + "Chapters", + "Characteristics", + "Characters", + "Charges", + "Charities", + "Charms", + "Charters", + "Charts", + "Chases", + "Chats", + "Cheats", + "Checks", + "Cheeks", + "Cheers", + "Cheeses", + "Chefs", + "Chemicals", + "Chemistries", + "Chests", + "Chickens", + "Chiefs", + "Childhoods", + "Chips", + "Chocolates", + "Choices", + "Choirs", + "Chunks", + "Churches", + "Cigarettes", + "Cinemas", + "Circles", + "Circuits", + "Circulations", + "Circumstances", + "Cities", + "Citizens", + "Citizenships", + "Civilians", + "Civilizations", + "Claims", + "Clarities", + "Clashes", + "Classes", + "Classics", + "Classifications", + "Classrooms", + "Clauses", + "Clerks", + "Clicks", + "Clients", + "Cliffs", + "Climates", + "Climbs", + "Clinics", + "Clips", + "Clocks", + "Closes", + "Closures", + "Clothes", + "Clothings", + "Cloths", + "Clouds", + "Clubs", + "Clues", + "Clusters", + "Coaches", + "Coalitions", + "Coals", + "Coasts", + "Coats", + "Cocktails", + "Codes", + "Coffees", + "Coincidences", + "Coins", + "Colds", + "Collaborations", + "Collapses", + "Colleagues", + "Collections", + "Collectors", + "Colleges", + "Collisions", + "Colonies", + "Colours", + "Columnists", + "Columns", + "Combats", + "Combinations", + "Comedies", + "Comforts", + "Comics", + "Commanders", + "Commands", + "Commentaries", + "Commentators", + "Comments", + "Commerces", + "Commercials", + "Commissioners", + "Commissions", + "Commitments", + "Committees", + "Commodities", + "Communications", + "Communities", + "Companies", + "Companions", + "Comparisons", + "Compassions", + "Compensations", + "Competences", + "Competitions", + "Competitors", + "Complaints", + "Completions", + "Complexes", + "Complexities", + "Compliances", + "Complications", + "Components", + "Composers", + "Compositions", + "Compounds", + "Compromises", + "Computers", + "Concentrations", + "Conceptions", + "Concepts", + "Concerns", + "Concerts", + "Concessions", + "Conclusions", + "Concretes", + "Conditions", + "Conducts", + "Conferences", + "Confessions", + "Confidences", + "Configurations", + "Confirmations", + "Conflicts", + "Confrontations", + "Confusions", + "Congregations", + "Connections", + "Consciences", + "Consciousnesses", + "Consensus", + "Consents", + "Consequences", + "Conservations", + "Conservatives", + "Considerations", + "Consistencies", + "Conspiracies", + "Constituencies", + "Constitutions", + "Constraints", + "Constructions", + "Consultants", + "Consultations", + "Consumers", + "Consumptions", + "Contacts", + "Containers", + "Contempts", + "Contenders", + "Contentions", + "Contents", + "Contests", + "Contexts", + "Continents", + "Contractors", + "Contracts", + "Contradictions", + "Contraries", + "Contrasts", + "Contributions", + "Contributors", + "Controls", + "Controversies", + "Conveniences", + "Conventions", + "Conversations", + "Conversions", + "Convictions", + "Cookers", + "Cookings", + "Cooks", + "Coordinations", + "Coordinators", + "Copies", + "Coppers", + "Cops", + "Copyrights", + "Cores", + "Corners", + "Corporations", + "Corrections", + "Correlations", + "Correspondences", + "Correspondents", + "Corridors", + "Corruptions", + "Costs", + "Costumes", + "Cottages", + "Cottons", + "Councillors", + "Councils", + "Counsellings", + "Counsellors", + "Counterparts", + "Counters", + "Counties", + "Countries", + "Countrysides", + "Counts", + "Couples", + "Coups", + "Courages", + "Courses", + "Courtesies", + "Courts", + "Cousins", + "Coverages", + "Covers", + "Cows", + "Cracks", + "Crafts", + "Crashes", + "Creams", + "Creations", + "Creativities", + "Creators", + "Creatures", + "Credibilities", + "Credits", + "Crews", + "Cries", + "Crises", + "Criteria", + "Criticisms", + "Critics", + "Critiques", + "Crops", + "Crosses", + "Crowds", + "Crowns", + "Cruises", + "Crystals", + "Cues", + "Cults", + "Cultures", + "Cupboards", + "Cups", + "Cures", + "Curiosities", + "Currencies", + "Currents", + "Curricula", + "Curtains", + "Custodies", + "Customers", + "Customs", + "Cuts", + "Cuttings", + "Cycles", + "Dads", + "Dairies", + "Damages", + "Dams", + "Dancers", + "Dances", + "Dancings", + "Dangers", + "Darknesses", + "Darks", + "Databases", + "Dates", + "Daughters", + "Dawns", + "Days", + "Deadlines", + "Dealers", + "Deals", + "Debates", + "Debris", + "Debts", + "Debuts", + "Decades", + "Decembers", + "DecisionMakings", + "Decisions", + "Decks", + "Declarations", + "Declines", + "Decorations", + "Decreases", + "Dedications", + "Deeds", + "Defaults", + "Defeats", + "Defects", + "Defences", + "Defenders", + "Deficiencies", + "Deficits", + "Definitions", + "Degrees", + "Delays", + "Delegates", + "Delegations", + "Delights", + "Deliveries", + "Demands", + "Democracies", + "Demons", + "Demonstrations", + "Denials", + "Densities", + "Dentists", + "Departments", + "Departures", + "Dependences", + "Deployments", + "Deposits", + "Depressions", + "Depths", + "Deputies", + "Descents", + "Descriptions", + "Deserts", + "Designers", + "Designs", + "Desires", + "Desks", + "Desktops", + "Destinations", + "Destructions", + "Details", + "Detections", + "Detectives", + "Detentions", + "Determinations", + "Developments", + "Devices", + "Devils", + "Diagnoses", + "Diagrams", + "Dialogues", + "Diamonds", + "Diaries", + "Dictators", + "Dictionaries", + "Diets", + "Differences", + "Difficulties", + "Dignities", + "Dilemmas", + "Dimensions", + "Dinners", + "Diplomats", + "Directions", + "Directories", + "Directors", + "Dirts", + "Disabilities", + "Disadvantages", + "Disagreements", + "Disappointments", + "Disciplines", + "Disclosures", + "Discounts", + "Discourses", + "Discoveries", + "Discretions", + "Discs", + "Discussions", + "Dishes", + "Disks", + "Dislikes", + "Dismissals", + "Disorders", + "Displays", + "Disposals", + "Disputes", + "Disruptions", + "Distances", + "Distinctions", + "Distresses", + "Distributions", + "Districts", + "Diversities", + "Dives", + "Divides", + "Divisions", + "Divorces", + "Doctors", + "Doctrines", + "Documentaries", + "Documentations", + "Documents", + "Dogs", + "Dollars", + "Domains", + "Dominances", + "Donations", + "Donors", + "Doors", + "Doses", + "Dots", + "Doubts", + "Downloads", + "Downtowns", + "Dozens", + "Drafts", + "Dramas", + "Drawings", + "Dreams", + "Dresses", + "Drinks", + "Drivers", + "Drives", + "Drivings", + "Drops", + "Droughts", + "Drums", + "Duos", + "Durations", + "Dusts", + "Duties", + "Dvds", + "Dynamics", + "Earnings", + "Ears", + "Earthquakes", + "Earths", + "Eases", + "Easts", + "Echoes", + "Economics", + "Economies", + "Economists", + "Edges", + "Editions", + "Editors", + "Educations", + "Educators", + "Effectivenesses", + "Effects", + "Efficiencies", + "Efforts", + "Eggs", + "Egos", + "Elbows", + "Elections", + "Electricities", + "Electronics", + "Elements", + "Elephants", + "Elites", + "Emails", + "Embarrassments", + "Embassies", + "Emergences", + "Emergencies", + "Emissions", + "Emotions", + "Emphases", + "Empires", + "Employees", + "Employers", + "Employments", + "Encounters", + "Encouragements", + "Endeavours", + "Endings", + "Endorsements", + "Ends", + "Enemies", + "Energies", + "Enforcements", + "Engagements", + "Engineerings", + "Engineers", + "Engines", + "Enquiries", + "Enterprises", + "Entertainments", + "Enthusiasms", + "Enthusiasts", + "Entities", + "Entrances", + "Entrepreneurs", + "Entries", + "Envelopes", + "Environments", + "Epidemics", + "Episodes", + "Equalities", + "Equals", + "Equations", + "Equipment", + "Equivalents", + "Eras", + "Errors", + "Escapes", + "Essays", + "Essences", + "Establishments", + "Estates", + "Estimates", + "Ethics", + "Euros", + "Evaluations", + "Evenings", + "Events", + "Evidence", + "Evils", + "Evolutions", + "Examinations", + "Examples", + "Exams", + "Excellences", + "Exceptions", + "Excesses", + "Exchanges", + "Excitements", + "Exclusions", + "Excuses", + "Executives", + "Exercises", + "Exhibitions", + "Exhibits", + "Exiles", + "Existences", + "Exits", + "Expansions", + "Expectations", + "Expeditions", + "Expenditures", + "Expenses", + "Experiences", + "Experiments", + "Expertises", + "Experts", + "Explanations", + "Exploitations", + "Explorations", + "Explosions", + "Explosives", + "Exports", + "Exposures", + "Expressions", + "Extensions", + "Extents", + "Extracts", + "Extras", + "Extremes", + "Eyes", + "Fabrics", + "Faces", + "Facilities", + "Factions", + "Factories", + "Factors", + "Facts", + "Faculties", + "Failures", + "Fairnesses", + "Faiths", + "Falls", + "Fames", + "Families", + "Fans", + "Fantasies", + "Fares", + "Farmers", + "Farmings", + "Farms", + "Fashions", + "Fates", + "Fats", + "Faults", + "Favourites", + "Favours", + "Fears", + "Feathers", + "Feats", + "Features", + "Februaries", + "Feedbacks", + "Feeds", + "Feelings", + "Feels", + "Fees", + "Feet", + "Feminists", + "Fences", + "Festivals", + "Fevers", + "Fibres", + "Fictions", + "Fields", + "Fightings", + "Fights", + "Figures", + "Files", + "FilmMakers", + "Films", + "Filters", + "Finals", + "Finances", + "Findings", + "Fines", + "Fingers", + "Finishes", + "Firefighters", + "Fires", + "Fireworks", + "Firms", + "Firsts", + "Fish", + "Fishings", + "Fitnesses", + "Fits", + "Fixes", + "Fixtures", + "Flags", + "Flames", + "Flashes", + "Flats", + "Flavours", + "Flaws", + "Fleets", + "Fleshes", + "Flexibilities", + "Flies", + "Flights", + "Floods", + "Floors", + "Flours", + "Flowers", + "Flows", + "Fluids", + "Flus", + "Flyings", + "Foci", + "Folds", + "Folks", + "Followings", + "Foods", + "Fools", + "Footages", + "Footballs", + "Forces", + "Forecasts", + "Foreigners", + "Forests", + "Forks", + "Formations", + "Formats", + "Forms", + "Formulae", + "Fortunes", + "Forums", + "Fossils", + "Foundations", + "Founders", + "Fractions", + "Fragments", + "Frames", + "Frameworks", + "Franchises", + "Frauds", + "Freedoms", + "Frequencies", + "Fridays", + "Fridges", + "Friends", + "Friendships", + "Frogs", + "Fronts", + "Fruits", + "Frustrations", + "Fuels", + "Functions", + "Fundings", + "Fundraisings", + "Funds", + "Funerals", + "Funs", + "Furnitures", + "Furs", + "Futures", + "Gains", + "Galleries", + "Gallons", + "Gamblings", + "Games", + "Gamings", + "Gaps", + "Garages", + "Gardens", + "Gases", + "Gates", + "Gatherings", + "Gazes", + "Gears", + "Genders", + "Generations", + "Genes", + "Genius", + "Genres", + "Gentlemen", + "Geographies", + "Gestures", + "Ghosts", + "Giants", + "Gifts", + "Gigs", + "Glances", + "Glasses", + "Glimpses", + "Globalizations", + "Globes", + "Glories", + "Gloves", + "Goals", + "Gods", + "Goes", + "Gold", + "Golfs", + "Goodbyes", + "Goodnesses", + "Goods", + "Governances", + "Governments", + "Governors", + "Graces", + "Grades", + "Graduates", + "Grains", + "Grandfathers", + "Grandmothers", + "Grandparents", + "Grants", + "Graphics", + "Grasps", + "Grasses", + "Graves", + "Gravities", + "Greenhouses", + "Greens", + "Greys", + "Grids", + "Griefs", + "Grins", + "Grips", + "Groceries", + "Grounds", + "Groups", + "Growths", + "Guarantees", + "Guards", + "Guerrillas", + "Guesses", + "Guests", + "Guidances", + "Guidelines", + "Guides", + "Guilts", + "Guitars", + "Guts", + "Guys", + "Gyms", + "Habitats", + "Habits", + "Hairs", + "Halls", + "Halts", + "Halves", + "Handfuls", + "Handles", + "Handlings", + "Hands", + "Happinesses", + "Harassments", + "Harbours", + "Hardwares", + "Harmonies", + "Harms", + "Harvests", + "Hats", + "Hazards", + "Headaches", + "Headlines", + "Headquarters", + "Heads", + "Healthcares", + "Healths", + "Hearings", + "Hearts", + "Heatings", + "Heats", + "Heavens", + "Heels", + "Heights", + "Helicopters", + "Hellos", + "Hells", + "Helmets", + "Helps", + "Herbs", + "Heritages", + "Heroes", + "Hierarchies", + "Highlights", + "Highs", + "Highways", + "Hills", + "Hints", + "Hips", + "Hires", + "Historians", + "Histories", + "Hits", + "Hobbies", + "Hockeys", + "Holds", + "Holes", + "Holidays", + "Homelands", + "Homes", + "Homework", + "Honesties", + "Honours", + "Hooks", + "Hopes", + "Horizons", + "Horns", + "Horrors", + "Horses", + "Hospitals", + "Hosts", + "Hotels", + "Hours", + "Households", + "Houses", + "Housings", + "Humanities", + "Humans", + "Humours", + "Hungers", + "Huntings", + "Hunts", + "Hurricanes", + "Hurries", + "Hurts", + "Hydrogens", + "Hypotheses", + "Ices", + "Icons", + "Ideals", + "Ideas", + "Identifications", + "Identities", + "Ideologies", + "Ids", + "Ignorances", + "Illusions", + "Illustrations", + "Imageries", + "Images", + "Imaginations", + "Immigrations", + "Impacts", + "Implementations", + "Implications", + "Importances", + "Imports", + "Impressions", + "Imprisonments", + "Improvements", + "Inabilities", + "Incentives", + "Inches", + "Incidences", + "Incidents", + "Inclusions", + "Incomes", + "Increases", + "Independences", + "Indications", + "Indicators", + "Indices", + "Indictments", + "Individuals", + "Industries", + "Inequalities", + "Infections", + "Inflations", + "Influences", + "Information", + "Infos", + "Infrastructures", + "Ingredients", + "Inhabitants", + "Initiatives", + "Injections", + "Injuries", + "Injustices", + "Inks", + "Innovations", + "Inputs", + "Inquiries", + "Insects", + "Insertions", + "Insiders", + "Insides", + "Insights", + "Inspections", + "Inspectors", + "Inspirations", + "Installations", + "Instances", + "Instincts", + "Institutes", + "Institutions", + "Instructions", + "Instructors", + "Instruments", + "Insults", + "Insurances", + "Intakes", + "Integrations", + "Integrities", + "Intellectuals", + "Intelligences", + "Intensities", + "Intentions", + "Intents", + "Interactions", + "Interests", + "Interfaces", + "Interferences", + "Interiors", + "Interpretations", + "Intervals", + "Interventions", + "Interviews", + "Introductions", + "Invasions", + "Inventions", + "Investigations", + "Investigators", + "Investments", + "Investors", + "Invitations", + "Involvements", + "Ironies", + "Irons", + "Islands", + "Isolations", + "Issues", + "Items", + "Its", + "Jackets", + "Jails", + "Jams", + "Januaries", + "Jazzes", + "Jeans", + "Jets", + "Jewelleries", + "Jobs", + "Joints", + "Jokes", + "Journalisms", + "Journalists", + "Journals", + "Journeys", + "Joys", + "Judgements", + "Judges", + "Juices", + "Julies", + "Jumps", + "Junctions", + "Junes", + "Juries", + "Jurisdictions", + "Justices", + "Justifications", + "Keyboards", + "Keys", + "Kicks", + "Kidneys", + "Kilometres", + "Kinds", + "Kingdoms", + "Kings", + "Kisses", + "Kitchens", + "Kits", + "Knees", + "Knives", + "Knocks", + "Knowledges", + "Labels", + "Laboratories", + "Labours", + "Labs", + "Lacks", + "Ladders", + "Lakes", + "Lamps", + "Landings", + "Landlords", + "Landmarks", + "Lands", + "Landscapes", + "Lanes", + "Languages", + "Laps", + "Laptops", + "Lasers", + "Lasts", + "Latests", + "Laughs", + "Laughters", + "Launches", + "Lawns", + "Laws", + "Lawsuits", + "Lawyers", + "Layers", + "Layouts", + "Leaders", + "Leaderships", + "Leads", + "Leaflets", + "Leagues", + "Leaks", + "Leaps", + "Learnings", + "Leathers", + "Leaves", + "Lectures", + "Lefts", + "Legacies", + "Legends", + "Legislations", + "Legislatures", + "Legs", + "Leisures", + "Lemons", + "Lengths", + "Lens", + "Lessons", + "Letters", + "Levels", + "Liberals", + "Liberations", + "Liberties", + "Libraries", + "Licences", + "Lies", + "Lifestyles", + "Lifetimes", + "Lifts", + "Lightings", + "Lights", + "Likelihoods", + "Likes", + "Limbs", + "Limitations", + "Limits", + "LineUps", + "Lines", + "Links", + "Lions", + "Lips", + "Liquids", + "Listeners", + "Listings", + "Lists", + "Literacies", + "Literatures", + "Litres", + "Litters", + "Livers", + "Lives", + "Livings", + "Loads", + "Loans", + "Lobbies", + "Locals", + "Locations", + "Locks", + "Logics", + "Logos", + "Logs", + "Looks", + "Loops", + "Lords", + "Lorries", + "Losses", + "Lotteries", + "Loves", + "Lows", + "Loyalties", + "Luck", + "Lunches", + "Lungs", + "Luxuries", + "Lyrics", + "Machineries", + "Machines", + "Magazines", + "Magics", + "Magistrates", + "Magnitudes", + "Mails", + "Mainlands", + "Mainstreams", + "Maintenances", + "Majorities", + "MakeUps", + "Makes", + "Makings", + "Malls", + "Managements", + "Managers", + "Mandates", + "Manipulations", + "Manners", + "Manufacturings", + "Manuscripts", + "Maps", + "Marathons", + "Marches", + "Margins", + "Markers", + "Marketings", + "Marketplaces", + "Markets", + "Marks", + "Marriages", + "Masks", + "Masses", + "Masters", + "Matches", + "Materials", + "Mates", + "Mathematics", + "Maths", + "Matters", + "Maximums", + "Mayors", + "Mays", + "Meals", + "Meanings", + "Means", + "Meantimes", + "Measurements", + "Measures", + "Meats", + "Mechanics", + "Mechanisms", + "Medals", + "Media", + "Medications", + "Medicines", + "Meditations", + "Meetings", + "Melodies", + "Members", + "Memberships", + "Memoirs", + "Memorials", + "Memories", + "Memos", + "Mentions", + "Mentors", + "Menus", + "Merchants", + "Mercies", + "Mergers", + "Merits", + "Messages", + "Messes", + "Metals", + "Metaphors", + "Methodologies", + "Methods", + "Metres", + "Mice", + "Middles", + "Midnights", + "Midsts", + "Migrations", + "Miles", + "Milks", + "Mills", + "Minds", + "Minerals", + "Miners", + "Mines", + "Minimums", + "Minings", + "Ministers", + "Ministries", + "Minutes", + "Miracles", + "Mirrors", + "Miseries", + "Missiles", + "Missions", + "Mistakes", + "Mixes", + "Mixtures", + "Mobiles", + "Mobilities", + "Mobs", + "Modes", + "Modifications", + "Momenta", + "Moments", + "Mondays", + "Moneys", + "Monitors", + "Monkeys", + "Monks", + "Monopolies", + "Monsters", + "Months", + "Monuments", + "Moods", + "Moons", + "Moralities", + "Morals", + "Mornings", + "Mortgages", + "Mothers", + "Motions", + "Motivations", + "Motives", + "Motorcycles", + "Motorists", + "Motors", + "Mountains", + "Mouths", + "Movements", + "Moves", + "Movies", + "Muds", + "Mums", + "Muscles", + "Museums", + "Music", + "Musicals", + "Musicians", + "Mysteries", + "Myths", + "Nails", + "Names", + "Narratives", + "Nationals", + "Nations", + "Natures", + "Navigations", + "Necessities", + "Necks", + "Needles", + "Needs", + "Negatives", + "Neglects", + "Negotiations", + "Neighbourhoods", + "Neighbours", + "Nerves", + "Nests", + "Nets", + "Networks", + "News", + "Newsletters", + "Newspapers", + "Niches", + "Nightmares", + "Nights", + "Noises", + "Nominations", + "Nominees", + "Nonsenses", + "Noons", + "Normals", + "Norms", + "Norths", + "Noses", + "Notebooks", + "Notes", + "Notices", + "Notions", + "Novelists", + "Novels", + "Novembers", + "Numbers", + "Nurseries", + "Nurses", + "Nursings", + "Nutritions", + "Nuts", + "Obesities", + "Objections", + "Objectives", + "Objects", + "Obligations", + "Observations", + "Observers", + "Obsessions", + "Obstacles", + "Occasions", + "Occupations", + "Occurrences", + "Oceans", + "Octobers", + "Odds", + "Offences", + "Offerings", + "Offers", + "Officers", + "Offices", + "Officials", + "Offspring", + "Oils", + "Onions", + "Openings", + "Operas", + "Operations", + "Operators", + "Opinions", + "Opponents", + "Opportunities", + "Opposites", + "Oppositions", + "Optimisms", + "Options", + "Oranges", + "Orchestras", + "Orders", + "Organizations", + "Organizers", + "Organs", + "Orientations", + "Originals", + "Origins", + "Outbreaks", + "Outcomes", + "Outfits", + "Outings", + "Outlets", + "Outlines", + "Outlooks", + "Outputs", + "Outrages", + "Outsiders", + "Outsides", + "Ovens", + "Owners", + "Ownerships", + "Oxygens", + "Paces", + "Packages", + "Packets", + "Packs", + "Pads", + "Pages", + "Pains", + "Painters", + "Paintings", + "Paints", + "Pairs", + "Palaces", + "Palms", + "Panels", + "Panics", + "Pans", + "Pants", + "Papers", + "Parades", + "Paragraphs", + "Parallels", + "Parameters", + "Parents", + "Parishes", + "Parkings", + "Parks", + "Parliaments", + "Participants", + "Participations", + "Parties", + "Partners", + "Partnerships", + "Parts", + "Passages", + "Passengers", + "Passes", + "Passings", + "Passions", + "Passports", + "Passwords", + "Pastors", + "Pasts", + "Patches", + "Patents", + "Paths", + "Pathways", + "Patiences", + "Patients", + "Patrols", + "Patrons", + "Patterns", + "Pauses", + "Payments", + "Pays", + "Peaces", + "Peaks", + "Peasants", + "Peers", + "Penalties", + "Pencils", + "Pennies", + "Pens", + "Pensions", + "People", + "Peoples", + "Peppers", + "Percentages", + "Perceptions", + "Performances", + "Periods", + "Permissions", + "Permits", + "Personalities", + "Personnels", + "Perspectives", + "Petitions", + "Petrols", + "Pets", + "Phases", + "Phenomena", + "Philosophers", + "Philosophies", + "Phones", + "Photographers", + "Photographies", + "Photographs", + "Photos", + "Phrases", + "Physicians", + "Physics", + "Pianos", + "Picks", + "Pictures", + "Pieces", + "Pigs", + "Piles", + "Pills", + "Pilots", + "Pinks", + "Pins", + "Pioneers", + "Pipelines", + "Pipes", + "Pirates", + "Pitches", + "Pities", + "Pits", + "Placements", + "Places", + "Planes", + "Planets", + "Plannings", + "Plans", + "Plants", + "Plastics", + "Plates", + "Platforms", + "Players", + "Plays", + "Pleas", + "Pleasures", + "Pledges", + "Plots", + "Plugs", + "Plus", + "Pockets", + "Poems", + "Poetries", + "Poets", + "Points", + "Poisons", + "Poles", + "Police", + "Policemen", + "Policies", + "Politicians", + "Politics", + "Polls", + "Pollutions", + "Ponds", + "Pools", + "Pops", + "Popularities", + "Populations", + "Portfolios", + "Portions", + "Portraits", + "Ports", + "Positions", + "Positives", + "Possessions", + "Possibilities", + "Posters", + "Posts", + "Potatoes", + "Potentials", + "Pots", + "Pounds", + "Poverties", + "Powders", + "Powers", + "Practices", + "Practitioners", + "Praises", + "Prayers", + "Precedents", + "Precisions", + "Predators", + "Predecessors", + "Predictions", + "Preferences", + "Pregnancies", + "Prejudices", + "Premises", + "Premiums", + "Preparations", + "Prescriptions", + "Presences", + "Presentations", + "Presents", + "Preservations", + "Presidencies", + "Presidents", + "Presses", + "Pressures", + "Prevalences", + "Preventions", + "Preys", + "Prices", + "Prides", + "Priests", + "Princes", + "Princesses", + "Principals", + "Principles", + "Printers", + "Printings", + "Prints", + "Priorities", + "Prisons", + "Privacies", + "Privatizations", + "Privileges", + "Prizes", + "Probabilities", + "Probes", + "Problems", + "Procedures", + "Proceedings", + "Proceeds", + "Processes", + "Processings", + "Processors", + "Producers", + "Produces", + "Productions", + "Productivities", + "Products", + "Professionals", + "Professions", + "Professors", + "Profiles", + "Profits", + "Programmes", + "Programmings", + "Programs", + "Progresses", + "Projections", + "Projects", + "Promises", + "Promotions", + "Proofs", + "Propagandas", + "Properties", + "Proportions", + "Proposals", + "Propositions", + "Prosecutions", + "Prosecutors", + "Prospects", + "Prosperities", + "Protections", + "Proteins", + "Protesters", + "Protests", + "Protocols", + "Provinces", + "Provisions", + "Psychologies", + "Psychologists", + "Publications", + "Publicities", + "Publics", + "Publishings", + "Pubs", + "Pulls", + "Pulses", + "Pumps", + "Punches", + "Punishments", + "Punks", + "Pupils", + "Purchases", + "Purples", + "Purposes", + "Pursuits", + "Pushes", + "Puzzles", + "Qualifications", + "Qualities", + "Quantities", + "Quarters", + "Queens", + "Queries", + "Questionnaires", + "Questions", + "Quests", + "Queues", + "Quotas", + "Quotations", + "Quotes", + "Races", + "Racings", + "Radars", + "Radiations", + "Radios", + "Rages", + "Raids", + "Rails", + "Railways", + "Rains", + "Rallies", + "Ranges", + "Rankings", + "Ranks", + "Rates", + "Ratings", + "Ratios", + "Rats", + "Rays", + "Reaches", + "Reactions", + "Readers", + "Readings", + "Realities", + "Realizations", + "Realms", + "Rears", + "Reasonings", + "Reasons", + "Rebellions", + "Rebels", + "Receipts", + "Receivers", + "Receptions", + "Recessions", + "Recipes", + "Recipients", + "Recognitions", + "Recommendations", + "Reconstructions", + "Recordings", + "Records", + "Recoveries", + "Recruitments", + "Recruits", + "Reductions", + "Referees", + "References", + "Referendums", + "Reflections", + "Reforms", + "Refusals", + "Regards", + "Regimes", + "Regions", + "Registers", + "Registrations", + "Regrets", + "Regulations", + "Regulators", + "Rehabilitations", + "Reigns", + "Rejections", + "Relations", + "Relationships", + "Relatives", + "Releases", + "Relevances", + "Reliabilities", + "Reliefs", + "Religions", + "Remainders", + "Remains", + "Remarks", + "Remedies", + "Reminders", + "Removals", + "Rentals", + "Rents", + "Repairs", + "Repeats", + "Replacements", + "Replies", + "Reporters", + "Reportings", + "Reports", + "Representations", + "Representatives", + "Reproductions", + "Republics", + "Reputations", + "Requests", + "Requirements", + "Rescues", + "Researchers", + "Researches", + "Reservations", + "Reserves", + "Residences", + "Residents", + "Residues", + "Resignations", + "Resistances", + "Resolutions", + "Resorts", + "Resources", + "Respects", + "Responses", + "Responsibilities", + "Restaurants", + "Restorations", + "Restraints", + "Restrictions", + "Rests", + "Results", + "Retails", + "Retirements", + "Retreats", + "Returns", + "Revelations", + "Revenges", + "Revenues", + "Reverses", + "Reviews", + "Revisions", + "Revivals", + "Revolutions", + "Rewards", + "Rhetorics", + "Rhythms", + "Rices", + "Rides", + "Rifles", + "Rights", + "Rings", + "Riots", + "Rises", + "Risks", + "Rituals", + "Rivals", + "Rivers", + "Roads", + "Robberies", + "Robots", + "Rockets", + "Rocks", + "Rods", + "Roles", + "Rolls", + "Romances", + "Roofs", + "Rooms", + "Roots", + "Ropes", + "Roses", + "Rotations", + "Rounds", + "Routes", + "Routines", + "Rows", + "Rubbers", + "Rubbishes", + "Rugbies", + "Ruins", + "Rules", + "Rulings", + "Rumours", + "Runners", + "Runnings", + "Runs", + "Rushes", + "Sacrifices", + "Safeties", + "Sailings", + "Sailors", + "Sails", + "Saints", + "Sakes", + "Salads", + "Salaries", + "Sales", + "Salts", + "Samples", + "Sanctions", + "Sands", + "Sandwiches", + "Satellites", + "Satisfactions", + "Saturdays", + "Sauces", + "Savings", + "Says", + "Scales", + "Scandals", + "Scares", + "Scenarios", + "Scenes", + "Schedules", + "Schemes", + "Scholars", + "Scholarships", + "Schools", + "Sciences", + "Scientists", + "Scopes", + "Scores", + "Scratches", + "Screams", + "Screenings", + "Screens", + "Screws", + "Scripts", + "Scrutinies", + "Sculptures", + "Seals", + "Searches", + "Seas", + "Seasons", + "Seats", + "Seconds", + "Secretaries", + "Secrets", + "Sections", + "Sectors", + "Securities", + "Seeds", + "Seekers", + "Segments", + "Selections", + "Selves", + "Seminars", + "Senators", + "Sensations", + "Senses", + "Sensitivities", + "Sentences", + "Sentiments", + "Separations", + "Septembers", + "Sequences", + "Series", + "Servants", + "Services", + "Sessions", + "SetUps", + "Sets", + "Settings", + "Settlements", + "Settlers", + "Shades", + "Shadows", + "Shakes", + "Shames", + "Shapes", + "Shareholders", + "Shares", + "Sheep", + "Sheets", + "Shells", + "Shelters", + "Shelves", + "Shifts", + "Shippings", + "Ships", + "Shirts", + "Shocks", + "Shoes", + "Shootings", + "Shoots", + "Shoppings", + "Shops", + "Shores", + "Shortages", + "Shots", + "Shoulders", + "Shouts", + "Showers", + "Shows", + "Siblings", + "Sides", + "Sighs", + "Sights", + "Signals", + "Signatures", + "Significances", + "Signs", + "Silences", + "Silks", + "Silver", + "Similarities", + "Simulations", + "Singers", + "Singings", + "Singles", + "Sins", + "Sirs", + "Sites", + "Situations", + "Sizes", + "Sketches", + "Skies", + "Skiings", + "Skills", + "Skins", + "Skirts", + "Skis", + "Skulls", + "Sleeps", + "Slices", + "Slides", + "Slogans", + "Slopes", + "Slots", + "Smartphones", + "Smells", + "Smiles", + "Smokes", + "Smokings", + "Snakes", + "Snows", + "Soaps", + "Soccers", + "Societies", + "Socks", + "Softwares", + "Soils", + "Soldiers", + "Solicitors", + "Solidarities", + "Solids", + "Solos", + "Solutions", + "Songs", + "Sons", + "Sorts", + "Souls", + "Sounds", + "Soups", + "Sources", + "Sovereignties", + "Spaces", + "Spams", + "Spans", + "Speakers", + "Specialists", + "Species", + "Specifications", + "Specimens", + "Spectacles", + "Spectators", + "Spectra", + "Speculations", + "Speeches", + "Speeds", + "Spellings", + "Spells", + "Spendings", + "Spheres", + "Spices", + "Spiders", + "Spies", + "Spines", + "Spins", + "Spirits", + "Spites", + "Splits", + "Spokesmen", + "Spokespeople", + "Sponsors", + "Sponsorships", + "Spoons", + "Sports", + "Spotlights", + "Spots", + "Spouses", + "Spreads", + "Springs", + "Squads", + "Squares", + "Stabilities", + "Stadiums", + "Staffs", + "Stages", + "Stairs", + "Stakes", + "Stalls", + "Stamps", + "Stances", + "Standards", + "Stands", + "Stars", + "Starts", + "Statements", + "States", + "Stations", + "Statistics", + "Statues", + "Status", + "Stays", + "Steams", + "Steels", + "Stems", + "Steps", + "Stereotypes", + "Sticks", + "Stimuli", + "Stocks", + "Stomachs", + "Stones", + "Stops", + "Storages", + "Stores", + "Stories", + "Storms", + "Strains", + "Strands", + "Strangers", + "Strategies", + "Streams", + "Streets", + "Strengths", + "Stresses", + "Stretches", + "Strikes", + "T.Texts", + "Strips", + "Strokes", + "Structures", + "Struggles", + "Students", + "Studies", + "Studios", + "Stuffs", + "Styles", + "Subjects", + "Submissions", + "Subscribers", + "Subscriptions", + "Subsidies", + "Substances", + "Substitutes", + "Substitutions", + "Suburbs", + "Successes", + "Successions", + "Successors", + "Sufferings", + "Sugars", + "Suggestions", + "Suites", + "Suits", + "Summaries", + "Summers", + "Summits", + "Sums", + "Sundays", + "Suns", + "Supermarkets", + "Supervisions", + "Supervisors", + "Supplements", + "Supplies", + "Supporters", + "Supports", + "Surfaces", + "Surgeons", + "Surgeries", + "Surges", + "Surplus", + "Surprises", + "Surveillances", + "Surveys", + "Survivals", + "Survivors", + "Suspects", + "Suspensions", + "Suspicions", + "Sweaters", + "Sweets", + "Swimmings", + "Swims", + "Swings", + "Switches", + "Swords", + "Symbols", + "Sympathies", + "Symptoms", + "Syndromes", + "Syntheses", + "Systems", + "TShirts", + "Tables", + "Tablets", + "Tackles", + "Tactics", + "Tags", + "Tails", + "Talents", + "Tales", + "Talks", + "Tanks", + "Tapes", + "Taps", + "Targets", + "Tasks", + "Tastes", + "Taxes", + "Taxis", + "Taxpayers", + "Teachers", + "Teachings", + "Teams", + "Tears", + "Teas", + "Techniques", + "Technologies", + "Teenagers", + "Teens", + "Teeth", + "Telephones", + "Televisions", + "Temperatures", + "Temples", + "Tenants", + "Tendencies", + "Tennis", + "Tensions", + "Tents", + "Tenures", + "Terminals", + "Terms", + "Terrains", + "Territories", + "Testimonies", + "Testings", + "Tests", + "Textbooks", + "Texts", + "Textures", + "Thanks", + "Theatres", + "Thefts", + "Themes", + "Theologies", + "Theories", + "Therapies", + "Therapists", + "Theses", + "Thieves", + "Things", + "Thinkings", + "Thirds", + "Thoughts", + "Threads", + "Threats", + "Thresholds", + "Throats", + "Thumbs", + "Thursdays", + "Tickets", + "Tides", + "Ties", + "Timbers", + "Times", + "Timings", + "Tins", + "Tips", + "Tissues", + "Titles", + "Tobaccos", + "Todays", + "Toes", + "Toilets", + "Tolerances", + "Tolls", + "Tomatoes", + "Tomorrows", + "Tones", + "Tongues", + "Tonights", + "Tonnes", + "Tons", + "Tools", + "Topics", + "Tops", + "Tortoises", + "Totals", + "Touches", + "Tourisms", + "Tourists", + "Tournaments", + "Tours", + "Towels", + "Towers", + "Towns", + "Toys", + "Traces", + "Tracks", + "Trademarks", + "Trades", + "Tradings", + "Traditions", + "Traffics", + "Tragedies", + "Trailers", + "Trails", + "Trainers", + "Trainings", + "Trains", + "Traits", + "Transactions", + "Transcripts", + "Transfers", + "Transformations", + "Transitions", + "Transits", + "Translations", + "Transmissions", + "Transparencies", + "Transportations", + "Transports", + "Traps", + "Traumas", + "Travellers", + "Travels", + "Treasures", + "Treaties", + "Treatments", + "Trees", + "Trends", + "Trials", + "Tribes", + "Tribunals", + "Tributes", + "Tricks", + "Tries", + "Triggers", + "Trios", + "Trips", + "Triumphs", + "Troops", + "Trophies", + "Troubles", + "Trousers", + "Trucks", + "Trustees", + "Trusts", + "Truths", + "Tsunamis", + "Tubes", + "Tuesdays", + "Tuitions", + "Tunes", + "Tunnels", + "Turnouts", + "Turnovers", + "Turns", + "Tvs", + "Twists", + "Types", + "Tyres", + "Umbrellas", + "Uncertainties", + "Uncles", + "Undergraduates", + "Understandings", + "Underwears", + "Unemployments", + "Uniforms", + "Unions", + "Unities", + "Units", + "Universes", + "Universities", + "Updates", + "Upgrades", + "Usages", + "Users", + "Uses", + "Utilities", + "Vacations", + "Vacuums", + "Validities", + "Valleys", + "Values", + "Vans", + "Variables", + "Variations", + "Varieties", + "Vegetables", + "Vehicles", + "Veins", + "Ventures", + "Venues", + "Verdicts", + "Verses", + "Versions", + "Vessels", + "Veterans", + "Vices", + "Victories", + "Videos", + "Viewers", + "Viewpoints", + "Views", + "Villagers", + "Villages", + "Violations", + "Violences", + "Virtues", + "Viruses", + "Visas", + "Visions", + "Visitors", + "Visits", + "Vitamins", + "Voices", + "Volumes", + "Volunteers", + "Votes", + "Votings", + "Vulnerabilities", + "Wages", + "Waiters", + "Waits", + "Walks", + "Walls", + "Wards", + "Warehouses", + "Warfares", + "Warmings", + "Warnings", + "Warrants", + "Warriors", + "Washes", + "Washings", + "Wastes", + "Watches", + "Waters", + "Waves", + "Ways", + "Weaknesses", + "Wealths", + "Weathers", + "Webs", + "Websites", + "Weddings", + "Wednesdays", + "Weeds", + "Weekends", + "Weeks", + "Weights", + "Welcomes", + "Welfares", + "WellBeings", + "Wells", + "Wests", + "Wheat", + "Wheels", + "Whispers", + "Wholes", + "Widows", + "Widths", + "Wildlives", + "Willingnesses", + "Wills", + "Windows", + "Winds", + "Wines", + "Wings", + "Winners", + "Wins", + "Winters", + "Wires", + "Wisdoms", + "Wishes", + "Withdrawals", + "Witnesses", + "Wits", + "Wonders", + "Woods", + "Wools", + "Words", + "Workers", + "Workforces", + "Workouts", + "Workplaces", + "Works", + "Workshops", + "Worlds", + "Worms", + "Worries", + "Worses", + "Worships", + "Worsts", + "Worths", + "Wounds", + "Wrists", + "Writers", + "Writings", + "Wrongs", + "Yards", + "Years", + "Yellows", + "Yesterdays", + "Yields", + "Zones" ] verbs :: V.Vector T.Text verbs = - [ "Abolish" - , "Absorb" - , "Accelerate" - , "Accept" - , "Access" - , "Accommodate" - , "Accompany" - , "Accomplish" - , "Account" - , "Accumulate" - , "Accuse" - , "Achieve" - , "Acknowledge" - , "Acquire" - , "Act" - , "Activate" - , "Adapt" - , "Add" - , "Address" - , "Adhere" - , "Adjust" - , "Administer" - , "Admire" - , "Admit" - , "Adopt" - , "Advance" - , "Advertise" - , "Advise" - , "Advocate" - , "Affect" - , "Afford" - , "Age" - , "Agree" - , "Aid" - , "Aim" - , "Alarm" - , "Alert" - , "Align" - , "Allege" - , "Allocate" - , "Allow" - , "Alter" - , "Amend" - , "Amount" - , "Analyse" - , "Announce" - , "Annoy" - , "Answer" - , "Anticipate" - , "Apologize" - , "Appeal" - , "Appear" - , "Applaud" - , "Apply" - , "Appoint" - , "Appreciate" - , "Approach" - , "Approve" - , "Argue" - , "Arise" - , "Arm" - , "Arrange" - , "Arrest" - , "Arrive" - , "Articulate" - , "Ask" - , "Aspire" - , "Assemble" - , "Assert" - , "Assess" - , "Assign" - , "Assist" - , "Associate" - , "Assume" - , "Assure" - , "Attach" - , "Attain" - , "Attempt" - , "Attend" - , "Attract" - , "Attribute" - , "Authorize" - , "Average" - , "Avoid" - , "Await" - , "Award" - , "Back" - , "Bake" - , "Balance" - , "Ban" - , "Bar" - , "Base" - , "Bat" - , "Battle" - , "Be" - , "Bear" - , "Beat" - , "Become" - , "Beg" - , "Begin" - , "Behave" - , "Believe" - , "Belong" - , "Bend" - , "Benefit" - , "Bet" - , "Betray" - , "Bid" - , "Bill" - , "Bind" - , "Bite" - , "Blame" - , "Blast" - , "Blend" - , "Bless" - , "Block" - , "Blow" - , "Board" - , "Boast" - , "Boil" - , "Book" - , "Boost" - , "Border" - , "Borrow" - , "Bother" - , "Bounce" - , "Bow" - , "Brand" - , "Breach" - , "Break" - , "Breathe" - , "Breed" - , "Bring" - , "Broadcast" - , "Brush" - , "Build" - , "Burn" - , "Burst" - , "Bury" - , "Buy" - , "Calculate" - , "Call" - , "Calm" - , "Camp" - , "Campaign" - , "Cancel" - , "Capture" - , "Care" - , "Carry" - , "Carve" - , "Cast" - , "Catch" - , "Cater" - , "Cause" - , "Cease" - , "Celebrate" - , "Centre" - , "Chain" - , "Chair" - , "Challenge" - , "Change" - , "Characterize" - , "Charge" - , "Chart" - , "Chase" - , "Chat" - , "Cheat" - , "Check" - , "Cheer" - , "Choose" - , "Chop" - , "Circle" - , "Circulate" - , "Cite" - , "Claim" - , "Clarify" - , "Classify" - , "Clean" - , "Clear" - , "Click" - , "Climb" - , "Cling" - , "Close" - , "Coach" - , "Coincide" - , "Collaborate" - , "Collapse" - , "Collect" - , "Combat" - , "Combine" - , "Come" - , "Comfort" - , "Command" - , "Commence" - , "Comment" - , "Commission" - , "Commit" - , "Communicate" - , "Compare" - , "Compel" - , "Compensate" - , "Compete" - , "Compile" - , "Complain" - , "Complement" - , "Complete" - , "Comply" - , "Compose" - , "Comprise" - , "Compromise" - , "Compute" - , "Conceal" - , "Concede" - , "Conceive" - , "Concentrate" - , "Concern" - , "Conclude" - , "Condemn" - , "Conduct" - , "Confer" - , "Confess" - , "Confine" - , "Confirm" - , "Conflict" - , "Confront" - , "Confuse" - , "Congratulate" - , "Connect" - , "Conquer" - , "Consent" - , "Conserve" - , "Consider" - , "Consist" - , "Consolidate" - , "Constitute" - , "Construct" - , "Consult" - , "Consume" - , "Contact" - , "Contain" - , "Contemplate" - , "Contend" - , "Contest" - , "Continue" - , "Contract" - , "Contrast" - , "Contribute" - , "Control" - , "Convert" - , "Convey" - , "Convict" - , "Convince" - , "Cook" - , "Cool" - , "Cooperate" - , "Coordinate" - , "Cope" - , "Copy" - , "Correct" - , "Correlate" - , "Correspond" - , "Cost" - , "Count" - , "Counter" - , "Cover" - , "Crack" - , "Craft" - , "Crash" - , "Crawl" - , "Create" - , "Credit" - , "Creep" - , "Criticize" - , "Cross" - , "Cruise" - , "Crush" - , "Cry" - , "Cultivate" - , "Cure" - , "Curve" - , "Cut" - , "Cycle" - , "Damage" - , "Dance" - , "Dare" - , "Date" - , "Deal" - , "Debate" - , "Decide" - , "Declare" - , "Decline" - , "Decorate" - , "Decrease" - , "Deem" - , "Defeat" - , "Defend" - , "Define" - , "Defy" - , "Delay" - , "Delete" - , "Delight" - , "Deliver" - , "Demand" - , "Demonstrate" - , "Denounce" - , "Deny" - , "Depart" - , "Depend" - , "Depict" - , "Deploy" - , "Deposit" - , "Deprive" - , "Derive" - , "Descend" - , "Describe" - , "Desert" - , "Deserve" - , "Design" - , "Designate" - , "Desire" - , "Destroy" - , "Detail" - , "Detain" - , "Detect" - , "Deteriorate" - , "Determine" - , "Devastate" - , "Develop" - , "Devise" - , "Devote" - , "Diagnose" - , "Dictate" - , "Differ" - , "Differentiate" - , "Dig" - , "Diminish" - , "Dip" - , "Direct" - , "Disagree" - , "Disappear" - , "Disappoint" - , "Discard" - , "Discharge" - , "Disclose" - , "Discount" - , "Discourage" - , "Discover" - , "Discuss" - , "Dislike" - , "Dismiss" - , "Displace" - , "Display" - , "Dispose" - , "Dispute" - , "Disrupt" - , "Dissolve" - , "Distinguish" - , "Distort" - , "Distract" - , "Distress" - , "Distribute" - , "Disturb" - , "Dive" - , "Divert" - , "Divide" - , "Divorce" - , "Do" - , "Document" - , "Dominate" - , "Donate" - , "Double" - , "Doubt" - , "Download" - , "Draft" - , "Drag" - , "Drain" - , "Draw" - , "Dream" - , "Dress" - , "Drift" - , "Drink" - , "Drive" - , "Drop" - , "Dry" - , "Dub" - , "Dump" - , "Earn" - , "Ease" - , "Eat" - , "Echo" - , "Edit" - , "Educate" - , "Elect" - , "Elevate" - , "Eliminate" - , "Email" - , "Embark" - , "Embed" - , "Embody" - , "Embrace" - , "Emerge" - , "Emphasize" - , "Employ" - , "Empower" - , "Empty" - , "Enable" - , "Enact" - , "Encompass" - , "Encounter" - , "Encourage" - , "End" - , "Endorse" - , "Endure" - , "Enforce" - , "Engage" - , "Enhance" - , "Enjoy" - , "Enquire" - , "Enrich" - , "Enrol" - , "Ensue" - , "Ensure" - , "Enter" - , "Entertain" - , "Entitle" - , "Equal" - , "Equip" - , "Erect" - , "Erupt" - , "Escalate" - , "Escape" - , "Establish" - , "Estimate" - , "Evacuate" - , "Evaluate" - , "Evoke" - , "Evolve" - , "Exaggerate" - , "Examine" - , "Exceed" - , "Exchange" - , "Exclude" - , "Excuse" - , "Execute" - , "Exercise" - , "Exert" - , "Exhibit" - , "Exist" - , "Exit" - , "Expand" - , "Expect" - , "Experience" - , "Experiment" - , "Expire" - , "Explain" - , "Explode" - , "Exploit" - , "Explore" - , "Export" - , "Expose" - , "Express" - , "Extend" - , "Extract" - , "Face" - , "Facilitate" - , "Fade" - , "Fail" - , "Fall" - , "Fancy" - , "Farm" - , "Fasten" - , "Favour" - , "Fear" - , "Feature" - , "Feed" - , "Feel" - , "Fight" - , "Figure" - , "File" - , "Fill" - , "Film" - , "Filter" - , "Finance" - , "Find" - , "Fine" - , "Finish" - , "Fire" - , "Fish" - , "Fit" - , "Fix" - , "Flash" - , "Flee" - , "Float" - , "Flood" - , "Flourish" - , "Flow" - , "Fly" - , "Focus" - , "Fold" - , "Follow" - , "Forbid" - , "Force" - , "Forecast" - , "Forge" - , "Forget" - , "Forgive" - , "Form" - , "Formulate" - , "Foster" - , "Found" - , "Frame" - , "Free" - , "Freeze" - , "Frighten" - , "Fry" - , "Fuel" - , "Fulfil" - , "Function" - , "Fund" - , "Gain" - , "Gather" - , "Gaze" - , "Generate" - , "Get" - , "Give" - , "Glance" - , "Go" - , "Govern" - , "Grab" - , "Grade" - , "Graduate" - , "Grant" - , "Grasp" - , "Greet" - , "Grin" - , "Grind" - , "Grip" - , "Grow" - , "Guarantee" - , "Guard" - , "Guess" - , "Guide" - , "Hail" - , "Halt" - , "Hand" - , "Handle" - , "Hang" - , "Happen" - , "Harvest" - , "Haunt" - , "Have" - , "Head" - , "Heal" - , "Hear" - , "Heat" - , "Heighten" - , "Help" - , "Hesitate" - , "Hide" - , "Highlight" - , "Hint" - , "Hire" - , "Hit" - , "Hold" - , "Honour" - , "Hook" - , "Hope" - , "Host" - , "House" - , "Hunt" - , "Hurry" - , "Identify" - , "Ignore" - , "Illustrate" - , "Imagine" - , "Impact" - , "Implement" - , "Imply" - , "Import" - , "Impose" - , "Impress" - , "Improve" - , "Include" - , "Incorporate" - , "Increase" - , "Incur" - , "Indicate" - , "Induce" - , "Indulge" - , "Infect" - , "Infer" - , "Inflict" - , "Influence" - , "Inform" - , "Inherit" - , "Inhibit" - , "Initiate" - , "Inject" - , "Injure" - , "Insert" - , "Insist" - , "Inspect" - , "Inspire" - , "Install" - , "Instruct" - , "Insult" - , "Integrate" - , "Intend" - , "Intensify" - , "Interact" - , "Interest" - , "Interfere" - , "Interpret" - , "Interrupt" - , "Intervene" - , "Interview" - , "Introduce" - , "Invade" - , "Invent" - , "Invest" - , "Investigate" - , "Invite" - , "Invoke" - , "Involve" - , "Iron" - , "Isolate" - , "Issue" - , "Join" - , "Joke" - , "Judge" - , "Jump" - , "Justify" - , "Keep" - , "Key" - , "Kick" - , "Kiss" - , "Knock" - , "Know" - , "Label" - , "Lack" - , "Land" - , "Last" - , "Laugh" - , "Launch" - , "Lay" - , "Lead" - , "Leak" - , "Lean" - , "Leap" - , "Learn" - , "Leave" - , "Lecture" - , "Lend" - , "Let" - , "Level" - , "License" - , "Lift" - , "Light" - , "Like" - , "Limit" - , "Line" - , "Linger" - , "Link" - , "List" - , "Listen" - , "Live" - , "Load" - , "Lobby" - , "Locate" - , "Lock" - , "Log" - , "Look" - , "Loom" - , "Lose" - , "Love" - , "Lower" - , "Mail" - , "Maintain" - , "Make" - , "Manage" - , "Manifest" - , "Manipulate" - , "Manufacture" - , "Map" - , "March" - , "Mark" - , "Market" - , "Marry" - , "Master" - , "Match" - , "Mate" - , "Matter" - , "Mature" - , "Maximize" - , "Mean" - , "Measure" - , "Meet" - , "Melt" - , "Mention" - , "Merge" - , "Mind" - , "Minimize" - , "Miss" - , "Mistake" - , "Mix" - , "Mobilize" - , "Model" - , "Modify" - , "Monitor" - , "Motivate" - , "Mount" - , "Move" - , "Multiply" - , "Name" - , "Narrow" - , "Need" - , "Neglect" - , "Negotiate" - , "Nod" - , "Nominate" - , "Note" - , "Notice" - , "Notify" - , "Number" - , "Obey" - , "Object" - , "Oblige" - , "Observe" - , "Obsess" - , "Obtain" - , "Occupy" - , "Occur" - , "Offend" - , "Offer" - , "Open" - , "Operate" - , "Oppose" - , "Opt" - , "Order" - , "Organize" - , "Originate" - , "Outline" - , "Outrage" - , "Overcome" - , "Overlook" - , "Oversee" - , "Overturn" - , "Overwhelm" - , "Owe" - , "Own" - , "Pace" - , "Pack" - , "Package" - , "Paint" - , "Park" - , "Participate" - , "Pass" - , "Patrol" - , "Pause" - , "Pay" - , "Perceive" - , "Perform" - , "Permit" - , "Persist" - , "Persuade" - , "Phone" - , "Photograph" - , "Pick" - , "Picture" - , "Pile" - , "Pin" - , "Pioneer" - , "Place" - , "Plan" - , "Plant" - , "Play" - , "Plead" - , "Please" - , "Pledge" - , "Plot" - , "Plug" - , "Plunge" - , "Point" - , "Pop" - , "Portray" - , "Pose" - , "Position" - , "Possess" - , "Post" - , "Postpone" - , "Pour" - , "Power" - , "Practise" - , "Praise" - , "Pray" - , "Preach" - , "Precede" - , "Predict" - , "Prefer" - , "Prepare" - , "Prescribe" - , "Present" - , "Preserve" - , "Preside" - , "Press" - , "Presume" - , "Pretend" - , "Prevail" - , "Prevent" - , "Price" - , "Print" - , "Probe" - , "Proceed" - , "Process" - , "Proclaim" - , "Produce" - , "Program" - , "Progress" - , "Prohibit" - , "Project" - , "Promise" - , "Promote" - , "Prompt" - , "Pronounce" - , "Propose" - , "Prosecute" - , "Protect" - , "Protest" - , "Prove" - , "Provide" - , "Provoke" - , "Publish" - , "Pull" - , "Pump" - , "Punch" - , "Punish" - , "Purchase" - , "Pursue" - , "Push" - , "Put" - , "Qualify" - , "Question" - , "Queue" - , "Quit" - , "Quote" - , "Race" - , "Raid" - , "Rain" - , "Raise" - , "Rally" - , "Range" - , "Rank" - , "Rate" - , "Reach" - , "React" - , "Read" - , "Realize" - , "Reassure" - , "Rebuild" - , "Recall" - , "Receive" - , "Reckon" - , "Recognize" - , "Recommend" - , "Record" - , "Recount" - , "Recover" - , "Recruit" - , "Recycle" - , "Reduce" - , "Refer" - , "Reflect" - , "Reform" - , "Refuse" - , "Regain" - , "Regard" - , "Register" - , "Regret" - , "Regulate" - , "Reign" - , "Reinforce" - , "Reject" - , "Relate" - , "Relax" - , "Release" - , "Relieve" - , "Rely" - , "Remain" - , "Remark" - , "Remember" - , "Remind" - , "Remove" - , "Render" - , "Renew" - , "Rent" - , "Repair" - , "Repeat" - , "Replace" - , "Reply" - , "Report" - , "Represent" - , "Reproduce" - , "Request" - , "Require" - , "Rescue" - , "Research" - , "Resemble" - , "Reserve" - , "Reside" - , "Resign" - , "Resist" - , "Resolve" - , "Respect" - , "Respond" - , "Rest" - , "Restore" - , "Restrict" - , "Result" - , "Resume" - , "Retain" - , "Retire" - , "Retreat" - , "Retrieve" - , "Return" - , "Reveal" - , "Reverse" - , "Review" - , "Revise" - , "Revive" - , "Reward" - , "Rid" - , "Ride" - , "Ring" - , "Rip" - , "Rise" - , "Risk" - , "Rob" - , "Rock" - , "Roll" - , "Rotate" - , "Rub" - , "Ruin" - , "Rule" - , "Run" - , "Rush" - , "Sack" - , "Sacrifice" - , "Sail" - , "Sample" - , "Satisfy" - , "Save" - , "Say" - , "Scan" - , "Scare" - , "Schedule" - , "Score" - , "Scratch" - , "Scream" - , "Screen" - , "Screw" - , "Seal" - , "Search" - , "Seat" - , "Secure" - , "See" - , "Seek" - , "Seize" - , "Select" - , "Sell" - , "Send" - , "Sense" - , "Sentence" - , "Separate" - , "Serve" - , "Set" - , "Settle" - , "Shake" - , "Shape" - , "Share" - , "Shatter" - , "Shed" - , "Shelter" - , "Shift" - , "Shine" - , "Ship" - , "Shock" - , "Shoot" - , "Shop" - , "Shout" - , "Show" - , "Shrink" - , "Shrug" - , "Shut" - , "Sigh" - , "Sign" - , "Signal" - , "Simulate" - , "Sing" - , "Sink" - , "Sit" - , "Ski" - , "Skip" - , "Slam" - , "Slap" - , "Slash" - , "Sleep" - , "Slice" - , "Slide" - , "Slip" - , "Slope" - , "Slow" - , "Smash" - , "Smell" - , "Smile" - , "Smoke" - , "Snap" - , "Snow" - , "Soak" - , "Soar" - , "Solve" - , "Sort" - , "Sound" - , "Span" - , "Spare" - , "Spark" - , "Speak" - , "Specialize" - , "Specify" - , "Speculate" - , "Speed" - , "Spell" - , "Spend" - , "Spill" - , "Spin" - , "Split" - , "Spoil" - , "Sponsor" - , "Spot" - , "Spread" - , "Spring" - , "Spy" - , "Squeeze" - , "Stab" - , "Stabilize" - , "Stage" - , "Stand" - , "Star" - , "Stare" - , "Start" - , "Starve" - , "State" - , "Stay" - , "Steal" - , "Steer" - , "Stem" - , "Step" - , "Stick" - , "Stimulate" - , "Stir" - , "Stop" - , "Store" - , "Strengthen" - , "Stress" - , "Stretch" - , "Strike" - , "Strip" - , "Strive" - , "Structure" - , "Struggle" - , "Study" - , "Stuff" - , "Stumble" - , "Stun" - , "Submit" - , "Substitute" - , "Succeed" - , "Sue" - , "Suffer" - , "Suggest" - , "Suit" - , "Sum" - , "Summarize" - , "Supervise" - , "Supplement" - , "Supply" - , "Support" - , "Suppose" - , "Suppress" - , "Surge" - , "Surprise" - , "Surrender" - , "Surround" - , "Survey" - , "Survive" - , "Suspect" - , "Suspend" - , "Sustain" - , "Swallow" - , "Swear" - , "Sweep" - , "Swim" - , "Swing" - , "Switch" - , "Tackle" - , "Tag" - , "Take" - , "Talk" - , "Tap" - , "Target" - , "Taste" - , "Tax" - , "Teach" - , "Tear" - , "Telephone" - , "Tell" - , "Tempt" - , "Tend" - , "Term" - , "Terminate" - , "Terrify" - , "Test" - , "Testify" - , "Text" - , "Thank" - , "Think" - , "Thrive" - , "Throw" - , "Tidy" - , "Tie" - , "Tighten" - , "Time" - , "Tip" - , "Title" - , "Tolerate" - , "Top" - , "Toss" - , "Total" - , "Touch" - , "Tour" - , "Trace" - , "Track" - , "Trade" - , "Trail" - , "Train" - , "Transfer" - , "Transform" - , "Translate" - , "Transmit" - , "Transport" - , "Trap" - , "Travel" - , "Treat" - , "Trick" - , "Trigger" - , "Trip" - , "Trouble" - , "Trust" - , "Try" - , "Turn" - , "Twist" - , "Type" - , "Undergo" - , "Undermine" - , "Understand" - , "Undertake" - , "Unfold" - , "Unify" - , "Unite" - , "Unveil" - , "Update" - , "Upgrade" - , "Uphold" - , "Upset" - , "Urge" - , "Use" - , "Utilize" - , "Value" - , "Vanish" - , "Vary" - , "Venture" - , "Verify" - , "View" - , "Visit" - , "Volunteer" - , "Vote" - , "Vow" - , "Wait" - , "Wake" - , "Walk" - , "Wander" - , "Want" - , "Warm" - , "Warn" - , "Warrant" - , "Wash" - , "Waste" - , "Watch" - , "Water" - , "Wave" - , "Weaken" - , "Wear" - , "Weave" - , "Weigh" - , "Welcome" - , "Whip" - , "Whisper" - , "Widen" - , "Win" - , "Wind" - , "Wipe" - , "Wish" - , "Withdraw" - , "Witness" - , "Wonder" - , "Work" - , "Worry" - , "Worship" - , "Wound" - , "Wrap" - , "Write" - , "Yell" - , "Yield" + [ "Abolish", + "Absorb", + "Accelerate", + "Accept", + "Access", + "Accommodate", + "Accompany", + "Accomplish", + "Account", + "Accumulate", + "Accuse", + "Achieve", + "Acknowledge", + "Acquire", + "Act", + "Activate", + "Adapt", + "Add", + "Address", + "Adhere", + "Adjust", + "Administer", + "Admire", + "Admit", + "Adopt", + "Advance", + "Advertise", + "Advise", + "Advocate", + "Affect", + "Afford", + "Age", + "Agree", + "Aid", + "Aim", + "Alarm", + "Alert", + "Align", + "Allege", + "Allocate", + "Allow", + "Alter", + "Amend", + "Amount", + "Analyse", + "Announce", + "Annoy", + "Answer", + "Anticipate", + "Apologize", + "Appeal", + "Appear", + "Applaud", + "Apply", + "Appoint", + "Appreciate", + "Approach", + "Approve", + "Argue", + "Arise", + "Arm", + "Arrange", + "Arrest", + "Arrive", + "Articulate", + "Ask", + "Aspire", + "Assemble", + "Assert", + "Assess", + "Assign", + "Assist", + "Associate", + "Assume", + "Assure", + "Attach", + "Attain", + "Attempt", + "Attend", + "Attract", + "Attribute", + "Authorize", + "Average", + "Avoid", + "Await", + "Award", + "Back", + "Bake", + "Balance", + "Ban", + "Bar", + "Base", + "Bat", + "Battle", + "Be", + "Bear", + "Beat", + "Become", + "Beg", + "Begin", + "Behave", + "Believe", + "Belong", + "Bend", + "Benefit", + "Bet", + "Betray", + "Bid", + "Bill", + "Bind", + "Bite", + "Blame", + "Blast", + "Blend", + "Bless", + "Block", + "Blow", + "Board", + "Boast", + "Boil", + "Book", + "Boost", + "Border", + "Borrow", + "Bother", + "Bounce", + "Bow", + "Brand", + "Breach", + "Break", + "Breathe", + "Breed", + "Bring", + "Broadcast", + "Brush", + "Build", + "Burn", + "Burst", + "Bury", + "Buy", + "Calculate", + "Call", + "Calm", + "Camp", + "Campaign", + "Cancel", + "Capture", + "Care", + "Carry", + "Carve", + "Cast", + "Catch", + "Cater", + "Cause", + "Cease", + "Celebrate", + "Centre", + "Chain", + "Chair", + "Challenge", + "Change", + "Characterize", + "Charge", + "Chart", + "Chase", + "Chat", + "Cheat", + "Check", + "Cheer", + "Choose", + "Chop", + "Circle", + "Circulate", + "Cite", + "Claim", + "Clarify", + "Classify", + "Clean", + "Clear", + "Click", + "Climb", + "Cling", + "Close", + "Coach", + "Coincide", + "Collaborate", + "Collapse", + "Collect", + "Combat", + "Combine", + "Come", + "Comfort", + "Command", + "Commence", + "Comment", + "Commission", + "Commit", + "Communicate", + "Compare", + "Compel", + "Compensate", + "Compete", + "Compile", + "Complain", + "Complement", + "Complete", + "Comply", + "Compose", + "Comprise", + "Compromise", + "Compute", + "Conceal", + "Concede", + "Conceive", + "Concentrate", + "Concern", + "Conclude", + "Condemn", + "Conduct", + "Confer", + "Confess", + "Confine", + "Confirm", + "Conflict", + "Confront", + "Confuse", + "Congratulate", + "Connect", + "Conquer", + "Consent", + "Conserve", + "Consider", + "Consist", + "Consolidate", + "Constitute", + "Construct", + "Consult", + "Consume", + "Contact", + "Contain", + "Contemplate", + "Contend", + "Contest", + "Continue", + "Contract", + "Contrast", + "Contribute", + "Control", + "Convert", + "Convey", + "Convict", + "Convince", + "Cook", + "Cool", + "Cooperate", + "Coordinate", + "Cope", + "Copy", + "Correct", + "Correlate", + "Correspond", + "Cost", + "Count", + "Counter", + "Cover", + "Crack", + "Craft", + "Crash", + "Crawl", + "Create", + "Credit", + "Creep", + "Criticize", + "Cross", + "Cruise", + "Crush", + "Cry", + "Cultivate", + "Cure", + "Curve", + "Cut", + "Cycle", + "Damage", + "Dance", + "Dare", + "Date", + "Deal", + "Debate", + "Decide", + "Declare", + "Decline", + "Decorate", + "Decrease", + "Deem", + "Defeat", + "Defend", + "Define", + "Defy", + "Delay", + "Delete", + "Delight", + "Deliver", + "Demand", + "Demonstrate", + "Denounce", + "Deny", + "Depart", + "Depend", + "Depict", + "Deploy", + "Deposit", + "Deprive", + "Derive", + "Descend", + "Describe", + "Desert", + "Deserve", + "Design", + "Designate", + "Desire", + "Destroy", + "Detail", + "Detain", + "Detect", + "Deteriorate", + "Determine", + "Devastate", + "Develop", + "Devise", + "Devote", + "Diagnose", + "Dictate", + "Differ", + "Differentiate", + "Dig", + "Diminish", + "Dip", + "Direct", + "Disagree", + "Disappear", + "Disappoint", + "Discard", + "Discharge", + "Disclose", + "Discount", + "Discourage", + "Discover", + "Discuss", + "Dislike", + "Dismiss", + "Displace", + "Display", + "Dispose", + "Dispute", + "Disrupt", + "Dissolve", + "Distinguish", + "Distort", + "Distract", + "Distress", + "Distribute", + "Disturb", + "Dive", + "Divert", + "Divide", + "Divorce", + "Do", + "Document", + "Dominate", + "Donate", + "Double", + "Doubt", + "Download", + "Draft", + "Drag", + "Drain", + "Draw", + "Dream", + "Dress", + "Drift", + "Drink", + "Drive", + "Drop", + "Dry", + "Dub", + "Dump", + "Earn", + "Ease", + "Eat", + "Echo", + "Edit", + "Educate", + "Elect", + "Elevate", + "Eliminate", + "Email", + "Embark", + "Embed", + "Embody", + "Embrace", + "Emerge", + "Emphasize", + "Employ", + "Empower", + "Empty", + "Enable", + "Enact", + "Encompass", + "Encounter", + "Encourage", + "End", + "Endorse", + "Endure", + "Enforce", + "Engage", + "Enhance", + "Enjoy", + "Enquire", + "Enrich", + "Enrol", + "Ensue", + "Ensure", + "Enter", + "Entertain", + "Entitle", + "Equal", + "Equip", + "Erect", + "Erupt", + "Escalate", + "Escape", + "Establish", + "Estimate", + "Evacuate", + "Evaluate", + "Evoke", + "Evolve", + "Exaggerate", + "Examine", + "Exceed", + "Exchange", + "Exclude", + "Excuse", + "Execute", + "Exercise", + "Exert", + "Exhibit", + "Exist", + "Exit", + "Expand", + "Expect", + "Experience", + "Experiment", + "Expire", + "Explain", + "Explode", + "Exploit", + "Explore", + "Export", + "Expose", + "Express", + "Extend", + "Extract", + "Face", + "Facilitate", + "Fade", + "Fail", + "Fall", + "Fancy", + "Farm", + "Fasten", + "Favour", + "Fear", + "Feature", + "Feed", + "Feel", + "Fight", + "Figure", + "File", + "Fill", + "Film", + "Filter", + "Finance", + "Find", + "Fine", + "Finish", + "Fire", + "Fish", + "Fit", + "Fix", + "Flash", + "Flee", + "Float", + "Flood", + "Flourish", + "Flow", + "Fly", + "Focus", + "Fold", + "Follow", + "Forbid", + "Force", + "Forecast", + "Forge", + "Forget", + "Forgive", + "Form", + "Formulate", + "Foster", + "Found", + "Frame", + "Free", + "Freeze", + "Frighten", + "Fry", + "Fuel", + "Fulfil", + "Function", + "Fund", + "Gain", + "Gather", + "Gaze", + "Generate", + "Get", + "Give", + "Glance", + "Go", + "Govern", + "Grab", + "Grade", + "Graduate", + "Grant", + "Grasp", + "Greet", + "Grin", + "Grind", + "Grip", + "Grow", + "Guarantee", + "Guard", + "Guess", + "Guide", + "Hail", + "Halt", + "Hand", + "Handle", + "Hang", + "Happen", + "Harvest", + "Haunt", + "Have", + "Head", + "Heal", + "Hear", + "Heat", + "Heighten", + "Help", + "Hesitate", + "Hide", + "Highlight", + "Hint", + "Hire", + "Hit", + "Hold", + "Honour", + "Hook", + "Hope", + "Host", + "House", + "Hunt", + "Hurry", + "Identify", + "Ignore", + "Illustrate", + "Imagine", + "Impact", + "Implement", + "Imply", + "Import", + "Impose", + "Impress", + "Improve", + "Include", + "Incorporate", + "Increase", + "Incur", + "Indicate", + "Induce", + "Indulge", + "Infect", + "Infer", + "Inflict", + "Influence", + "Inform", + "Inherit", + "Inhibit", + "Initiate", + "Inject", + "Injure", + "Insert", + "Insist", + "Inspect", + "Inspire", + "Install", + "Instruct", + "Insult", + "Integrate", + "Intend", + "Intensify", + "Interact", + "Interest", + "Interfere", + "Interpret", + "Interrupt", + "Intervene", + "Interview", + "Introduce", + "Invade", + "Invent", + "Invest", + "Investigate", + "Invite", + "Invoke", + "Involve", + "Iron", + "Isolate", + "Issue", + "Join", + "Joke", + "Judge", + "Jump", + "Justify", + "Keep", + "Key", + "Kick", + "Kiss", + "Knock", + "Know", + "Label", + "Lack", + "Land", + "Last", + "Laugh", + "Launch", + "Lay", + "Lead", + "Leak", + "Lean", + "Leap", + "Learn", + "Leave", + "Lecture", + "Lend", + "Let", + "Level", + "License", + "Lift", + "Light", + "Like", + "Limit", + "Line", + "Linger", + "Link", + "List", + "Listen", + "Live", + "Load", + "Lobby", + "Locate", + "Lock", + "Log", + "Look", + "Loom", + "Lose", + "Love", + "Lower", + "Mail", + "Maintain", + "Make", + "Manage", + "Manifest", + "Manipulate", + "Manufacture", + "Map", + "March", + "Mark", + "Market", + "Marry", + "Master", + "Match", + "Mate", + "Matter", + "Mature", + "Maximize", + "Mean", + "Measure", + "Meet", + "Melt", + "Mention", + "Merge", + "Mind", + "Minimize", + "Miss", + "Mistake", + "Mix", + "Mobilize", + "Model", + "Modify", + "Monitor", + "Motivate", + "Mount", + "Move", + "Multiply", + "Name", + "Narrow", + "Need", + "Neglect", + "Negotiate", + "Nod", + "Nominate", + "Note", + "Notice", + "Notify", + "Number", + "Obey", + "Object", + "Oblige", + "Observe", + "Obsess", + "Obtain", + "Occupy", + "Occur", + "Offend", + "Offer", + "Open", + "Operate", + "Oppose", + "Opt", + "Order", + "Organize", + "Originate", + "Outline", + "Outrage", + "Overcome", + "Overlook", + "Oversee", + "Overturn", + "Overwhelm", + "Owe", + "Own", + "Pace", + "Pack", + "Package", + "Paint", + "Park", + "Participate", + "Pass", + "Patrol", + "Pause", + "Pay", + "Perceive", + "Perform", + "Permit", + "Persist", + "Persuade", + "Phone", + "Photograph", + "Pick", + "Picture", + "Pile", + "Pin", + "Pioneer", + "Place", + "Plan", + "Plant", + "Play", + "Plead", + "Please", + "Pledge", + "Plot", + "Plug", + "Plunge", + "Point", + "Pop", + "Portray", + "Pose", + "Position", + "Possess", + "Post", + "Postpone", + "Pour", + "Power", + "Practise", + "Praise", + "Pray", + "Preach", + "Precede", + "Predict", + "Prefer", + "Prepare", + "Prescribe", + "Present", + "Preserve", + "Preside", + "Press", + "Presume", + "Pretend", + "Prevail", + "Prevent", + "Price", + "Print", + "Probe", + "Proceed", + "Process", + "Proclaim", + "Produce", + "Program", + "Progress", + "Prohibit", + "Project", + "Promise", + "Promote", + "Prompt", + "Pronounce", + "Propose", + "Prosecute", + "Protect", + "Protest", + "Prove", + "Provide", + "Provoke", + "Publish", + "Pull", + "Pump", + "Punch", + "Punish", + "Purchase", + "Pursue", + "Push", + "Put", + "Qualify", + "Question", + "Queue", + "Quit", + "Quote", + "Race", + "Raid", + "Rain", + "Raise", + "Rally", + "Range", + "Rank", + "Rate", + "Reach", + "React", + "Read", + "Realize", + "Reassure", + "Rebuild", + "Recall", + "Receive", + "Reckon", + "Recognize", + "Recommend", + "Record", + "Recount", + "Recover", + "Recruit", + "Recycle", + "Reduce", + "Refer", + "Reflect", + "Reform", + "Refuse", + "Regain", + "Regard", + "Register", + "Regret", + "Regulate", + "Reign", + "Reinforce", + "Reject", + "Relate", + "Relax", + "Release", + "Relieve", + "Rely", + "Remain", + "Remark", + "Remember", + "Remind", + "Remove", + "Render", + "Renew", + "Rent", + "Repair", + "Repeat", + "Replace", + "Reply", + "Report", + "Represent", + "Reproduce", + "Request", + "Require", + "Rescue", + "Research", + "Resemble", + "Reserve", + "Reside", + "Resign", + "Resist", + "Resolve", + "Respect", + "Respond", + "Rest", + "Restore", + "Restrict", + "Result", + "Resume", + "Retain", + "Retire", + "Retreat", + "Retrieve", + "Return", + "Reveal", + "Reverse", + "Review", + "Revise", + "Revive", + "Reward", + "Rid", + "Ride", + "Ring", + "Rip", + "Rise", + "Risk", + "Rob", + "Rock", + "Roll", + "Rotate", + "Rub", + "Ruin", + "Rule", + "Run", + "Rush", + "Sack", + "Sacrifice", + "Sail", + "Sample", + "Satisfy", + "Save", + "Say", + "Scan", + "Scare", + "Schedule", + "Score", + "Scratch", + "Scream", + "Screen", + "Screw", + "Seal", + "Search", + "Seat", + "Secure", + "See", + "Seek", + "Seize", + "Select", + "Sell", + "Send", + "Sense", + "Sentence", + "Separate", + "Serve", + "Set", + "Settle", + "Shake", + "Shape", + "Share", + "Shatter", + "Shed", + "Shelter", + "Shift", + "Shine", + "Ship", + "Shock", + "Shoot", + "Shop", + "Shout", + "Show", + "Shrink", + "Shrug", + "Shut", + "Sigh", + "Sign", + "Signal", + "Simulate", + "Sing", + "Sink", + "Sit", + "Ski", + "Skip", + "Slam", + "Slap", + "Slash", + "Sleep", + "Slice", + "Slide", + "Slip", + "Slope", + "Slow", + "Smash", + "Smell", + "Smile", + "Smoke", + "Snap", + "Snow", + "Soak", + "Soar", + "Solve", + "Sort", + "Sound", + "Span", + "Spare", + "Spark", + "Speak", + "Specialize", + "Specify", + "Speculate", + "Speed", + "Spell", + "Spend", + "Spill", + "Spin", + "Split", + "Spoil", + "Sponsor", + "Spot", + "Spread", + "Spring", + "Spy", + "Squeeze", + "Stab", + "Stabilize", + "Stage", + "Stand", + "Star", + "Stare", + "Start", + "Starve", + "State", + "Stay", + "Steal", + "Steer", + "Stem", + "Step", + "Stick", + "Stimulate", + "Stir", + "Stop", + "Store", + "Strengthen", + "Stress", + "Stretch", + "Strike", + "Strip", + "Strive", + "Structure", + "Struggle", + "Study", + "Stuff", + "Stumble", + "Stun", + "Submit", + "Substitute", + "Succeed", + "Sue", + "Suffer", + "Suggest", + "Suit", + "Sum", + "Summarize", + "Supervise", + "Supplement", + "Supply", + "Support", + "Suppose", + "Suppress", + "Surge", + "Surprise", + "Surrender", + "Surround", + "Survey", + "Survive", + "Suspect", + "Suspend", + "Sustain", + "Swallow", + "Swear", + "Sweep", + "Swim", + "Swing", + "Switch", + "Tackle", + "Tag", + "Take", + "Talk", + "Tap", + "Target", + "Taste", + "Tax", + "Teach", + "Tear", + "Telephone", + "Tell", + "Tempt", + "Tend", + "Term", + "Terminate", + "Terrify", + "Test", + "Testify", + "Text", + "Thank", + "Think", + "Thrive", + "Throw", + "Tidy", + "Tie", + "Tighten", + "Time", + "Tip", + "Title", + "Tolerate", + "Top", + "Toss", + "Total", + "Touch", + "Tour", + "Trace", + "Track", + "Trade", + "Trail", + "Train", + "Transfer", + "Transform", + "Translate", + "Transmit", + "Transport", + "Trap", + "Travel", + "Treat", + "Trick", + "Trigger", + "Trip", + "Trouble", + "Trust", + "Try", + "Turn", + "Twist", + "Type", + "Undergo", + "Undermine", + "Understand", + "Undertake", + "Unfold", + "Unify", + "Unite", + "Unveil", + "Update", + "Upgrade", + "Uphold", + "Upset", + "Urge", + "Use", + "Utilize", + "Value", + "Vanish", + "Vary", + "Venture", + "Verify", + "View", + "Visit", + "Volunteer", + "Vote", + "Vow", + "Wait", + "Wake", + "Walk", + "Wander", + "Want", + "Warm", + "Warn", + "Warrant", + "Wash", + "Waste", + "Watch", + "Water", + "Wave", + "Weaken", + "Wear", + "Weave", + "Weigh", + "Welcome", + "Whip", + "Whisper", + "Widen", + "Win", + "Wind", + "Wipe", + "Wish", + "Withdraw", + "Witness", + "Wonder", + "Work", + "Worry", + "Worship", + "Wound", + "Wrap", + "Write", + "Yell", + "Yield" ] adverbs :: V.Vector T.Text adverbs = - [ "About" - , "Above" - , "Abroad" - , "Absently" - , "Absolutely" - , "Accidentally" - , "Accordingly" - , "Accurately" - , "Accusingly" - , "Across" - , "Actually" - , "Additionally" - , "Adequately" - , "Adorably" - , "After" - , "Afterwards" - , "Again" - , "Ago" - , "Ahead" - , "Alike" - , "All" - , "Allegedly" - , "AllTheTime" - , "Almost" - , "Alone" - , "Along" - , "Already" - , "Also" - , "Altogether" - , "Always" - , "Amazingly" - , "Angrily" - , "Annually" - , "Anxiously" - , "Any" - , "Anyway" - , "Anywhere" - , "Apart" - , "Appallingly" - , "Apparently" - , "Appropriately" - , "Approximately" - , "Arguably" - , "Around" - , "Articulately" - , "As" - , "Aside" - , "Astonishingly" - , "Automatically" - , "Away" - , "Back" - , "Backwards" - , "Badly" - , "Barely" - , "Basically" - , "Beautifully" - , "Before" - , "Behind" - , "Below" - , "Besides" - , "Best" - , "Better" - , "Between" - , "Beyond" - , "Blindly" - , "Bravely" - , "Briefly" - , "Brightly" - , "Briskly" - , "Broadly" - , "By" - , "Calmly" - , "Carefully" - , "Casually" - , "Cautiously" - , "Certainly" - , "Cheaply" - , "Clearly" - , "Cleverly" - , "Close" - , "Closely" - , "Commonly" - , "Completely" - , "Consequently" - , "Considerably" - , "Consistently" - , "Constantly" - , "Continually" - , "Correctly" - , "Crazily" - , "Critically" - , "Curiously" - , "Currently" - , "Cynically" - , "Daily" - , "Dangerously" - , "Deeply" - , "Definitely" - , "Deliberately" - , "Delicately" - , "Desperately" - , "Differently" - , "Directly" - , "Discreetly" - , "Double" - , "Down" - , "Downstairs" - , "Downtown" - , "Downwards" - , "Dramatically" - , "Each" - , "Eagerly" - , "Early" - , "Easily" - , "East" - , "Effectively" - , "Efficiently" - , "Either" - , "Else" - , "Elsewhere" - , "Emotionally" - , "Enough" - , "Entirely" - , "Equally" - , "Especially" - , "Essentially" - , "Euphoricly" - , "Even" - , "Evenly" - , "Eventually" - , "Ever" - , "Everywhere" - , "Exactly" - , "Exclusively" - , "Expectantly" - , "Explicitly" - , "Extensively" - , "Extra" - , "Extremely" - , "Fairly" - , "Far" - , "Fast" - , "Ferociously" - , "Fiercely" - , "Finally" - , "Finely" - , "Firmly" - , "First" - , "Firstly" - , "Flatly" - , "Forever" - , "Formerly" - , "Forth" - , "Fortunately" - , "Forward" - , "Frankly" - , "Free" - , "Freely" - , "Frequently" - , "Frighteningly" - , "FullTime" - , "Fully" - , "Fundamentally" - , "Further" - , "Furthermore" - , "Generally" - , "Gently" - , "Genuinely" - , "Gloriously" - , "Gradually" - , "Greatly" - , "Grimly" - , "Guiltily" - , "Half" - , "Halfway" - , "Happily" - , "Hard" - , "Hardly" - , "Hastily" - , "Heavily" - , "Hence" - , "Here" - , "Heroically" - , "High" - , "Highly" - , "Home" - , "Hopefully" - , "Hourly" - , "How" - , "However" - , "Humbly" - , "Hysterically" - , "Immediately" - , "Immensely" - , "Impartially" - , "Impolitely" - , "In" - , "Increasingly" - , "Incredibly" - , "Indeed" - , "Indifferently" - , "Indoors" - , "Inevitably" - , "Initially" - , "Inside" - , "Instantly" - , "Instead" - , "Intensely" - , "Ironically" - , "Jealously" - , "Jovially" - , "Just" - , "Kindly" - , "Largely" - , "Last" - , "Late" - , "Lately" - , "Later" - , "Lazily" - , "Least" - , "Left" - , "Less" - , "Lightly" - , "Likewise" - , "Literally" - , "Little" - , "Live" - , "Long" - , "LongTerm" - , "Lot" - , "Loud" - , "Loudly" - , "Lovingly" - , "Low" - , "Loyally" - , "Magnificently" - , "Mainly" - , "Maybe" - , "Meanwhile" - , "Merely" - , "Merrily" - , "Mightily" - , "Miserably" - , "More" - , "Moreover" - , "Most" - , "Mostly" - , "Much" - , "Mysteriously" - , "Namely" - , "Naturally" - , "Near" - , "Nearby" - , "Nearly" - , "Necessarily" - , "Neither" - , "Nervously" - , "Never" - , "Nevertheless" - , "Newly" - , "Next" - , "Nicely" - , "Nonetheless" - , "Nor" - , "Normally" - , "North" - , "Not" - , "NOT" - , "Notably" - , "Now" - , "Nowadays" - , "Nowhere" - , "Objectively" - , "Obnoxiously" - , "Obsessively" - , "Obviously" - , "Occasionally" - , "Off" - , "Often" - , "Ok" - , "On" - , "Once" - , "Online" - , "Only" - , "Openly" - , "Opposite" - , "Originally" - , "Otherwise" - , "Out" - , "Outdoors" - , "Outside" - , "Over" - , "Overall" - , "Overly" - , "Overnight" - , "Overseas" - , "Painfully" - , "Partially" - , "Particularly" - , "Partly" - , "Past" - , "Patiently" - , "Perfectly" - , "Perhaps" - , "Permanently" - , "Personally" - , "Playfully" - , "Politely" - , "Poorly" - , "Possibly" - , "Potentially" - , "Precisely" - , "Predominantly" - , "Presently" - , "Presumably" - , "Pretty" - , "Previously" - , "Primarily" - , "Probably" - , "Promptly" - , "Properly" - , "Purely" - , "Quickly" - , "Quietly" - , "Quite" - , "Randomly" - , "Rapidly" - , "Rarely" - , "Rather" - , "Readily" - , "Really" - , "Reasonably" - , "Recently" - , "Recklessly" - , "Regardless" - , "Regularly" - , "Relatively" - , "Remarkably" - , "Remorsefully" - , "Reportedly" - , "Respectively" - , "Responsibly" - , "Right" - , "Roughly" - , "Round" - , "Rudely" - , "Ruthlessly" - , "Sadly" - , "Same" - , "Scornfully" - , "Seamlessly" - , "Second" - , "Secondly" - , "Seemingly" - , "Seldom" - , "Selfishly" - , "Seriously" - , "Severely" - , "Shakily" - , "Sharply" - , "Shortly" - , "Sideways" - , "Significantly" - , "Silently" - , "Similarly" - , "Simply" - , "Simultaneously" - , "Since" - , "Sleepily" - , "Slightly" - , "Slowly" - , "Slyly" - , "Smoothly" - , "So" - , "Softly" - , "Solely" - , "Solemnly" - , "Somehow" - , "Sometime" - , "Sometimes" - , "Somewhat" - , "Somewhere" - , "Soon" - , "South" - , "Specifically" - , "Steadily" - , "Sternly" - , "Still" - , "Straight" - , "Strangely" - , "Strictly" - , "Strongly" - , "Stunningly" - , "Subsequently" - , "Substantially" - , "Successfully" - , "Suddenly" - , "Sufficiently" - , "Supposedly" - , "Sure" - , "Surely" - , "Temporarily" - , "Tenderly" - , "Terribly" - , "Thankfully" - , "That" - , "Then" - , "There" - , "Thereafter" - , "Thereby" - , "Therefore" - , "This" - , "Thoroughly" - , "Though" - , "Thoughtfully" - , "Through" - , "Throughout" - , "Thus" - , "Tightly" - , "Today" - , "Together" - , "Tomorrow" - , "Tonight" - , "Too" - , "Totally" - , "Truly" - , "Twice" - , "Typically" - , "Ultimately" - , "Under" - , "Underground" - , "Undoubtedly" - , "Uneasily" - , "Unfortunately" - , "Up" - , "Upstairs" - , "Upwards" - , "Usually" - , "Utterly" - , "Vanishingly" - , "Very" - , "Warmly" - , "Way" - , "Weakly" - , "Wearily" - , "Weekly" - , "Weirdly" - , "Well" - , "West" - , "Whatever" - , "Whatsoever" - , "When" - , "Where" - , "Whereby" - , "Wholly" - , "Why" - , "Wickedly" - , "Widely" - , "Wildly" - , "Wisely" - , "Wonderfully" - , "Worldwide" - , "Worse" - , "Worst" - , "Wrong" - , "Yearly" - , "Yesterday" - , "Yet" + [ "About", + "Above", + "Abroad", + "Absently", + "Absolutely", + "Accidentally", + "Accordingly", + "Accurately", + "Accusingly", + "Across", + "Actually", + "Additionally", + "Adequately", + "Adorably", + "After", + "Afterwards", + "Again", + "Ago", + "Ahead", + "Alike", + "All", + "Allegedly", + "AllTheTime", + "Almost", + "Alone", + "Along", + "Already", + "Also", + "Altogether", + "Always", + "Amazingly", + "Angrily", + "Annually", + "Anxiously", + "Any", + "Anyway", + "Anywhere", + "Apart", + "Appallingly", + "Apparently", + "Appropriately", + "Approximately", + "Arguably", + "Around", + "Articulately", + "As", + "Aside", + "Astonishingly", + "Automatically", + "Away", + "Back", + "Backwards", + "Badly", + "Barely", + "Basically", + "Beautifully", + "Before", + "Behind", + "Below", + "Besides", + "Best", + "Better", + "Between", + "Beyond", + "Blindly", + "Bravely", + "Briefly", + "Brightly", + "Briskly", + "Broadly", + "By", + "Calmly", + "Carefully", + "Casually", + "Cautiously", + "Certainly", + "Cheaply", + "Clearly", + "Cleverly", + "Close", + "Closely", + "Commonly", + "Completely", + "Consequently", + "Considerably", + "Consistently", + "Constantly", + "Continually", + "Correctly", + "Crazily", + "Critically", + "Curiously", + "Currently", + "Cynically", + "Daily", + "Dangerously", + "Deeply", + "Definitely", + "Deliberately", + "Delicately", + "Desperately", + "Differently", + "Directly", + "Discreetly", + "Double", + "Down", + "Downstairs", + "Downtown", + "Downwards", + "Dramatically", + "Each", + "Eagerly", + "Early", + "Easily", + "East", + "Effectively", + "Efficiently", + "Either", + "Else", + "Elsewhere", + "Emotionally", + "Enough", + "Entirely", + "Equally", + "Especially", + "Essentially", + "Euphoricly", + "Even", + "Evenly", + "Eventually", + "Ever", + "Everywhere", + "Exactly", + "Exclusively", + "Expectantly", + "Explicitly", + "Extensively", + "Extra", + "Extremely", + "Fairly", + "Far", + "Fast", + "Ferociously", + "Fiercely", + "Finally", + "Finely", + "Firmly", + "First", + "Firstly", + "Flatly", + "Forever", + "Formerly", + "Forth", + "Fortunately", + "Forward", + "Frankly", + "Free", + "Freely", + "Frequently", + "Frighteningly", + "FullTime", + "Fully", + "Fundamentally", + "Further", + "Furthermore", + "Generally", + "Gently", + "Genuinely", + "Gloriously", + "Gradually", + "Greatly", + "Grimly", + "Guiltily", + "Half", + "Halfway", + "Happily", + "Hard", + "Hardly", + "Hastily", + "Heavily", + "Hence", + "Here", + "Heroically", + "High", + "Highly", + "Home", + "Hopefully", + "Hourly", + "How", + "However", + "Humbly", + "Hysterically", + "Immediately", + "Immensely", + "Impartially", + "Impolitely", + "In", + "Increasingly", + "Incredibly", + "Indeed", + "Indifferently", + "Indoors", + "Inevitably", + "Initially", + "Inside", + "Instantly", + "Instead", + "Intensely", + "Ironically", + "Jealously", + "Jovially", + "Just", + "Kindly", + "Largely", + "Last", + "Late", + "Lately", + "Later", + "Lazily", + "Least", + "Left", + "Less", + "Lightly", + "Likewise", + "Literally", + "Little", + "Live", + "Long", + "LongTerm", + "Lot", + "Loud", + "Loudly", + "Lovingly", + "Low", + "Loyally", + "Magnificently", + "Mainly", + "Maybe", + "Meanwhile", + "Merely", + "Merrily", + "Mightily", + "Miserably", + "More", + "Moreover", + "Most", + "Mostly", + "Much", + "Mysteriously", + "Namely", + "Naturally", + "Near", + "Nearby", + "Nearly", + "Necessarily", + "Neither", + "Nervously", + "Never", + "Nevertheless", + "Newly", + "Next", + "Nicely", + "Nonetheless", + "Nor", + "Normally", + "North", + "Not", + "NOT", + "Notably", + "Now", + "Nowadays", + "Nowhere", + "Objectively", + "Obnoxiously", + "Obsessively", + "Obviously", + "Occasionally", + "Off", + "Often", + "Ok", + "On", + "Once", + "Online", + "Only", + "Openly", + "Opposite", + "Originally", + "Otherwise", + "Out", + "Outdoors", + "Outside", + "Over", + "Overall", + "Overly", + "Overnight", + "Overseas", + "Painfully", + "Partially", + "Particularly", + "Partly", + "Past", + "Patiently", + "Perfectly", + "Perhaps", + "Permanently", + "Personally", + "Playfully", + "Politely", + "Poorly", + "Possibly", + "Potentially", + "Precisely", + "Predominantly", + "Presently", + "Presumably", + "Pretty", + "Previously", + "Primarily", + "Probably", + "Promptly", + "Properly", + "Purely", + "Quickly", + "Quietly", + "Quite", + "Randomly", + "Rapidly", + "Rarely", + "Rather", + "Readily", + "Really", + "Reasonably", + "Recently", + "Recklessly", + "Regardless", + "Regularly", + "Relatively", + "Remarkably", + "Remorsefully", + "Reportedly", + "Respectively", + "Responsibly", + "Right", + "Roughly", + "Round", + "Rudely", + "Ruthlessly", + "Sadly", + "Same", + "Scornfully", + "Seamlessly", + "Second", + "Secondly", + "Seemingly", + "Seldom", + "Selfishly", + "Seriously", + "Severely", + "Shakily", + "Sharply", + "Shortly", + "Sideways", + "Significantly", + "Silently", + "Similarly", + "Simply", + "Simultaneously", + "Since", + "Sleepily", + "Slightly", + "Slowly", + "Slyly", + "Smoothly", + "So", + "Softly", + "Solely", + "Solemnly", + "Somehow", + "Sometime", + "Sometimes", + "Somewhat", + "Somewhere", + "Soon", + "South", + "Specifically", + "Steadily", + "Sternly", + "Still", + "Straight", + "Strangely", + "Strictly", + "Strongly", + "Stunningly", + "Subsequently", + "Substantially", + "Successfully", + "Suddenly", + "Sufficiently", + "Supposedly", + "Sure", + "Surely", + "Temporarily", + "Tenderly", + "Terribly", + "Thankfully", + "That", + "Then", + "There", + "Thereafter", + "Thereby", + "Therefore", + "This", + "Thoroughly", + "Though", + "Thoughtfully", + "Through", + "Throughout", + "Thus", + "Tightly", + "Today", + "Together", + "Tomorrow", + "Tonight", + "Too", + "Totally", + "Truly", + "Twice", + "Typically", + "Ultimately", + "Under", + "Underground", + "Undoubtedly", + "Uneasily", + "Unfortunately", + "Up", + "Upstairs", + "Upwards", + "Usually", + "Utterly", + "Vanishingly", + "Very", + "Warmly", + "Way", + "Weakly", + "Wearily", + "Weekly", + "Weirdly", + "Well", + "West", + "Whatever", + "Whatsoever", + "When", + "Where", + "Whereby", + "Wholly", + "Why", + "Wickedly", + "Widely", + "Wildly", + "Wisely", + "Wonderfully", + "Worldwide", + "Worse", + "Worst", + "Wrong", + "Yearly", + "Yesterday", + "Yet" ] adjectives :: V.Vector T.Text adjectives = - [ "Able" - , "Absent" - , "Absolute" - , "Abstract" - , "Absurd" - , "Academic" - , "Acceptable" - , "Accessible" - , "Accountable" - , "Accurate" - , "Acid" - , "Active" - , "Actual" - , "Acute" - , "Additional" - , "Adequate" - , "Adjacent" - , "Administrative" - , "Adult" - , "Advance" - , "Advanced" - , "Adverse" - , "Aesthetic" - , "Affordable" - , "Afraid" - , "Aged" - , "Agricultural" - , "Alert" - , "Alien" - , "Alike" - , "Alive" - , "Alone" - , "Alternative" - , "Amateur" - , "Amazed" - , "Amazing" - , "Ambitious" - , "Amusing" - , "Ancient" - , "Angry" - , "Annoyed" - , "Annoying" - , "Annual" - , "Anonymous" - , "Anxious" - , "Apparent" - , "Appealing" - , "Applicable" - , "Appropriate" - , "Arbitrary" - , "Architectural" - , "Artificial" - , "Artistic" - , "Ashamed" - , "Asleep" - , "Assistant" - , "Associated" - , "Astonishing" - , "Attractive" - , "Audio" - , "Authentic" - , "Automatic" - , "Available" - , "Average" - , "Aware" - , "Awful" - , "Awkward" - , "Back" - , "Bad" - , "Balanced" - , "Bare" - , "Based" - , "Basic" - , "Beautiful" - , "Beloved" - , "Beneficial" - , "Bent" - , "Best" - , "Better" - , "Big" - , "Biological" - , "Bitter" - , "Bizarre" - , "Blank" - , "Blind" - , "Blonde" - , "Blue" - , "Bold" - , "Bored" - , "Boring" - , "Bottom" - , "Bound" - , "Brave" - , "Brief" - , "Bright" - , "Brilliant" - , "Broad" - , "Broken" - , "Brown" - , "Busy" - , "Calm" - , "Capable" - , "Capital" - , "Capitalist" - , "Careful" - , "Careless" - , "Casual" - , "Cautious" - , "Central" - , "Certain" - , "Challenging" - , "Characteristic" - , "Charming" - , "Cheap" - , "Cheerful" - , "Chemical" - , "Chief" - , "Chronic" - , "Civic" - , "Civil" - , "Civilian" - , "Classic" - , "Classical" - , "Clean" - , "Clear" - , "Clever" - , "Clinical" - , "Close" - , "Closed" - , "Coastal" - , "Cognitive" - , "Cold" - , "Collective" - , "Colonial" - , "Coloured" - , "Colourful" - , "Comfortable" - , "Comic" - , "Commercial" - , "Common" - , "Communist" - , "Comparable" - , "Comparative" - , "Compelling" - , "Competent" - , "Competitive" - , "Complete" - , "Complex" - , "Complicated" - , "Comprehensive" - , "Compulsory" - , "Concerned" - , "Concrete" - , "Confident" - , "Confused" - , "Confusing" - , "Congressional" - , "Connected" - , "Conscious" - , "Consecutive" - , "Conservative" - , "Considerable" - , "Consistent" - , "Constant" - , "Constitutional" - , "Contemporary" - , "Content" - , "Continuous" - , "Contrary" - , "Controversial" - , "Convenient" - , "Conventional" - , "Convinced" - , "Convincing" - , "Cool" - , "Cooperative" - , "Core" - , "Corporate" - , "Correct" - , "Corresponding" - , "Costly" - , "Countless" - , "Covered" - , "Cream" - , "Creative" - , "Credible" - , "Critical" - , "Crowded" - , "Crucial" - , "Crude" - , "Cruel" - , "Cult" - , "Cultural" - , "Curious" - , "Curly" - , "Current" - , "Curved" - , "Cute" - , "Cynical" - , "Daily" - , "Dairy" - , "Damaging" - , "Dangerous" - , "Dark" - , "Dead" - , "Dear" - , "Decent" - , "Decisive" - , "Dedicated" - , "Deep" - , "Defensive" - , "Definite" - , "Deliberate" - , "Delicate" - , "Delicious" - , "Delighted" - , "Democratic" - , "Dense" - , "Dependent" - , "Depressed" - , "Depressing" - , "Desirable" - , "Desperate" - , "Destructive" - , "Detailed" - , "Determined" - , "Different" - , "Difficult" - , "Digital" - , "Diplomatic" - , "Direct" - , "Dirty" - , "Disabled" - , "Disappointed" - , "Disappointing" - , "Disastrous" - , "Dishonest" - , "Distant" - , "Distinct" - , "Distinctive" - , "Disturbing" - , "Diverse" - , "Divine" - , "Divorced" - , "Domestic" - , "Dominant" - , "Double" - , "Downstairs" - , "Downtown" - , "Dramatic" - , "Dressed" - , "Driving" - , "Dry" - , "Dual" - , "Due" - , "Dull" - , "Dumb" - , "Dynamic" - , "Eager" - , "Early" - , "East" - , "Eastern" - , "Easy" - , "Ecological" - , "Economic" - , "Editorial" - , "Educated" - , "Educational" - , "Effective" - , "Efficient" - , "Elaborate" - , "Elderly" - , "Electoral" - , "Electric" - , "Electrical" - , "Electronic" - , "Elegant" - , "Elementary" - , "Eligible" - , "Embarrassed" - , "Embarrassing" - , "Emotional" - , "Empirical" - , "Empty" - , "Encouraging" - , "Endless" - , "Engaged" - , "Engaging" - , "Enjoyable" - , "Enormous" - , "Entertaining" - , "Enthusiastic" - , "Entire" - , "Environmental" - , "Equal" - , "Equivalent" - , "Essential" - , "Eternal" - , "Ethical" - , "Ethnic" - , "Even" - , "Everyday" - , "Evident" - , "Evil" - , "Evolutionary" - , "Exact" - , "Excellent" - , "Exceptional" - , "Excess" - , "Excessive" - , "Excited" - , "Exciting" - , "Exclusive" - , "Executive" - , "Exotic" - , "Expected" - , "Expensive" - , "Experienced" - , "Experimental" - , "Expert" - , "Explicit" - , "Explosive" - , "Extensive" - , "External" - , "Extra" - , "Extraordinary" - , "Extreme" - , "Fabulous" - , "Failed" - , "Fair" - , "Fake" - , "False" - , "Familiar" - , "Family" - , "Famous" - , "Fancy" - , "Fantastic" - , "Far" - , "Fascinating" - , "Fashionable" - , "Fast" - , "Fat" - , "Fatal" - , "Favourable" - , "Favourite" - , "Federal" - , "Fellow" - , "Feminist" - , "Few" - , "Fierce" - , "Final" - , "Financial" - , "Fine" - , "Firm" - , "Fit" - , "Fixed" - , "Flat" - , "Flawed" - , "Flexible" - , "Flying" - , "Folding" - , "Folk" - , "Following" - , "Fond" - , "Foreign" - , "Formal" - , "Former" - , "Forthcoming" - , "Fortunate" - , "Forward" - , "Fragile" - , "Free" - , "Frequent" - , "Fresh" - , "Friendly" - , "Frightened" - , "Frightening" - , "Front" - , "Frozen" - , "Frustrated" - , "Frustrating" - , "Full" - , "FullTime" - , "Fun" - , "Functional" - , "Fundamental" - , "Funny" - , "Furious" - , "Further" - , "Future" - , "General" - , "Generic" - , "Generous" - , "Genetic" - , "Gentle" - , "Genuine" - , "Giant" - , "Glad" - , "Global" - , "Glorious" - , "Gold" - , "Golden" - , "Good" - , "Gorgeous" - , "Grand" - , "Graphic" - , "Grateful" - , "Grave" - , "Great" - , "Green" - , "Grey" - , "Gross" - , "Guilty" - , "Handy" - , "Happy" - , "Hard" - , "Harmful" - , "Harsh" - , "Healthy" - , "Heavy" - , "Helpful" - , "Hidden" - , "High" - , "HighProfile" - , "Hilarious" - , "Historic" - , "Historical" - , "Hollow" - , "Holy" - , "Home" - , "Homeless" - , "Honest" - , "Hopeful" - , "Horrible" - , "Hot" - , "Huge" - , "Human" - , "Humanitarian" - , "Humble" - , "Humorous" - , "Hungry" - , "Hurt" - , "Ideal" - , "Identical" - , "Ideological" - , "Ill" - , "Illegal" - , "Imaginary" - , "Immediate" - , "Immense" - , "Imminent" - , "Immune" - , "Impatient" - , "Important" - , "Impossible" - , "Impressed" - , "Impressive" - , "Inadequate" - , "Inappropriate" - , "Inclined" - , "Included" - , "Incorrect" - , "Incredible" - , "Independent" - , "Indigenous" - , "Indirect" - , "Individual" - , "Indoor" - , "Industrial" - , "Inevitable" - , "Infamous" - , "Influential" - , "Informal" - , "Inherent" - , "Initial" - , "Injured" - , "Inner" - , "Innocent" - , "Innovative" - , "Inside" - , "Instant" - , "Institutional" - , "Instrumental" - , "Insufficient" - , "Intact" - , "Integral" - , "Integrated" - , "Intellectual" - , "Intelligent" - , "Intended" - , "Intense" - , "Intensive" - , "Interactive" - , "Interested" - , "Interesting" - , "Interim" - , "Interior" - , "Intermediate" - , "Internal" - , "International" - , "Intimate" - , "Intriguing" - , "Invisible" - , "Involved" - , "Ironic" - , "Irrelevant" - , "Isolated" - , "Joint" - , "Judicial" - , "Junior" - , "Just" - , "Keen" - , "Key" - , "Kind" - , "Large" - , "LargeScale" - , "Late" - , "Later" - , "Latest" - , "Latter" - , "Lazy" - , "Leading" - , "Left" - , "Legal" - , "Legendary" - , "Legislative" - , "Legitimate" - , "Lengthy" - , "Lesser" - , "Level" - , "Liable" - , "Liberal" - , "Lifelong" - , "Light" - , "Likely" - , "Limited" - , "Linear" - , "Liquid" - , "Literary" - , "Little" - , "Live" - , "Lively" - , "Living" - , "Local" - , "Located" - , "Logical" - , "Lonely" - , "Long" - , "LongStanding" - , "LongTerm" - , "LongTime" - , "Loose" - , "Lost" - , "Loud" - , "Lovely" - , "Low" - , "Loyal" - , "Lucky" - , "Luxury" - , "Mad" - , "Magic" - , "Magical" - , "Magnetic" - , "Magnificent" - , "Main" - , "Mainstream" - , "Major" - , "Mandatory" - , "Marginal" - , "Marine" - , "Married" - , "Martial" - , "Mass" - , "Massive" - , "Matching" - , "Material" - , "Mathematical" - , "Mature" - , "Maximum" - , "Meaningful" - , "Mechanical" - , "Medical" - , "Medieval" - , "Medium" - , "Memorable" - , "Mental" - , "Mere" - , "Middle" - , "Mild" - , "Minimal" - , "Minimum" - , "Minute" - , "Miserable" - , "Misleading" - , "Missing" - , "Mixed" - , "Mobile" - , "Moderate" - , "Modern" - , "Modest" - , "Monthly" - , "Moral" - , "Motor" - , "Moving" - , "Multiple" - , "Municipal" - , "Musical" - , "Mutual" - , "Mysterious" - , "Narrative" - , "Narrow" - , "National" - , "Nationwide" - , "Native" - , "Natural" - , "Naval" - , "Near" - , "Nearby" - , "Neat" - , "Necessary" - , "Negative" - , "Neighbouring" - , "Nervous" - , "Net" - , "Neutral" - , "New" - , "Next" - , "Nice" - , "Noble" - , "Noisy" - , "NonProfit" - , "Normal" - , "North" - , "Northern" - , "Notable" - , "Notorious" - , "Novel" - , "Nuclear" - , "Numerous" - , "Objective" - , "Obvious" - , "Occasional" - , "Odd" - , "Offensive" - , "Official" - , "Ok" - , "Old" - , "OldFashioned" - , "Ongoing" - , "Online" - , "Only" - , "Open" - , "Operational" - , "Opposed" - , "Opposite" - , "Optical" - , "Optimistic" - , "Orange" - , "Ordinary" - , "Organic" - , "Organizational" - , "Organized" - , "Original" - , "Other" - , "Outdoor" - , "Outer" - , "Outside" - , "Outstanding" - , "Overall" - , "Overseas" - , "Overwhelming" - , "Own" - , "Painful" - , "Pale" - , "Parallel" - , "Parental" - , "Parliamentary" - , "PartTime" - , "Partial" - , "Particular" - , "Passionate" - , "Passive" - , "Past" - , "Patient" - , "Peaceful" - , "Peculiar" - , "Perfect" - , "Permanent" - , "Persistent" - , "Personal" - , "Philosophical" - , "Physical" - , "Pink" - , "Plain" - , "Plastic" - , "Pleasant" - , "Pleased" - , "Plus" - , "Pointed" - , "Poisonous" - , "Polite" - , "Political" - , "Poor" - , "Pop" - , "Popular" - , "Positive" - , "Possible" - , "PostWar" - , "Potential" - , "Powerful" - , "Practical" - , "Precious" - , "Precise" - , "Predictable" - , "Preliminary" - , "Premier" - , "Prepared" - , "Present" - , "Presidential" - , "Prestigious" - , "Pretty" - , "Previous" - , "Primary" - , "Prime" - , "Principal" - , "Prior" - , "Private" - , "Probable" - , "Problematic" - , "Productive" - , "Professional" - , "Profitable" - , "Profound" - , "Progressive" - , "Prominent" - , "Promising" - , "Pronounced" - , "Proper" - , "Prospective" - , "Protective" - , "Proud" - , "Provincial" - , "Psychiatric" - , "Psychological" - , "Public" - , "Pure" - , "Purple" - , "Qualified" - , "Quick" - , "Quiet" - , "Radical" - , "Random" - , "Rapid" - , "Rare" - , "Rational" - , "Raw" - , "Ready" - , "Real" - , "Realistic" - , "Rear" - , "Reasonable" - , "Recent" - , "Red" - , "Regional" - , "Regular" - , "Regulatory" - , "Related" - , "Relative" - , "Relaxed" - , "Relaxing" - , "Relevant" - , "Reliable" - , "Relieved" - , "Religious" - , "Reluctant" - , "Remarkable" - , "Remote" - , "Renowned" - , "Repeated" - , "Representative" - , "Resident" - , "Residential" - , "Respective" - , "Responsible" - , "Retired" - , "Reverse" - , "Revolutionary" - , "Rich" - , "Ridiculous" - , "Right" - , "Risky" - , "Rival" - , "Robust" - , "Romantic" - , "Rough" - , "Round" - , "Routine" - , "Royal" - , "Rubber" - , "Rude" - , "Rural" - , "Sacred" - , "Sad" - , "Safe" - , "Same" - , "Satisfied" - , "Scary" - , "Scattered" - , "Sceptical" - , "Scientific" - , "Secondary" - , "Secret" - , "Secular" - , "Secure" - , "Selective" - , "Senior" - , "Sensible" - , "Sensitive" - , "Separate" - , "Serial" - , "Serious" - , "Severe" - , "Shallow" - , "Shaped" - , "Sharp" - , "Sheer" - , "Shiny" - , "Shocked" - , "Shocking" - , "Short" - , "ShortTerm" - , "Shut" - , "Shy" - , "Significant" - , "Silent" - , "Silly" - , "Silver" - , "Similar" - , "Simple" - , "Sincere" - , "Single" - , "Situated" - , "Ski" - , "Skilled" - , "Slight" - , "Slow" - , "Small" - , "Smart" - , "Smooth" - , "SoCalled" - , "Social" - , "Socialist" - , "Soft" - , "Solar" - , "Sole" - , "Solid" - , "Solo" - , "Sophisticated" - , "Sound" - , "South" - , "Spare" - , "Special" - , "Specialist" - , "Specialized" - , "Specific" - , "Spectacular" - , "Spicy" - , "Spiritual" - , "Spoken" - , "Sporting" - , "Square" - , "Stable" - , "Standard" - , "Standing" - , "Stark" - , "State" - , "Statistical" - , "Steady" - , "Steep" - , "Sticky" - , "Stiff" - , "Still" - , "Straight" - , "Straightforward" - , "Strange" - , "Strategic" - , "Strict" - , "Striking" - , "Strong" - , "Structural" - , "Stunning" - , "Subject" - , "Subsequent" - , "Substantial" - , "Subtle" - , "Suburban" - , "Successful" - , "Successive" - , "Sudden" - , "Sufficient" - , "Suitable" - , "Super" - , "Superb" - , "Superior" - , "Supportive" - , "Supreme" - , "Sure" - , "Surgical" - , "Surprised" - , "Surprising" - , "Surrounding" - , "Suspicious" - , "Sustainable" - , "Sweet" - , "Symbolic" - , "Sympathetic" - , "Systematic" - , "Tactical" - , "Talented" - , "Tall" - , "Technical" - , "Technological" - , "Temporary" - , "Tender" - , "Terminal" - , "Terrible" - , "Terrific" - , "Theatrical" - , "Theoretical" - , "Thick" - , "Thin" - , "Thirsty" - , "Thorough" - , "ThoughtProvoking" - , "Thoughtful" - , "Thrilled" - , "Tidy" - , "Tight" - , "Timely" - , "Tiny" - , "Tired" - , "Top" - , "Total" - , "Tough" - , "Toxic" - , "Toy" - , "Traditional" - , "Transparent" - , "Tremendous" - , "Tribal" - , "Tropical" - , "True" - , "Twin" - , "Typical" - , "Ultimate" - , "Unable" - , "Unacceptable" - , "Uncomfortable" - , "Underground" - , "Underlying" - , "Unemployed" - , "Unexpected" - , "Unfair" - , "Unfortunate" - , "Unique" - , "United" - , "Universal" - , "Unknown" - , "Unlikely" - , "Unnecessary" - , "Unpleasant" - , "Unprecedented" - , "Unusual" - , "Upcoming" - , "Upper" - , "Upset" - , "Upstairs" - , "Urban" - , "Urgent" - , "Used" - , "Useful" - , "Useless" - , "Usual" - , "Vague" - , "Valid" - , "Valuable" - , "Variable" - , "Varied" - , "Various" - , "Vast" - , "Verbal" - , "Vertical" - , "Very" - , "Viable" - , "Vibrant" - , "Virtual" - , "Visible" - , "Visual" - , "Vital" - , "Vocal" - , "Voluntary" - , "Vulnerable" - , "Warm" - , "Waste" - , "Weak" - , "Wealthy" - , "Weekly" - , "Weird" - , "Welcome" - , "Well" - , "West" - , "Western" - , "Wet" - , "White" - , "Whole" - , "Wide" - , "Widespread" - , "Wild" - , "Willing" - , "Wise" - , "Wonderful" - , "Wooden" - , "Working" - , "Worldwide" - , "Worried" - , "Worse" - , "Worst" - , "Worth" - , "Worthwhile" - , "Worthy" - , "Written" - , "Wrong" - , "Yellow" + [ "Able", + "Absent", + "Absolute", + "Abstract", + "Absurd", + "Academic", + "Acceptable", + "Accessible", + "Accountable", + "Accurate", + "Acid", + "Active", + "Actual", + "Acute", + "Additional", + "Adequate", + "Adjacent", + "Administrative", + "Adult", + "Advance", + "Advanced", + "Adverse", + "Aesthetic", + "Affordable", + "Afraid", + "Aged", + "Agricultural", + "Alert", + "Alien", + "Alike", + "Alive", + "Alone", + "Alternative", + "Amateur", + "Amazed", + "Amazing", + "Ambitious", + "Amusing", + "Ancient", + "Angry", + "Annoyed", + "Annoying", + "Annual", + "Anonymous", + "Anxious", + "Apparent", + "Appealing", + "Applicable", + "Appropriate", + "Arbitrary", + "Architectural", + "Artificial", + "Artistic", + "Ashamed", + "Asleep", + "Assistant", + "Associated", + "Astonishing", + "Attractive", + "Audio", + "Authentic", + "Automatic", + "Available", + "Average", + "Aware", + "Awful", + "Awkward", + "Back", + "Bad", + "Balanced", + "Bare", + "Based", + "Basic", + "Beautiful", + "Beloved", + "Beneficial", + "Bent", + "Best", + "Better", + "Big", + "Biological", + "Bitter", + "Bizarre", + "Blank", + "Blind", + "Blonde", + "Blue", + "Bold", + "Bored", + "Boring", + "Bottom", + "Bound", + "Brave", + "Brief", + "Bright", + "Brilliant", + "Broad", + "Broken", + "Brown", + "Busy", + "Calm", + "Capable", + "Capital", + "Capitalist", + "Careful", + "Careless", + "Casual", + "Cautious", + "Central", + "Certain", + "Challenging", + "Characteristic", + "Charming", + "Cheap", + "Cheerful", + "Chemical", + "Chief", + "Chronic", + "Civic", + "Civil", + "Civilian", + "Classic", + "Classical", + "Clean", + "Clear", + "Clever", + "Clinical", + "Close", + "Closed", + "Coastal", + "Cognitive", + "Cold", + "Collective", + "Colonial", + "Coloured", + "Colourful", + "Comfortable", + "Comic", + "Commercial", + "Common", + "Communist", + "Comparable", + "Comparative", + "Compelling", + "Competent", + "Competitive", + "Complete", + "Complex", + "Complicated", + "Comprehensive", + "Compulsory", + "Concerned", + "Concrete", + "Confident", + "Confused", + "Confusing", + "Congressional", + "Connected", + "Conscious", + "Consecutive", + "Conservative", + "Considerable", + "Consistent", + "Constant", + "Constitutional", + "Contemporary", + "Content", + "Continuous", + "Contrary", + "Controversial", + "Convenient", + "Conventional", + "Convinced", + "Convincing", + "Cool", + "Cooperative", + "Core", + "Corporate", + "Correct", + "Corresponding", + "Costly", + "Countless", + "Covered", + "Cream", + "Creative", + "Credible", + "Critical", + "Crowded", + "Crucial", + "Crude", + "Cruel", + "Cult", + "Cultural", + "Curious", + "Curly", + "Current", + "Curved", + "Cute", + "Cynical", + "Daily", + "Dairy", + "Damaging", + "Dangerous", + "Dark", + "Dead", + "Dear", + "Decent", + "Decisive", + "Dedicated", + "Deep", + "Defensive", + "Definite", + "Deliberate", + "Delicate", + "Delicious", + "Delighted", + "Democratic", + "Dense", + "Dependent", + "Depressed", + "Depressing", + "Desirable", + "Desperate", + "Destructive", + "Detailed", + "Determined", + "Different", + "Difficult", + "Digital", + "Diplomatic", + "Direct", + "Dirty", + "Disabled", + "Disappointed", + "Disappointing", + "Disastrous", + "Dishonest", + "Distant", + "Distinct", + "Distinctive", + "Disturbing", + "Diverse", + "Divine", + "Divorced", + "Domestic", + "Dominant", + "Double", + "Downstairs", + "Downtown", + "Dramatic", + "Dressed", + "Driving", + "Dry", + "Dual", + "Due", + "Dull", + "Dumb", + "Dynamic", + "Eager", + "Early", + "East", + "Eastern", + "Easy", + "Ecological", + "Economic", + "Editorial", + "Educated", + "Educational", + "Effective", + "Efficient", + "Elaborate", + "Elderly", + "Electoral", + "Electric", + "Electrical", + "Electronic", + "Elegant", + "Elementary", + "Eligible", + "Embarrassed", + "Embarrassing", + "Emotional", + "Empirical", + "Empty", + "Encouraging", + "Endless", + "Engaged", + "Engaging", + "Enjoyable", + "Enormous", + "Entertaining", + "Enthusiastic", + "Entire", + "Environmental", + "Equal", + "Equivalent", + "Essential", + "Eternal", + "Ethical", + "Ethnic", + "Even", + "Everyday", + "Evident", + "Evil", + "Evolutionary", + "Exact", + "Excellent", + "Exceptional", + "Excess", + "Excessive", + "Excited", + "Exciting", + "Exclusive", + "Executive", + "Exotic", + "Expected", + "Expensive", + "Experienced", + "Experimental", + "Expert", + "Explicit", + "Explosive", + "Extensive", + "External", + "Extra", + "Extraordinary", + "Extreme", + "Fabulous", + "Failed", + "Fair", + "Fake", + "False", + "Familiar", + "Family", + "Famous", + "Fancy", + "Fantastic", + "Far", + "Fascinating", + "Fashionable", + "Fast", + "Fat", + "Fatal", + "Favourable", + "Favourite", + "Federal", + "Fellow", + "Feminist", + "Few", + "Fierce", + "Final", + "Financial", + "Fine", + "Firm", + "Fit", + "Fixed", + "Flat", + "Flawed", + "Flexible", + "Flying", + "Folding", + "Folk", + "Following", + "Fond", + "Foreign", + "Formal", + "Former", + "Forthcoming", + "Fortunate", + "Forward", + "Fragile", + "Free", + "Frequent", + "Fresh", + "Friendly", + "Frightened", + "Frightening", + "Front", + "Frozen", + "Frustrated", + "Frustrating", + "Full", + "FullTime", + "Fun", + "Functional", + "Fundamental", + "Funny", + "Furious", + "Further", + "Future", + "General", + "Generic", + "Generous", + "Genetic", + "Gentle", + "Genuine", + "Giant", + "Glad", + "Global", + "Glorious", + "Gold", + "Golden", + "Good", + "Gorgeous", + "Grand", + "Graphic", + "Grateful", + "Grave", + "Great", + "Green", + "Grey", + "Gross", + "Guilty", + "Handy", + "Happy", + "Hard", + "Harmful", + "Harsh", + "Healthy", + "Heavy", + "Helpful", + "Hidden", + "High", + "HighProfile", + "Hilarious", + "Historic", + "Historical", + "Hollow", + "Holy", + "Home", + "Homeless", + "Honest", + "Hopeful", + "Horrible", + "Hot", + "Huge", + "Human", + "Humanitarian", + "Humble", + "Humorous", + "Hungry", + "Hurt", + "Ideal", + "Identical", + "Ideological", + "Ill", + "Illegal", + "Imaginary", + "Immediate", + "Immense", + "Imminent", + "Immune", + "Impatient", + "Important", + "Impossible", + "Impressed", + "Impressive", + "Inadequate", + "Inappropriate", + "Inclined", + "Included", + "Incorrect", + "Incredible", + "Independent", + "Indigenous", + "Indirect", + "Individual", + "Indoor", + "Industrial", + "Inevitable", + "Infamous", + "Influential", + "Informal", + "Inherent", + "Initial", + "Injured", + "Inner", + "Innocent", + "Innovative", + "Inside", + "Instant", + "Institutional", + "Instrumental", + "Insufficient", + "Intact", + "Integral", + "Integrated", + "Intellectual", + "Intelligent", + "Intended", + "Intense", + "Intensive", + "Interactive", + "Interested", + "Interesting", + "Interim", + "Interior", + "Intermediate", + "Internal", + "International", + "Intimate", + "Intriguing", + "Invisible", + "Involved", + "Ironic", + "Irrelevant", + "Isolated", + "Joint", + "Judicial", + "Junior", + "Just", + "Keen", + "Key", + "Kind", + "Large", + "LargeScale", + "Late", + "Later", + "Latest", + "Latter", + "Lazy", + "Leading", + "Left", + "Legal", + "Legendary", + "Legislative", + "Legitimate", + "Lengthy", + "Lesser", + "Level", + "Liable", + "Liberal", + "Lifelong", + "Light", + "Likely", + "Limited", + "Linear", + "Liquid", + "Literary", + "Little", + "Live", + "Lively", + "Living", + "Local", + "Located", + "Logical", + "Lonely", + "Long", + "LongStanding", + "LongTerm", + "LongTime", + "Loose", + "Lost", + "Loud", + "Lovely", + "Low", + "Loyal", + "Lucky", + "Luxury", + "Mad", + "Magic", + "Magical", + "Magnetic", + "Magnificent", + "Main", + "Mainstream", + "Major", + "Mandatory", + "Marginal", + "Marine", + "Married", + "Martial", + "Mass", + "Massive", + "Matching", + "Material", + "Mathematical", + "Mature", + "Maximum", + "Meaningful", + "Mechanical", + "Medical", + "Medieval", + "Medium", + "Memorable", + "Mental", + "Mere", + "Middle", + "Mild", + "Minimal", + "Minimum", + "Minute", + "Miserable", + "Misleading", + "Missing", + "Mixed", + "Mobile", + "Moderate", + "Modern", + "Modest", + "Monthly", + "Moral", + "Motor", + "Moving", + "Multiple", + "Municipal", + "Musical", + "Mutual", + "Mysterious", + "Narrative", + "Narrow", + "National", + "Nationwide", + "Native", + "Natural", + "Naval", + "Near", + "Nearby", + "Neat", + "Necessary", + "Negative", + "Neighbouring", + "Nervous", + "Net", + "Neutral", + "New", + "Next", + "Nice", + "Noble", + "Noisy", + "NonProfit", + "Normal", + "North", + "Northern", + "Notable", + "Notorious", + "Novel", + "Nuclear", + "Numerous", + "Objective", + "Obvious", + "Occasional", + "Odd", + "Offensive", + "Official", + "Ok", + "Old", + "OldFashioned", + "Ongoing", + "Online", + "Only", + "Open", + "Operational", + "Opposed", + "Opposite", + "Optical", + "Optimistic", + "Orange", + "Ordinary", + "Organic", + "Organizational", + "Organized", + "Original", + "Other", + "Outdoor", + "Outer", + "Outside", + "Outstanding", + "Overall", + "Overseas", + "Overwhelming", + "Own", + "Painful", + "Pale", + "Parallel", + "Parental", + "Parliamentary", + "PartTime", + "Partial", + "Particular", + "Passionate", + "Passive", + "Past", + "Patient", + "Peaceful", + "Peculiar", + "Perfect", + "Permanent", + "Persistent", + "Personal", + "Philosophical", + "Physical", + "Pink", + "Plain", + "Plastic", + "Pleasant", + "Pleased", + "Plus", + "Pointed", + "Poisonous", + "Polite", + "Political", + "Poor", + "Pop", + "Popular", + "Positive", + "Possible", + "PostWar", + "Potential", + "Powerful", + "Practical", + "Precious", + "Precise", + "Predictable", + "Preliminary", + "Premier", + "Prepared", + "Present", + "Presidential", + "Prestigious", + "Pretty", + "Previous", + "Primary", + "Prime", + "Principal", + "Prior", + "Private", + "Probable", + "Problematic", + "Productive", + "Professional", + "Profitable", + "Profound", + "Progressive", + "Prominent", + "Promising", + "Pronounced", + "Proper", + "Prospective", + "Protective", + "Proud", + "Provincial", + "Psychiatric", + "Psychological", + "Public", + "Pure", + "Purple", + "Qualified", + "Quick", + "Quiet", + "Radical", + "Random", + "Rapid", + "Rare", + "Rational", + "Raw", + "Ready", + "Real", + "Realistic", + "Rear", + "Reasonable", + "Recent", + "Red", + "Regional", + "Regular", + "Regulatory", + "Related", + "Relative", + "Relaxed", + "Relaxing", + "Relevant", + "Reliable", + "Relieved", + "Religious", + "Reluctant", + "Remarkable", + "Remote", + "Renowned", + "Repeated", + "Representative", + "Resident", + "Residential", + "Respective", + "Responsible", + "Retired", + "Reverse", + "Revolutionary", + "Rich", + "Ridiculous", + "Right", + "Risky", + "Rival", + "Robust", + "Romantic", + "Rough", + "Round", + "Routine", + "Royal", + "Rubber", + "Rude", + "Rural", + "Sacred", + "Sad", + "Safe", + "Same", + "Satisfied", + "Scary", + "Scattered", + "Sceptical", + "Scientific", + "Secondary", + "Secret", + "Secular", + "Secure", + "Selective", + "Senior", + "Sensible", + "Sensitive", + "Separate", + "Serial", + "Serious", + "Severe", + "Shallow", + "Shaped", + "Sharp", + "Sheer", + "Shiny", + "Shocked", + "Shocking", + "Short", + "ShortTerm", + "Shut", + "Shy", + "Significant", + "Silent", + "Silly", + "Silver", + "Similar", + "Simple", + "Sincere", + "Single", + "Situated", + "Ski", + "Skilled", + "Slight", + "Slow", + "Small", + "Smart", + "Smooth", + "SoCalled", + "Social", + "Socialist", + "Soft", + "Solar", + "Sole", + "Solid", + "Solo", + "Sophisticated", + "Sound", + "South", + "Spare", + "Special", + "Specialist", + "Specialized", + "Specific", + "Spectacular", + "Spicy", + "Spiritual", + "Spoken", + "Sporting", + "Square", + "Stable", + "Standard", + "Standing", + "Stark", + "State", + "Statistical", + "Steady", + "Steep", + "Sticky", + "Stiff", + "Still", + "Straight", + "Straightforward", + "Strange", + "Strategic", + "Strict", + "Striking", + "Strong", + "Structural", + "Stunning", + "Subject", + "Subsequent", + "Substantial", + "Subtle", + "Suburban", + "Successful", + "Successive", + "Sudden", + "Sufficient", + "Suitable", + "Super", + "Superb", + "Superior", + "Supportive", + "Supreme", + "Sure", + "Surgical", + "Surprised", + "Surprising", + "Surrounding", + "Suspicious", + "Sustainable", + "Sweet", + "Symbolic", + "Sympathetic", + "Systematic", + "Tactical", + "Talented", + "Tall", + "Technical", + "Technological", + "Temporary", + "Tender", + "Terminal", + "Terrible", + "Terrific", + "Theatrical", + "Theoretical", + "Thick", + "Thin", + "Thirsty", + "Thorough", + "ThoughtProvoking", + "Thoughtful", + "Thrilled", + "Tidy", + "Tight", + "Timely", + "Tiny", + "Tired", + "Top", + "Total", + "Tough", + "Toxic", + "Toy", + "Traditional", + "Transparent", + "Tremendous", + "Tribal", + "Tropical", + "True", + "Twin", + "Typical", + "Ultimate", + "Unable", + "Unacceptable", + "Uncomfortable", + "Underground", + "Underlying", + "Unemployed", + "Unexpected", + "Unfair", + "Unfortunate", + "Unique", + "United", + "Universal", + "Unknown", + "Unlikely", + "Unnecessary", + "Unpleasant", + "Unprecedented", + "Unusual", + "Upcoming", + "Upper", + "Upset", + "Upstairs", + "Urban", + "Urgent", + "Used", + "Useful", + "Useless", + "Usual", + "Vague", + "Valid", + "Valuable", + "Variable", + "Varied", + "Various", + "Vast", + "Verbal", + "Vertical", + "Very", + "Viable", + "Vibrant", + "Virtual", + "Visible", + "Visual", + "Vital", + "Vocal", + "Voluntary", + "Vulnerable", + "Warm", + "Waste", + "Weak", + "Wealthy", + "Weekly", + "Weird", + "Welcome", + "Well", + "West", + "Western", + "Wet", + "White", + "Whole", + "Wide", + "Widespread", + "Wild", + "Willing", + "Wise", + "Wonderful", + "Wooden", + "Working", + "Worldwide", + "Worried", + "Worse", + "Worst", + "Worth", + "Worthwhile", + "Worthy", + "Written", + "Wrong", + "Yellow" ] diff --git a/src/CofreeBot/Bot/Behaviors/Magic8Ball.hs b/src/CofreeBot/Bot/Behaviors/Magic8Ball.hs index 2598c02..d688097 100644 --- a/src/CofreeBot/Bot/Behaviors/Magic8Ball.hs +++ b/src/CofreeBot/Bot/Behaviors/Magic8Ball.hs @@ -1,18 +1,19 @@ module CofreeBot.Bot.Behaviors.Magic8Ball - ( magic8BallBot - , simplifyMagic8BallBot - ) where + ( magic8BallBot, + simplifyMagic8BallBot, + ) +where -------------------------------------------------------------------------------- -import CofreeBot.Bot -import CofreeBot.Utils.ListT ( emptyListT ) -import Control.Monad.Reader -import Data.Attoparsec.Text -import Data.Bifunctor ( bimap ) -import Data.Profunctor -import qualified Data.Text as T -import System.Random +import CofreeBot.Bot +import CofreeBot.Utils.ListT (emptyListT) +import Control.Monad.Reader +import Data.Attoparsec.Text +import Data.Bifunctor (bimap) +import Data.Profunctor +import Data.Text qualified as T +import System.Random -------------------------------------------------------------------------------- @@ -20,38 +21,38 @@ magic8BallBot :: Bot IO () () Int magic8BallBot = do randomRIO (1, 20) -simplifyMagic8BallBot :: forall s . Bot IO s () Int -> TextBot IO s +simplifyMagic8BallBot :: forall s. Bot IO s () Int -> TextBot IO s simplifyMagic8BallBot b = do i <- ask case to i of - Left _err -> Bot $ pure $ const emptyListT - Right () -> dimap (const ()) from $ b - where - to :: T.Text -> Either T.Text () - to = fmap (bimap T.pack id) $ parseOnly parseMagic8BallCommand + Left _err -> Bot $ pure $ const emptyListT + Right () -> dimap (const ()) from $ b + where + to :: T.Text -> Either T.Text () + to = fmap (bimap T.pack id) $ parseOnly parseMagic8BallCommand - from :: Int -> T.Text - from i = case i `mod` 20 of - 1 -> "It is certain." - 2 -> "It is decidedly so." - 3 -> "Without a doubt." - 4 -> "Yes definitely." - 5 -> "You may rely on it." - 6 -> "As I see it, yes." - 7 -> "Most likely." - 8 -> "Outlook good." - 9 -> "Yes." - 10 -> "Signs point to yes." - 11 -> "Reply hazy, try again." - 12 -> "Ask again later." - 13 -> "Better not tell you now." - 14 -> "Cannot predict now." - 15 -> "Concentrate and ask again." - 16 -> "Don't count on it." - 17 -> "My reply is no." - 18 -> "My sources say no." - 19 -> "Outlook not so good." - _ -> "Very doubtful." + from :: Int -> T.Text + from i = case i `mod` 20 of + 1 -> "It is certain." + 2 -> "It is decidedly so." + 3 -> "Without a doubt." + 4 -> "Yes definitely." + 5 -> "You may rely on it." + 6 -> "As I see it, yes." + 7 -> "Most likely." + 8 -> "Outlook good." + 9 -> "Yes." + 10 -> "Signs point to yes." + 11 -> "Reply hazy, try again." + 12 -> "Ask again later." + 13 -> "Better not tell you now." + 14 -> "Cannot predict now." + 15 -> "Concentrate and ask again." + 16 -> "Don't count on it." + 17 -> "My reply is no." + 18 -> "My sources say no." + 19 -> "Outlook not so good." + _ -> "Very doubtful." parseMagic8BallCommand :: Parser () parseMagic8BallCommand = "8 ball" *> pure () diff --git a/src/CofreeBot/Bot/Behaviors/Updog.hs b/src/CofreeBot/Bot/Behaviors/Updog.hs index ffbe058..2b46659 100644 --- a/src/CofreeBot/Bot/Behaviors/Updog.hs +++ b/src/CofreeBot/Bot/Behaviors/Updog.hs @@ -1,18 +1,20 @@ module CofreeBot.Bot.Behaviors.Updog - ( updogSimpleBot - , updogMatrixBot - ) where + ( updogSimpleBot, + updogMatrixBot, + ) +where -------------------------------------------------------------------------------- -import CofreeBot.Bot -import CofreeBot.Utils.ListT ( toListT ) -import Control.Applicative ( empty - , liftA2 - ) -import Data.String -import Data.Text ( Text ) -import qualified Data.Text as T +import CofreeBot.Bot +import CofreeBot.Utils.ListT (toListT) +import Control.Applicative + ( empty, + liftA2, + ) +import Data.String +import Data.Text (Text) +import Data.Text qualified as T -------------------------------------------------------------------------------- @@ -33,14 +35,14 @@ instance Monoid Matcher where Matcher p ||| Matcher f = Matcher $ liftA2 (||) p f data Match = Match - { mMatch :: Matcher - , mResp :: Text + { mMatch :: Matcher, + mResp :: Text } runMatches :: [Match] -> Text -> [Text] runMatches ms = flip foldMap ms $ \m t -> case runMatcher (mMatch m) t of False -> empty - True -> [mResp m, "HAH GOTTEM"] + True -> [mResp m, "HAH GOTTEM"] what :: Matcher what = "what" ||| "What" ||| "WHAT" @@ -50,12 +52,11 @@ what = "what" ||| "What" ||| "WHAT" updogSimpleBot :: Applicative m => Bot m s Text Text updogSimpleBot = Bot $ \s i -> let matches = - [ Match (what <> "updog") "nothin much whats up with you dog" - , Match (what <> "snakesay") "Hissss, hisssss" - , Match (what <> "OPP") "yo, you know me!" + [ Match (what <> "updog") "nothin much whats up with you dog", + Match (what <> "snakesay") "Hissss, hisssss", + Match (what <> "OPP") "yo, you know me!" ] - in fmap (, s) $ toListT $ runMatches matches i + in fmap (,s) $ toListT $ runMatches matches i updogMatrixBot :: Monad m => MatrixBot m () updogMatrixBot = liftSimpleBot updogSimpleBot - diff --git a/src/CofreeBot/Bot/Context.hs b/src/CofreeBot/Bot/Context.hs index 42cb829..66622ba 100644 --- a/src/CofreeBot/Bot/Context.hs +++ b/src/CofreeBot/Bot/Context.hs @@ -1,37 +1,40 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + {-# HLINT ignore "Use <$>" #-} + -- | Context Transformations for bots module CofreeBot.Bot.Context ( -- * Room Awareness - RoomAware - , mkRoomAware - , + RoomAware, + mkRoomAware, + -- * User Awareness - UserAware - , mkUserAware - , + UserAware, + mkUserAware, + -- * Session - SessionState(..) - , SessionInput(..) - , SessionOutput(..) - , sessionize - , simplifySessionBot - ) where + SessionState (..), + SessionInput (..), + SessionOutput (..), + sessionize, + simplifySessionBot, + ) +where -------------------------------------------------------------------------------- -import CofreeBot.Bot -import CofreeBot.Utils.ListT ( emptyListT ) -import Control.Applicative -import qualified Control.Arrow as Arrow -import Data.Attoparsec.Text -import Data.Bifunctor ( Bifunctor(first) ) -import qualified Data.IntMap.Strict as IntMap -import Data.IntMap.Strict ( IntMap ) -import Data.Profunctor ( second' ) -import qualified Data.Text as T -import Network.Matrix.Client +import CofreeBot.Bot +import CofreeBot.Utils.ListT (emptyListT) +import Control.Applicative +import Control.Arrow qualified as Arrow +import Data.Attoparsec.Text +import Data.Bifunctor (Bifunctor (first)) +import Data.IntMap.Strict (IntMap) +import Data.IntMap.Strict qualified as IntMap +import Data.Profunctor (second') +import Data.Text qualified as T +import Network.Matrix.Client -------------------------------------------------------------------------------- @@ -60,16 +63,17 @@ mkUserAware = second' -------------------------------------------------------------------------------- -- | A map of states @s@ used to track sessions in a "sessionized" bot. -newtype SessionState s = SessionState { sessions :: IntMap s } +newtype SessionState s = SessionState {sessions :: IntMap s} deriving newtype (Show, Semigroup, Monoid) freshSessionKey :: IntMap a -> Int freshSessionKey state = case IntMap.lookupMax state of - Nothing -> 0 + Nothing -> 0 Just (k, _) -> k + 1 -- | Expand the input type @i@ to include session interaction meta commands. data SessionInput i = InteractWithSession Int i | StartSession | EndSession Int + -- | Expand the output type @o@ to include session interaction meta commands. data SessionOutput o = SessionOutput Int o | SessionStarted Int | SessionEnded Int | InvalidSession Int @@ -85,24 +89,26 @@ data SessionOutput o = SessionOutput Int o | SessionStarted Int | SessionEnded I -- and @i@ is an ordinary input for the non-sessionized 'Bot'. -- -- @end n@ - Terminate session @n@. -sessionize - :: Monad m - => s - -> Bot m s i o - -> Bot m (SessionState s) (SessionInput i) (SessionOutput o) +sessionize :: + Monad m => + s -> + Bot m s i o -> + Bot m (SessionState s) (SessionInput i) (SessionOutput o) sessionize defaultState (Bot bot) = Bot $ \(SessionState s) si -> case si of StartSession -> do let k = freshSessionKey s - pure - $ (,) (SessionStarted k) (SessionState $ IntMap.insert k defaultState s) + pure $ + (,) (SessionStarted k) (SessionState $ IntMap.insert k defaultState s) EndSession k -> do pure $ (,) (SessionEnded k) (SessionState $ IntMap.delete k s) InteractWithSession k i -> case IntMap.lookup k s of Nothing -> pure $ (,) (InvalidSession k) (SessionState s) Just s' -> do (responses, nextState) <- bot s' i - pure $ (,) (SessionOutput k responses) - (SessionState $ IntMap.insert k nextState s) + pure $ + (,) + (SessionOutput k responses) + (SessionState $ IntMap.insert k nextState s) data Nue = New | Use | End @@ -115,7 +121,7 @@ parseSessionInfo p = do _ <- space n <- decimal <* ": " i <- p - --endOfLine + -- endOfLine pure $ InteractWithSession n i End -> do _ <- space @@ -127,25 +133,25 @@ parseSessionInfo p = do -- Given a printer @o -> T.Text@ and a @Parser i@, convert the -- sessionized bot into a 'TextBot' which can then be further composed -- with other bots. -simplifySessionBot - :: forall m s i o - . (Show s, Monad m) - => (o -> T.Text) - -> Parser i - -> Bot m s (SessionInput i) (SessionOutput o) - -> TextBot m s +simplifySessionBot :: + forall m s i o. + (Show s, Monad m) => + (o -> T.Text) -> + Parser i -> + Bot m s (SessionInput i) (SessionOutput o) -> + TextBot m s simplifySessionBot tshow p (Bot bot) = Bot $ \s i -> do case to i of - Left _ -> emptyListT + Left _ -> emptyListT Right si -> fmap (Arrow.first from) $ bot s si - where - to :: T.Text -> Either T.Text (SessionInput i) - to = fmap (first T.pack) $ parseOnly $ parseSessionInfo p - - from :: SessionOutput o -> T.Text - from = \case - SessionOutput n o -> - "Session '" <> T.pack (show n) <> "' Output:\n" <> tshow o - SessionStarted n -> "Session Started: '" <> T.pack (show n) <> "'." - SessionEnded n -> "Session Ended: '" <> T.pack (show n) <> "'." - InvalidSession n -> "Invalid Session: '" <> T.pack (show n) <> "'." + where + to :: T.Text -> Either T.Text (SessionInput i) + to = fmap (first T.pack) $ parseOnly $ parseSessionInfo p + + from :: SessionOutput o -> T.Text + from = \case + SessionOutput n o -> + "Session '" <> T.pack (show n) <> "' Output:\n" <> tshow o + SessionStarted n -> "Session Started: '" <> T.pack (show n) <> "'." + SessionEnded n -> "Session Ended: '" <> T.pack (show n) <> "'." + InvalidSession n -> "Invalid Session: '" <> T.pack (show n) <> "'." diff --git a/src/CofreeBot/Utils.hs b/src/CofreeBot/Utils.hs index 7544d51..d24b907 100644 --- a/src/CofreeBot/Utils.hs +++ b/src/CofreeBot/Utils.hs @@ -1,64 +1,65 @@ +{-# LANGUAGE PatternSynonyms #-} + module CofreeBot.Utils ( -- * Product - type (/\) - , pattern (:&) - , (|*|) - , type (/+\) - , + type (/\), + pattern (:&), + (|*|), + type (/+\), + -- * Coproduct - type (\/) - , + type (\/), -- * Wedge Product - type (\*/) - , + type (\*/), + -- * MTL Helpers - Transformers - , duplicate - , indistinct - , + Transformers, + duplicate, + indistinct, + -- * Misc - distinguish - , PointedChoice(..) - ) where + distinguish, + PointedChoice (..), + ) +where ------------------------------------------------------------------------------- -import Control.Applicative -import Control.Arrow ( (&&&) ) -import Data.Kind -import Data.These ( These ) +import Control.Applicative +import Control.Arrow ((&&&)) +import Data.Kind +import Data.These (These) ------------------------------------------------------------------------------- type (/\) = (,) -infixr /\ +infixr 9 /\ pattern (:&) :: a -> b -> (a, b) pattern a :& b = (a, b) {-# COMPLETE (:&) #-} -infixr :& +infixr 9 :& (|*|) :: Applicative f => f a -> f b -> f (a /\ b) (|*|) = liftA2 (,) -infixr |*| - +infixr 9 |*| ------------------------------------------------------------------------------- type (\/) = Either -infixr \/ +infixr 9 \/ ------------------------------------------------------------------------------- type a \*/ b = Maybe (Either a b) -infixr \*/ +infixr 9 \*/ ------------------------------------------------------------------------------- -- These @@ -66,15 +67,16 @@ infixr \*/ type a /+\ b = These a b -infixr /+\ +infixr 9 /+\ ------------------------------------------------------------------------------- -type Transformers - :: [(Type -> Type) -> Type -> Type] - -> (Type -> Type) -> Type -> Type -type family Transformers ts m - where +type Transformers :: + [(Type -> Type) -> Type -> Type] -> + (Type -> Type) -> + Type -> + Type +type family Transformers ts m where Transformers '[] m = m Transformers (t ': ts) m = t (Transformers ts m) @@ -87,8 +89,9 @@ indistinct = id `either` id -------------------------------------------------------------------------------- distinguish :: (a -> Bool) -> a -> Either a a -distinguish f x | f x = Right x - | otherwise = Left x +distinguish f x + | f x = Right x + | otherwise = Left x class PointedChoice p where pleft :: p a b -> p (x \*/ a) (x \*/ b) diff --git a/src/CofreeBot/Utils/ListT.hs b/src/CofreeBot/Utils/ListT.hs index e9546e0..c5cf052 100644 --- a/src/CofreeBot/Utils/ListT.hs +++ b/src/CofreeBot/Utils/ListT.hs @@ -1,53 +1,50 @@ -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE UndecidableInstances #-} module CofreeBot.Utils.ListT ( -- * ListF - ListF(..) - , + ListF (..), -- * ListT - ListT(..) - , emptyListT - , consListT - , singletonListT - , joinListT - , toListT - , fromListT - , hoistListT - , interleaveListT - ) where - -import Control.Applicative -import Control.Monad.Except -import Data.Bifunctor ( Bifunctor(..) ) -import Data.Foldable -import Data.Functor ( (<&>) ) -import Data.These + ListT (..), + emptyListT, + consListT, + singletonListT, + joinListT, + toListT, + fromListT, + hoistListT, + interleaveListT, + ) +where + +import Control.Applicative +import Control.Monad.Except +import Data.Bifunctor (Bifunctor (..)) +import Data.Foldable +import Data.Functor ((<&>)) +import Data.These data ListF a r = NilF | ConsF a r deriving (Functor) -instance Bifunctor ListF - where +instance Bifunctor ListF where bimap f g = \case - NilF -> NilF + NilF -> NilF ConsF a r -> ConsF (f a) (g r) newtype ListT m a = ListT { runListT :: m (ListF a (ListT m a)) } -instance Functor m => Functor (ListT m) - where +instance Functor m => Functor (ListT m) where fmap f (ListT ma) = ListT $ fmap (bimap f (fmap f)) $ ma -instance Monad m => Applicative (ListT m) - where - pure = return +instance Monad m => Applicative (ListT m) where + pure = return (<*>) = ap instance Monad m => Alternative (ListT m) where @@ -56,39 +53,40 @@ instance Monad m => Alternative (ListT m) where x <- m y <- n pure $ case (x, y) of - (NilF , NilF ) -> NilF - (ConsF x' xs, NilF ) -> ConsF x' xs - (NilF , ConsF y' ys) -> ConsF y' ys + (NilF, NilF) -> NilF + (ConsF x' xs, NilF) -> ConsF x' xs + (NilF, ConsF y' ys) -> ConsF y' ys (ConsF x' xs, ConsF y' ys) -> ConsF x' (ListT $ pure $ ConsF y' (xs <|> ys)) -instance MonadTrans ListT - where +instance MonadTrans ListT where lift ma = ListT $ fmap (\a -> ConsF a (ListT $ pure NilF)) ma -instance MonadIO m => MonadIO (ListT m) - where +instance MonadIO m => MonadIO (ListT m) where liftIO io = ListT $ liftIO $ fmap (\a -> ConsF a (ListT $ pure NilF)) io instance MonadError e m => MonadError e (ListT m) where throwError = lift . throwError - --catchError m f = ListT $ runListT m `catchError` \e -> runListT (f e) + + -- catchError m f = ListT $ runListT m `catchError` \e -> runListT (f e) catchError m f = ListT . deepCatch . runListT $ m - where - deepCatch m' = fmap deepCatch' m' `catchError` \e -> runListT (f e) + where + deepCatch m' = fmap deepCatch' m' `catchError` \e -> runListT (f e) - deepCatch' = \case - NilF -> NilF - ConsF a r -> ConsF a (ListT $ deepCatch $ runListT r) + deepCatch' = \case + NilF -> NilF + ConsF a r -> ConsF a (ListT $ deepCatch $ runListT r) emptyListT :: Applicative m => ListT m a emptyListT = ListT $ pure NilF consListT :: Applicative m => a -> ListT m a -> ListT m a consListT a = \case - ListT ml -> ListT $ ml <&> \case - NilF -> ConsF a emptyListT - ConsF x xs -> ConsF a $ ListT $ pure $ ConsF x xs + ListT ml -> + ListT $ + ml <&> \case + NilF -> ConsF a emptyListT + ConsF x xs -> ConsF a $ ListT $ pure $ ConsF x xs singletonListT :: Applicative m => a -> ListT m a singletonListT a = consListT a emptyListT @@ -97,35 +95,35 @@ joinListT :: Monad m => ListT m (ListT m a) -> ListT m a joinListT (ListT ma) = ListT $ do fma <- ma case fma of - NilF -> return NilF + NilF -> return NilF ListT mxs `ConsF` xss -> do xs <- mxs case xs of - NilF -> runListT $ joinListT xss + NilF -> runListT $ joinListT xss x `ConsF` xs' -> runListT $ consListT x $ joinListT $ consListT xs' xss -instance Monad m => Monad (ListT m) - where +instance Monad m => Monad (ListT m) where return = ListT . return . (`ConsF` emptyListT) ma >>= amb = joinListT $ fmap amb ma toListT :: (Foldable t, Applicative m) => t a -> ListT m a toListT = foldr' consListT emptyListT -hoistListT :: Functor n => (forall x . m x -> n x) -> ListT m a -> ListT n a +hoistListT :: Functor n => (forall x. m x -> n x) -> ListT m a -> ListT n a hoistListT f = ListT . fmap (fmap (hoistListT f)) . f . runListT fromListT :: Monad m => ListT m a -> m [a] -fromListT (ListT m) = m >>= \case - NilF -> pure [] - ConsF a xs -> fmap (a :) $ fromListT xs +fromListT (ListT m) = + m >>= \case + NilF -> pure [] + ConsF a xs -> fmap (a :) $ fromListT xs interleaveListT :: Monad m => ListT m a -> ListT m b -> ListT m (These a b) interleaveListT (ListT m) (ListT n) = ListT $ do x <- m y <- n pure $ case (x, y) of - (NilF , NilF ) -> NilF - (ConsF x' xs, NilF ) -> ConsF (This x') (fmap This xs) - (NilF , ConsF y' ys) -> ConsF (That y') (fmap That ys) + (NilF, NilF) -> NilF + (ConsF x' xs, NilF) -> ConsF (This x') (fmap This xs) + (NilF, ConsF y' ys) -> ConsF (That y') (fmap That ys) (ConsF x' xs, ConsF y' ys) -> ConsF (These x' y') (interleaveListT xs ys) diff --git a/src/Parsing.hs b/src/Parsing.hs index f223513..4b7a7a4 100644 --- a/src/Parsing.hs +++ b/src/Parsing.hs @@ -1,5 +1,6 @@ module Parsing where -import Data.Void ( Void ) + +import Data.Void (Void) class Invariant f where invmap :: (b -> a) -> (a -> b) -> f a -> f b @@ -12,8 +13,8 @@ class Invariant f => Invariant' f where in1 :: f a -> (f a, f b) in2 :: f b -> (f a, f b) - lstrong1 - :: (a, f b) -> f (a, b) + lstrong1 :: + (a, f b) -> f (a, b) - lstrong2 - :: (a, f (a, b)) -> f b + lstrong2 :: + (a, f (a, b)) -> f b