diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,44 @@
+# `bm-haskell` Changelog
+
+This project follows the [Haskell package versioning policy][PVP], with
+versions in `A.B.C.D` format. `A` may be incremented arbitrarily for
+non-technical reasons, but [semantic versioning][SemVer] is otherwise
+followed, where `A.B` is the major version, `C` is the minor version, and `D`
+is the patch version. Initial development uses versions `0.0.0.D`, for which
+every version is considered breaking.
+
+[PVP]:
+[SemVer]:
+
+The format of this changelog is based on [Keep a Changelog][KaC], with the
+following conventions:
+
+* Level-two heading `Unreleased` is used to track changes that have not been
+ released.
+* Other level-two headings specify the release in `A.B.C.D (YYYY-MM-DD)`
+ format, with newer versions above older versions.
+* Level-three headings are used to categorize changes as follows:
+ 1. Breaking
+ 2. Non-Breaking
+* Changes are listed in arbitrary order and present tense.
+
+[KaC]:
+
+## 0.1.0.2 (2022-03-02)
+
+### Non-Breaking
+
+* Bump `text` dependency version upper bound
+* Bump `optparse-applicative` dependency version upper bound
+
+## 0.1.0.1 (2021-10-10)
+
+### Non-Breaking
+
+* Add dependency bounds
+
+## 0.1.0.0 (2021-07-02)
+
+### Breaking
+
+* Initial release
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+The MIT License
+
+Copyright (c) 2021-2022 Travis Cardwell
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,152 @@
+# bm
+
+[](https://www.repostatus.org/#active)
+[](https://github.com/ExtremaIS/bm-haskell/actions)
+[](https://hackage.haskell.org/package/bm)
+[](https://stackage.org/package/bm)
+[](https://stackage.org/nightly/package/bm)
+
+* [Overview](#overview)
+* [CLI](#cli)
+ * [Requirements](#requirements)
+ * [Installation](#installation)
+ * [`.deb` Package Installation](#deb-package-installation)
+ * [`.rpm` Package Installation](#rpm-package-installation)
+ * [Installation From Hackage](#installation-from-hackage)
+ * [Installation From Stackage](#installation-from-stackage)
+ * [Usage](#usage)
+ * [Examples](#examples)
+* [Project](#project)
+ * [Links](#links)
+ * [Tags](#tags)
+ * [Contribution](#contribution)
+ * [License](#license)
+
+## Overview
+
+`bm` is a utility for opening bookmarks and queries from the command line.
+The bookmarks and queries are configured hierarchically in YAML, and they are
+referenced using keyword prefixes. It allows you to quickly open bookmarks
+and perform search queries in your browser using only your keyboard.
+
+## CLI
+
+### Requirements
+
+`bm` is designed to work on any operating system, but it has only been tested
+on Linux.
+
+### Installation
+
+#### `.deb` Package Installation
+
+Check the [Releases][] page for `.deb` packages.
+
+[Releases]:
+
+#### `.rpm` Package Installation
+
+Check the [Releases][] page for `.rpm` packages.
+
+#### Installation From Hackage
+
+Install `bm` from [Hackage][] using [Cabal][] as follows:
+
+```
+$ cabal v2-install bm
+```
+
+[Hackage]:
+[Cabal]:
+
+#### Installation From Stackage
+
+Install `bm` from [Stackage][] using [Stack][] as follows:
+
+```
+$ stack install bm
+```
+
+[Stackage]:
+[Stack]:
+
+### Usage
+
+Bookmarks and search queries are configured using a hierarchy of keywords in a
+YAML configuration file. They are selected using keyword prefixes as
+command-line arguments. Command-line completion is available for Bash. See
+the [`bm` man page](doc/bm.1.md) for details.
+
+Note that the command used to open bookmarks and queries can be customized in
+the configuration file. Specifying the command for your specific browser can
+make links open considerably faster than with the default (generic) command.
+
+#### Examples
+
+An example configuration file is available in the `config` directory on
+GitHub (example for the latest release: [bm.yaml][]). The following are
+example commands using this configuration file.
+
+Open a bookmark link by specifying keywords. The Nix homepage can be opened
+with the following command:
+
+```
+$ bm nix
+```
+
+The `nixpkgs` manual can be opened using the following command:
+
+```
+$ bm nix pkgs manual
+```
+
+Keyword prefixes can also be used. The following command also opens the
+`nixpkgs` manual:
+
+```
+$ bm n p m
+```
+
+When more than one keyword has the same prefix, the first is selected. If a
+selected bookmark does not specify a URL, the first child is processed.
+
+The `/` keyword defines a bookmark with a URL as well as a query. When no
+query is specified, the URL is opened, allowing you to search with suggestions
+using the search field. Open a query by specifying keywords followed by the
+query.
+
+```
+$ bm / LinearTypes
+```
+
+When multiple query arguments are provided, they are joined with a space.
+
+[bm.yaml]:
+
+## Project
+
+### Links
+
+* Hackage:
+* Stackage:
+* GitHub:
+* GitHub Actions CI:
+
+### Tags
+
+All releases are tagged in the `main` branch. Release tags are signed using
+the
+[`security@extrema.is` GPG key](http://keys.gnupg.net/pks/lookup?op=vindex&fingerprint=on&search=0x1D484E4B4705FADF).
+
+### Contribution
+
+Issues and feature requests are tracked on GitHub:
+
+
+Issues may also be submitted via email to .
+
+### License
+
+This project is released under the
+[MIT License](https://opensource.org/licenses/MIT) as specified in the
+[`LICENSE`](LICENSE) file.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/app/LibOA.hs b/app/LibOA.hs
new file mode 100644
--- /dev/null
+++ b/app/LibOA.hs
@@ -0,0 +1,141 @@
+------------------------------------------------------------------------------
+-- |
+-- Module : LibOA
+-- Description : supplementary functions for optparse-applicative
+-- Copyright : Copyright (c) 2019-2022 Travis Cardwell
+-- License : MIT
+--
+-- This is a collection of functions that I often use with
+-- @optparse-applicative@. I do not feel that it is worth maintaining yet
+-- another helper package on Hackage, so I just copy the code to different
+-- projects as required. If the library grows to a substantial size or others
+-- with to use it, I will reconsider.
+--
+-- Revision: 2022-01-02
+------------------------------------------------------------------------------
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
+
+module LibOA
+ ( -- * Options
+ -- $Options
+ helper
+ , versioner
+ -- * Utilities
+ , commands
+ -- * Help
+ , (<||>)
+ , section
+ , table
+ , table_
+ , vspace
+ ) where
+
+-- https://hackage.haskell.org/package/ansi-wl-pprint
+import qualified Text.PrettyPrint.ANSI.Leijen as Doc
+import Text.PrettyPrint.ANSI.Leijen (Doc)
+
+-- https://hackage.haskell.org/package/base
+import Data.List (intersperse, transpose)
+import Data.Maybe (fromMaybe)
+#if !MIN_VERSION_base (4,11,0)
+import Data.Monoid ((<>))
+#endif
+
+-- https://hackage.haskell.org/package/optparse-applicative
+import qualified Options.Applicative as OA
+#if MIN_VERSION_optparse_applicative (0,16,0)
+import qualified Options.Applicative.Builder.Internal as OABI
+#endif
+import qualified Options.Applicative.Common as OAC
+import qualified Options.Applicative.Types as OAT
+
+------------------------------------------------------------------------------
+-- $Options
+--
+-- Option descriptions are not capitalized.
+
+-- | A hidden @-h@ / @--help@ option that always fails, showing the help
+--
+-- This is the same as 'OA.helper' except that it has a different help
+-- message.
+helper :: OA.Parser (a -> a)
+#if MIN_VERSION_optparse_applicative (0,16,0)
+helper = OA.option helpReader $ mconcat
+ [ OA.short 'h'
+ , OA.long "help"
+ , OA.value id
+ , OA.metavar ""
+ , OABI.noGlobal
+ , OA.noArgError (OA.ShowHelpText Nothing)
+ , OA.help "show this help text"
+ , OA.hidden
+ ]
+ where
+ helpReader = do
+ potentialCommand <- OAT.readerAsk
+ OA.readerAbort $ OA.ShowHelpText (Just potentialCommand)
+#else
+helper = OA.abortOption OA.ShowHelpText $ mconcat
+ [ OA.short 'h'
+ , OA.long "help"
+ , OA.help "show help and exit"
+ , OA.hidden
+ ]
+#endif
+
+-- | A hidden @--version@ option that always fails, showing the version
+versioner
+ :: String -- ^ version string
+ -> OA.Parser (a -> a)
+versioner verStr = OA.infoOption verStr $ mconcat
+ [ OA.long "version"
+ , OA.help "show version and exit"
+ , OA.hidden
+ ]
+
+------------------------------------------------------------------------------
+-- $Utilities
+
+-- | Get a list of commands for a parser
+commands :: OA.Parser a -> [String]
+commands =
+ let go _ opt = case OAT.optMain opt of
+ OAT.CmdReader _ cmds _ -> reverse cmds
+ _otherReader -> []
+ in concat . OAC.mapParser go
+
+------------------------------------------------------------------------------
+-- $Help
+
+-- | Insert a blank line between two documents
+(<||>) :: Doc -> Doc -> Doc
+d1 <||> d2 = d1 <> Doc.line <> Doc.line <> d2
+infixr 5 <||>
+
+-- | Create a section with a title and indented body
+section :: String -> Doc -> Doc
+section title = (Doc.text title Doc.<$$>) . Doc.indent 2
+
+-- | Create a table, with formatting
+table :: Int -> [[(String, Doc -> Doc)]] -> Doc
+table sep rows = Doc.vcat $
+ map (fromMaybe Doc.empty . foldr go Nothing . zip lengths) rows
+ where
+ lengths :: [Int]
+ lengths = map ((+) sep . maximum . map (length . fst)) $ transpose rows
+
+ go :: (Int, (String, Doc -> Doc)) -> Maybe Doc -> Maybe Doc
+ go (len, (s, f)) = Just . \case
+ Just doc -> Doc.fill len (f $ Doc.string s) <> doc
+ Nothing -> f $ Doc.string s
+
+-- | Create a table, without formatting
+table_ :: Int -> [[String]] -> Doc
+table_ sep = table sep . (map . map) (, id)
+
+-- | Vertically space documents with blank lines between them
+vspace :: [Doc] -> Doc
+vspace = mconcat . intersperse (Doc.line <> Doc.line)
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,301 @@
+------------------------------------------------------------------------------
+-- |
+-- Module : Main
+-- Description : bm: open bookmarks and queries from the command line
+-- Copyright : Copyright (c) 2021-2022 Travis Cardwell
+-- License : MIT
+--
+-- See the README for details.
+------------------------------------------------------------------------------
+
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Main (main) where
+
+-- https://hackage.haskell.org/package/base
+import Control.Applicative (optional, some)
+import Control.Monad (forM, unless, when)
+import Data.List (find, isInfixOf, isPrefixOf, sort, uncons)
+import Data.Maybe (catMaybes)
+import System.Environment (getArgs)
+import System.Exit (ExitCode(ExitFailure), exitSuccess, exitWith)
+import System.IO (hPutStrLn, stderr)
+import Text.Read (readMaybe)
+
+-- https://hackage.haskell.org/package/directory
+import qualified System.Directory as Dir
+
+-- https://hackage.haskell.org/package/filepath
+import qualified System.FilePath as FP
+import System.FilePath (())
+
+-- https://hackage.haskell.org/package/optparse-applicative
+import qualified Options.Applicative as OA
+import qualified Options.Applicative.Types as OAT
+
+-- https://hackage.haskell.org/package/typed-process
+import qualified System.Process.Typed as TP
+
+-- https://hackage.haskell.org/package/yaml
+import qualified Data.Yaml as Yaml
+
+-- (bm)
+import qualified BM
+
+-- (bm:executable)
+import qualified LibOA
+
+------------------------------------------------------------------------------
+-- $Options
+
+data Options
+ = Options
+ { configOpt :: !(Maybe FilePath)
+ , traceOpt :: !Bool
+ , args :: ![String]
+ }
+ deriving Show
+
+configOption :: OA.Parser FilePath
+configOption = OA.strOption $ mconcat
+ [ OA.long "config"
+ , OA.short 'c'
+ , OA.metavar "CONFIG"
+ , OA.help "config file (default: $XDG_CONFIG_HOME/bm.yaml)"
+ ]
+
+traceOption :: OA.Parser Bool
+traceOption = OA.switch $ mconcat
+ [ OA.long "trace"
+ , OA.short 't'
+ , OA.help "show trace output for debugging"
+ ]
+
+arguments :: OA.Parser [String]
+arguments = some . OA.strArgument $ mconcat
+ [ OA.metavar "ARG [ARG ...]"
+ , OA.help "arguments"
+ ]
+
+options :: OA.Parser Options
+options = Options
+ <$> optional configOption
+ <*> traceOption
+ <*> arguments
+
+------------------------------------------------------------------------------
+-- $Completion
+
+data CompletionOption
+ = CompleteDefault
+ | CompleteNoSpace
+
+instance Show CompletionOption where
+ show = \case
+ CompleteDefault -> "DEFAULT"
+ CompleteNoSpace -> "NOSPACE"
+
+handleCompletion :: [String] -> IO (Either OA.ParseError [String])
+handleCompletion args = case find isOAOption optArgs of
+ Just arg ->
+ return . Left $ OA.UnexpectedError arg (OAT.SomeParser options)
+ Nothing
+ | "--complete" `elem` optArgs -> handleComplete args
+ | "--complete-bash" `elem` optArgs -> handleCompleteBash args
+ | otherwise -> return $ Right args
+ where
+ optArgs :: [String]
+ optArgs = takeWhile (/= "--") args
+
+ isOAOption :: String -> Bool
+ isOAOption =
+ (&&) <$> ("--" `isPrefixOf`) <*> ("completion" `isInfixOf`)
+
+handleComplete :: [String] -> IO a
+handleComplete = \case
+ "--complete" : idxArg : args -> do
+ idx <- case readMaybe idxArg of
+ Just n | n > 0 -> return n
+ _invalidIdx -> errorExit $ "invalid index: " ++ idxArg
+ goOpts Nothing [] (idx - 1) (drop 1 args)
+ _invalidArgs -> do
+ mapM_ (hPutStrLn stderr)
+ [ "Usage: bm --complete INDEX [ARG ...]"
+ , " get completion options"
+ , ""
+ , "Use one of the following commands to enable bm completion:"
+ , " * bm --complete-bash"
+ ]
+ exitWith $ ExitFailure 2
+ where
+ longOpts, shortOpts :: [String]
+ longOpts = ["--help", "--version", "--config", "--trace"]
+ shortOpts = ["-h", "-c", "-t"]
+
+ goOpts :: Maybe FilePath -> [String] -> Int -> [String] -> IO a
+ goOpts mConfigPath bmArgsAcc 0 (arg:_args) = do
+ when (arg `elem` ["-", "--"]) $ reply longOpts
+ when (arg `elem` shortOpts) $ reply [arg]
+ case find (isPrefixOf arg) longOpts of
+ Just longOpt -> reply [longOpt]
+ Nothing -> return ()
+ when ("-" `isPrefixOf` arg) $ reply []
+ goBM mConfigPath $ reverse (arg : bmArgsAcc)
+ goOpts mConfigPath bmArgsAcc 0 [] =
+ goBM mConfigPath $ reverse ("" : bmArgsAcc)
+ goOpts mConfigPath bmArgsAcc idx (arg:args)
+ | arg == "--" = goArgs mConfigPath bmArgsAcc (idx - 1) args
+ | arg `elem` ["-c", "--config"] = case uncons args of
+ Just (configPath, args')
+ | idx == 1 -> goConfig =<< expandHomeDirectory configPath
+ | otherwise -> goOpts (Just configPath) bmArgsAcc (idx -2) args'
+ Nothing -> goConfig "./"
+ | "-" `isPrefixOf` arg = goOpts mConfigPath bmArgsAcc (idx -1) args
+ | otherwise = goOpts mConfigPath (arg : bmArgsAcc) (idx - 1) args
+ goOpts _mConfigPath _bmArgsAcc _idx [] = reply []
+
+ goArgs :: Maybe FilePath -> [String] -> Int -> [String] -> IO a
+ goArgs mConfigPath bmArgsAcc 0 (arg:_args) =
+ goBM mConfigPath $ reverse (arg : bmArgsAcc)
+ goArgs mConfigPath bmArgsAcc 0 [] =
+ goBM mConfigPath $ reverse ("" : bmArgsAcc)
+ goArgs mConfigPath bmArgsAcc idx (arg:args) =
+ goArgs mConfigPath (arg : bmArgsAcc) (idx - 1) args
+ goArgs _mConfigPath _bmArgsAcc _idx [] = reply []
+
+ expandHomeDirectory :: FilePath -> IO FilePath
+ expandHomeDirectory arg = case uncons (FP.splitPath arg) of
+ Just (part, parts)
+ | part `elem` ["~", "~/"] -> do
+ homeDir <- Dir.getHomeDirectory
+ return . FP.joinPath $ homeDir : parts
+ _otherwise -> return arg
+
+ goConfig :: FilePath -> IO a
+ goConfig arg = do
+ isDir <- Dir.doesDirectoryExist arg
+ when isDir $
+ goConfigDir . map (arg ) . sort =<< Dir.listDirectory arg
+ when (FP.hasTrailingPathSeparator arg) $ reply []
+ isFile <- Dir.doesFileExist arg
+ when isFile $ reply [arg | ".yaml" `FP.isExtensionOf` arg]
+ let (dir, partial) = FP.splitFileName arg
+ isDirDir <- Dir.doesDirectoryExist dir
+ unless isDirDir $ reply []
+ goConfigDir . map (dir ) . sort . filter (isPrefixOf partial)
+ =<< Dir.listDirectory dir
+
+ goConfigDir :: [FilePath] -> IO a
+ goConfigDir paths = do
+ dirOrFiles <- fmap catMaybes . forM paths $ \path -> do
+ isDir <- Dir.doesDirectoryExist path
+ return $ if isDir
+ then Just . Left $ FP.addTrailingPathSeparator path
+ else if ".yaml" `FP.isExtensionOf` path
+ then Just $ Right path
+ else Nothing
+ case dirOrFiles of
+ [Right path] -> reply [path]
+ _otherwise -> do
+ print CompleteNoSpace
+ mapM_ (putStrLn . either id id) dirOrFiles
+ exitSuccess
+
+ goBM :: Maybe FilePath -> [String] -> IO a
+ goBM mConfigPath args = do
+ print CompleteDefault
+ configPath <- case mConfigPath of
+ Just path -> pure path
+ Nothing -> Dir.getXdgDirectory Dir.XdgConfig "bm.yaml"
+ exists <- Dir.doesFileExist configPath
+ when exists $ do
+ eec <- Yaml.decodeFileEither configPath
+ case eec of
+ Right config -> mapM_ putStrLn $ BM.getCompletion config args
+ Left{} -> return ()
+ exitSuccess
+
+ reply :: [String] -> IO a
+ reply choices = do
+ print CompleteDefault
+ mapM_ putStrLn choices
+ exitSuccess
+
+handleCompleteBash :: [String] -> IO a
+handleCompleteBash = \case
+ ["--complete-bash", path] | not ("-" `isPrefixOf` path) -> do
+ mapM_ putStrLn
+ [ "_bm() {"
+ , "mapfile -t COMPREPLY < <(\"" ++ path ++
+ "\" --complete ${COMP_CWORD} ${COMP_WORDS[@]})"
+ , "test \"${COMPREPLY[0]}\" != \"" ++ show CompleteNoSpace ++
+ "\" || compopt -o nospace"
+ , "unset \"COMPREPLY[0]\""
+ , "}"
+ , ""
+ , "complete -F _bm bm"
+ ]
+ exitSuccess
+ _invalidArgs -> do
+ mapM_ (hPutStrLn stderr)
+ [ "Usage: bm --complete-bash PATH"
+ , " print a Bash script to enable bm completion"
+ , ""
+ , "Example usage:"
+ , ""
+ , " $ source <(bm --complete-bash `which bm`)"
+ ]
+ exitWith $ ExitFailure 2
+
+parseArgs :: IO Options
+parseArgs = do
+ eeas <- handleCompletion =<< getArgs
+ OA.handleParseResult $ case eeas of
+ Right args -> OA.execParserPure OA.defaultPrefs pinfo args
+ Left parseError ->
+ OA.Failure $ OA.parserFailure OA.defaultPrefs pinfo parseError mempty
+ where
+ pinfo :: OA.ParserInfo Options
+ pinfo
+ = OA.info (LibOA.helper <*> LibOA.versioner BM.version <*> options)
+ $ mconcat
+ [ OA.fullDesc
+ , OA.progDesc "open bookmarks and queries from the command line"
+ , OA.failureCode 2
+ ]
+
+------------------------------------------------------------------------------
+-- $Main
+
+errorExit :: String -> IO a
+errorExit message = do
+ hPutStrLn stderr $ "error: " ++ message
+ exitWith $ ExitFailure 1
+
+runProc :: BM.Proc -> IO ()
+runProc proc
+ = TP.runProcess_
+ . TP.setStdin TP.nullStream
+ . TP.setStdout TP.nullStream
+ . TP.setStderr TP.nullStream
+ $ TP.proc (BM.command proc) (BM.arguments proc)
+
+main :: IO ()
+main = do
+ Options{..} <- parseArgs
+ configPath <- case configOpt of
+ Just path -> pure path
+ Nothing -> Dir.getXdgDirectory Dir.XdgConfig "bm.yaml"
+ exists <- Dir.doesFileExist configPath
+ unless exists . errorExit $ "configuration file not found: " ++ configPath
+ eec <- Yaml.decodeFileEither configPath
+ case eec of
+ Right config -> do
+ let (eep, traceLines) = BM.run config args
+ when traceOpt $ mapM_ (hPutStrLn stderr) traceLines
+ either errorExit runProc eep
+ Left parseException -> do
+ hPutStrLn stderr $ "error parsing config file: " ++ configPath
+ hPutStrLn stderr $ Yaml.prettyPrintParseException parseException
+ exitWith $ ExitFailure 1
diff --git a/bm.cabal b/bm.cabal
new file mode 100644
--- /dev/null
+++ b/bm.cabal
@@ -0,0 +1,92 @@
+name: bm
+version: 0.1.0.2
+category: Utils
+synopsis: open bookmarks and queries from the command line
+description:
+ This package provides a command-line utility that opens bookmarks and
+ queries. Please see the README on GitHub at
+ .
+
+homepage: https://github.com/ExtremaIS/bm-haskell#readme
+bug-reports: https://github.com/ExtremaIS/bm-haskell/issues
+author: Travis Cardwell
+maintainer: Travis Cardwell
+copyright: Copyright (c) 2021-2022 Travis Cardwell
+license: MIT
+license-file: LICENSE
+
+cabal-version: 1.24
+build-type: Simple
+tested-with:
+ GHC ==8.6.5
+ || ==8.8.4
+ || ==8.10.7
+ || ==9.0.2
+ || ==9.2.1
+
+extra-source-files:
+ CHANGELOG.md
+ README.md
+
+source-repository head
+ type: git
+ location: https://github.com/ExtremaIS/bm-haskell.git
+
+flag write-hie
+ description: write .hie files
+ default: False
+
+library
+ hs-source-dirs: src
+ exposed-modules:
+ BM
+ other-modules:
+ Paths_bm
+ build-depends:
+ aeson >=1.4 && < 2.1
+ , base >=4.7 && <5
+ , dlist >=0.8 && <1.1
+ , network-uri >=2.6 && <2.7
+ , scientific >=0.3 && <0.4
+ , text >=1.2.3 && <2.1
+ , transformers >=0.5.6 && <0.6
+ , vector >=0.12 && <0.13
+ default-language: Haskell2010
+ default-extensions:
+ OverloadedStrings
+ if flag(write-hie)
+ ghc-options: -Wall -fwrite-ide-info -hiedir=.hie
+ else
+ ghc-options: -Wall
+
+executable bm
+ hs-source-dirs: app
+ main-is: Main.hs
+ other-modules:
+ LibOA
+ build-depends:
+ ansi-wl-pprint >=0.6 && <0.7
+ , base
+ , bm
+ , directory >=1.3 && <1.4
+ , filepath >=1.4 && <1.5
+ , optparse-applicative >=0.14 && <0.18
+ , typed-process >=0.2.6 && <0.3
+ , yaml >=0.11 && <0.12
+ default-language: Haskell2010
+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+
+test-suite bm-test
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Spec.hs
+ other-modules:
+ BM.Test
+ build-depends:
+ base
+ , bm
+ , tasty >=1.0 && <1.5
+ , tasty-hunit >=0.10 && <0.11
+ , vector
+ default-language: Haskell2010
+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
diff --git a/src/BM.hs b/src/BM.hs
new file mode 100644
--- /dev/null
+++ b/src/BM.hs
@@ -0,0 +1,396 @@
+------------------------------------------------------------------------------
+-- |
+-- Module : BM
+-- Description : API
+-- Copyright : Copyright (c) 2021-2022 Travis Cardwell
+-- License : MIT
+------------------------------------------------------------------------------
+
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
+
+module BM
+ ( -- * Constants
+ version
+ -- * Types
+ , Argument
+ , Command
+ , Error
+ , Keyword
+ , ParameterName
+ , ParameterValue
+ , Trace
+ , Url
+ , Config(..)
+ , Bookmark(..)
+ , Query(..)
+ , Parameter(..)
+ , Proc(..)
+ -- * API
+ , run
+ , getCompletion
+ ) where
+
+-- https://hackage.haskell.org/package/aeson
+import qualified Data.Aeson as A
+import Data.Aeson (FromJSON, (.:), (.:?), (.!=))
+import qualified Data.Aeson.Types as AT
+
+-- https://hackage.haskell.org/package/base
+import Data.List (intercalate, isPrefixOf)
+import Data.Maybe (fromMaybe)
+import Data.Version (showVersion)
+import qualified System.Info
+
+-- https://hackage.haskell.org/package/dlist
+import qualified Data.DList as DList
+import Data.DList (DList)
+
+-- https://hackage.haskell.org/package/network-uri
+import qualified Network.URI as URI
+
+-- https://hackage.haskell.org/package/scientific
+import qualified Data.Scientific as Sci
+
+-- https://hackage.haskell.org/package/text
+import qualified Data.Text as T
+
+-- https://hackage.haskell.org/package/transformers
+import Control.Monad.Trans.Writer (Writer, runWriter, tell)
+
+-- https://hackage.haskell.org/package/vector
+import qualified Data.Vector as V
+import Data.Vector (Vector)
+
+-- (bm:cabal)
+import qualified Paths_bm as Project
+
+------------------------------------------------------------------------------
+-- $Constants
+
+-- | bm version string (\"@bm-haskell X.X.X.X@\")
+--
+-- @since 0.1.0.0
+version :: String
+version = "bm-haskell " ++ showVersion Project.version
+
+------------------------------------------------------------------------------
+
+-- | Default command, depending on the OS
+defaultCommand :: Command
+defaultCommand = case System.Info.os of
+ "mingw32" -> "start"
+ "darwin" -> "open"
+ _other -> "xdg-open"
+
+-- | Default query parameter name
+defaultParameter :: ParameterName
+defaultParameter = "q"
+
+------------------------------------------------------------------------------
+-- $Types
+--
+-- This implementation makes heavy use of the 'String' type. Type aliases are
+-- provided to make the API easier to read.
+
+-- | CLI argument or process argument
+--
+-- @since 0.1.0.0
+type Argument = String
+
+-- | Process command
+--
+-- This command is executed with a single URL argument to open a
+-- bookmark/query.
+--
+-- @since 0.1.0.0
+type Command = FilePath
+
+-- | Error message
+--
+-- @since 0.1.0.0
+type Error = String
+
+-- | Bookmark keyword
+--
+-- The configuration file defines a hierarchy of keywords that are matched
+-- against CLI arguments to determine which bookmark/query to open.
+--
+-- @since 0.1.0.0
+type Keyword = String
+
+-- | Query parameter name
+--
+-- @since 0.1.0.0
+type ParameterName = String
+
+-- | Query parameter value
+--
+-- @since 0.1.0.0
+type ParameterValue = String
+
+-- | Trace line for debugging
+--
+-- @since 0.1.0.0
+type Trace = String
+
+-- | Bookmark or query action URL
+--
+-- @since 0.1.0.0
+type Url = String
+
+------------------------------------------------------------------------------
+
+-- | Configuration
+--
+-- YAML attributes:
+--
+-- * @command@: top-level command (string, default depends on the OS)
+-- * @args@: bookmarks (array of 'Bookmark')
+--
+-- Default commands:
+--
+-- * Linux: @xdg-open@
+-- * Windows: @start@
+-- * macOS: @open@
+--
+-- @since 0.1.0.0
+data Config
+ = Config
+ { configCommand :: !Command
+ , configArgs :: !(Vector Bookmark)
+ }
+ deriving Show
+
+instance FromJSON Config where
+ parseJSON = A.withObject "Config" $ \o ->
+ Config
+ <$> o .:? "command" .!= defaultCommand
+ <*> o .: "args"
+
+------------------------------------------------------------------------------
+
+-- | Bookmark definition
+--
+-- YAML attributes:
+--
+-- * @keyword@: bookmark keyword (string)
+-- * @command@: command for this bookmark and children (string, optional)
+-- * @url@: bookmark URL (string, optional)
+-- * @query@: bookmark query definition ('Query', optional)
+-- * @args@: child bookmarks (array of 'Bookmark', optional)
+--
+-- A command be set to override the top-level command, but this is generally
+-- not done. If a bookmark is selected and there is no URL, the first child
+-- is processed. Only one of @query@ and @args@ may be present.
+--
+-- @since 0.1.0.0
+data Bookmark
+ = Bookmark
+ { keyword :: !Keyword
+ , mCommand :: !(Maybe Command)
+ , mUrl :: !(Maybe Url)
+ , queryOrArgs :: !(Either Query (Vector Bookmark))
+ }
+ deriving Show
+
+instance FromJSON Bookmark where
+ parseJSON = A.withObject "Bookmark" $ \o -> do
+ keyword <- parseToString =<< o .: "keyword"
+ mCommand <- o .:? "command"
+ mUrl <- o .:? "url"
+ mQuery <- o .:? "query"
+ mArgs <- o .:? "args"
+ queryOrArgs <- case (mQuery, mArgs) of
+ (Nothing, Just args) -> pure $ Right args
+ (Just query, Nothing) -> pure $ Left query
+ (Nothing, Nothing) -> pure $ Right V.empty
+ (Just{}, Just{}) -> fail $
+ "bookmark has both query and args: " ++ keyword
+ pure Bookmark{..}
+
+------------------------------------------------------------------------------
+
+-- | Query definition
+--
+-- YAML attributes:
+--
+-- * @action@: URL (string)
+-- * @parameter@: query parameter name (string, default: @q@)
+-- * @hidden@: array of constant parameters ('Parameter')
+--
+-- @since 0.1.0.0
+data Query
+ = Query
+ { action :: !Url
+ , parameter :: !ParameterName
+ , hiddenParameters :: !(Vector Parameter)
+ }
+ deriving Show
+
+instance FromJSON Query where
+ parseJSON = A.withObject "Query" $ \o ->
+ Query
+ <$> o .: "action"
+ <*> o .:? "parameter" .!= defaultParameter
+ <*> o .:? "hidden" .!= V.empty
+
+------------------------------------------------------------------------------
+
+-- | HTTP GET parameter definition
+--
+-- YAML attributes:
+--
+-- * @name@: parameter name
+-- * @value@: constant parameter value
+--
+-- @since 0.1.0.0
+data Parameter
+ = Parameter
+ { name :: !ParameterName
+ , value :: !ParameterValue
+ }
+ deriving Show
+
+instance FromJSON Parameter where
+ parseJSON = A.withObject "Parameter" $ \o ->
+ Parameter
+ <$> o .: "name"
+ <*> (parseToString =<< o .: "value")
+
+-- | Encode an HTTP GET parameter
+--
+-- Spaces are transformed to plus characters, and other reserved characters
+-- are escaped.
+encodeParameter :: Parameter -> String
+encodeParameter Parameter{..} = encodePart name ++ "=" ++ encodePart value
+ where
+ encodePart :: String -> String
+ encodePart
+ = map (\c -> if c == ' ' then '+' else c)
+ . URI.escapeURIString ((||) <$> URI.isUnreserved <*> (== ' '))
+
+------------------------------------------------------------------------------
+
+-- | Process specification
+--
+-- @since 0.1.0.0
+data Proc
+ = Proc
+ { command :: !Command
+ , arguments :: ![Argument]
+ }
+ deriving (Eq, Show)
+
+------------------------------------------------------------------------------
+-- $API
+
+-- | Determine the process to execute for the given config and CLI arguments
+--
+-- @since 0.1.0.0
+run
+ :: Config
+ -> [Argument]
+ -> (Either Error Proc, [Trace])
+run Config{..} cliArgs = fmap DList.toList . runWriter $ do
+ trace $ formatCommand configCommand
+ loop configCommand configArgs cliArgs
+ where
+ loop
+ :: Command
+ -> Vector Bookmark
+ -> [Argument]
+ -> Writer (DList Trace) (Either Error Proc)
+ loop cmd bms (arg:args) = case V.find (isPrefixOf arg . keyword) bms of
+ Just bm -> do
+ trace $ formatBookmark bm
+ case queryOrArgs bm of
+ Left query
+ | null args -> case mUrl bm of
+ Just url -> openUrl (fromMaybe cmd $ mCommand bm) url
+ Nothing -> returnError $ "no query for " ++ keyword bm
+ | otherwise -> openQuery (fromMaybe cmd $ mCommand bm) query args
+ Right bms'
+ | null args -> case mUrl bm of
+ Just url -> openUrl (fromMaybe cmd $ mCommand bm) url
+ Nothing -> case bms' V.!? 0 of
+ Just bm' ->
+ loop (fromMaybe cmd $ mCommand bm) bms' [keyword bm']
+ Nothing -> returnError $ "no URL for " ++ keyword bm
+ | otherwise -> loop (fromMaybe cmd $ mCommand bm) bms' args
+ Nothing -> returnError $ "unknown argument: " ++ arg
+ loop _cmd _bms [] = returnError "no arguments"
+
+ returnError :: Error -> Writer (DList Trace) (Either Error Proc)
+ returnError = return . Left
+
+ openUrl :: Command -> Url -> Writer (DList Trace) (Either Error Proc)
+ openUrl cmd url = do
+ trace $ unwords [cmd, url]
+ return . Right $ Proc cmd [url]
+
+ openQuery
+ :: Command
+ -> Query
+ -> [Argument]
+ -> Writer (DList Trace) (Either Error Proc)
+ openQuery cmd Query{..} args
+ = openUrl cmd
+ . (action ++)
+ . ('?' :)
+ . intercalate "&"
+ . map encodeParameter
+ $ Parameter parameter (unwords args) : V.toList hiddenParameters
+
+ trace :: Trace -> Writer (DList Trace) ()
+ trace = tell . DList.singleton
+
+ formatCommand :: Command -> Trace
+ formatCommand = ('[' :) . (++ "]")
+
+ formatKeyword :: Keyword -> Trace
+ formatKeyword = ('<' :) . (++ ">")
+
+ formatBookmark :: Bookmark -> Trace
+ formatBookmark Bookmark{..} = case mCommand of
+ Just command -> unwords [formatKeyword keyword, formatCommand command]
+ Nothing -> formatKeyword keyword
+
+------------------------------------------------------------------------------
+
+-- | Get CLI completion options
+--
+-- @since 0.1.0.0
+getCompletion
+ :: Config
+ -> [Argument] -- ^ current CLI arguments, last one being completed
+ -> [Argument] -- ^ completion options
+getCompletion Config{..} = loop configArgs
+ where
+ loop :: Vector Bookmark -> [Argument] -> [Argument]
+ loop bms [arg] = filter (isPrefixOf arg) . map keyword $ V.toList bms
+ loop bms (arg:args) = case V.find (isPrefixOf arg . keyword) bms of
+ Just bm -> case queryOrArgs bm of
+ Left{} -> []
+ Right bms' -> loop bms' args
+ Nothing -> []
+ loop _bms [] = []
+
+------------------------------------------------------------------------------
+-- $Internal
+
+-- | Parse any scalar value as a string
+--
+-- Strings, numbers, booleans, and null are parsed as a string. Arrays and
+-- objects result in an error.
+parseToString :: A.Value -> AT.Parser String
+parseToString = \case
+ (A.String t) -> pure $ T.unpack t
+ (A.Number n) -> pure . either (show @Double) (show @Integer) $
+ Sci.floatingOrInteger n
+ (A.Bool b) -> pure $ if b then "true" else "false"
+ A.Null -> pure "null"
+ A.Array{} -> fail "unexpected array"
+ A.Object{} -> fail "unexpected object"
diff --git a/test/BM/Test.hs b/test/BM/Test.hs
new file mode 100644
--- /dev/null
+++ b/test/BM/Test.hs
@@ -0,0 +1,302 @@
+module BM.Test (tests) where
+
+-- https://hackage.haskell.org/package/tasty
+import Test.Tasty (TestTree, testGroup)
+
+-- https://hackage.haskell.org/package/tasty-hunit
+import Test.Tasty.HUnit ((@=?), testCase)
+
+-- https://hackage.haskell.org/package/vector
+import qualified Data.Vector as V
+
+-- (bm)
+import qualified BM
+
+------------------------------------------------------------------------------
+
+config :: BM.Config
+config = BM.Config
+ { BM.configCommand = "xdg-open"
+ , BM.configArgs = V.fromList [ddg, google, nix, postgres, python, tst]
+ }
+ where
+ ddg = BM.Bookmark
+ { BM.keyword = "ddg"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Just "https://duckduckgo.com"
+ , BM.queryOrArgs = Left $ BM.Query
+ { BM.action = "https://duckduckgo.com/"
+ , BM.parameter = "q"
+ , BM.hiddenParameters = V.fromList
+ [ BM.Parameter
+ { BM.name = "ia"
+ , BM.value = "web"
+ }
+ ]
+ }
+ }
+
+ google = BM.Bookmark
+ { BM.keyword = "google"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Nothing
+ , BM.queryOrArgs = Left $ BM.Query
+ { BM.action = "https://www.google.com/search"
+ , BM.parameter = "q"
+ , BM.hiddenParameters = V.empty
+ }
+ }
+
+ nix = BM.Bookmark
+ { BM.keyword = "nix"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Just "https://nixos.org/"
+ , BM.queryOrArgs = Right $ V.fromList [nixManual, nixOS, nixPkgs]
+ }
+ nixManual = BM.Bookmark
+ { BM.keyword = "manual"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Just "https://nixos.org/manual/nix/stable"
+ , BM.queryOrArgs = Right V.empty
+ }
+ nixOS = BM.Bookmark
+ { BM.keyword = "OS"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Just "https://nixos.org/manual/nixos/stable"
+ , BM.queryOrArgs = Right V.empty
+ }
+ nixPkgs = BM.Bookmark
+ { BM.keyword = "pkgs"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Just "https://github.com/NixOS/nixpkgs"
+ , BM.queryOrArgs = Right $ V.fromList [nixPkgsManual]
+ }
+ nixPkgsManual = BM.Bookmark
+ { BM.keyword = "manual"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Just "https://nixos.org/manual/nixpkgs/stable"
+ , BM.queryOrArgs = Right V.empty
+ }
+
+ postgres = BM.Bookmark
+ { BM.keyword = "postgres"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Just "https://www.postgresql.org/docs/current/index.html"
+ , BM.queryOrArgs = Right V.empty
+ }
+
+ python = BM.Bookmark
+ { BM.keyword = "python"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Just "https://docs.python.org/3/"
+ , BM.queryOrArgs = Right V.empty
+ }
+
+ tst = BM.Bookmark
+ { BM.keyword = "tst"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Nothing
+ , BM.queryOrArgs = Right $ V.fromList [tstAUrl, tstCommand, tstNoUrl]
+ }
+ tstAUrl = BM.Bookmark
+ { BM.keyword = "aurl"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Just "http://localhost:8001"
+ , BM.queryOrArgs = Right V.empty
+ }
+ tstCommand = BM.Bookmark
+ { BM.keyword = "cmd"
+ , BM.mCommand = Just "firefox"
+ , BM.mUrl = Just "http://localhost:8002"
+ , BM.queryOrArgs = Right $ V.fromList [tstCommandChild]
+ }
+ tstCommandChild = BM.Bookmark
+ { BM.keyword = "child"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Just "http://localhost:8003"
+ , BM.queryOrArgs = Right V.empty
+ }
+ tstNoUrl = BM.Bookmark
+ { BM.keyword = "nourl"
+ , BM.mCommand = Nothing
+ , BM.mUrl = Nothing
+ , BM.queryOrArgs = Right V.empty
+ }
+
+------------------------------------------------------------------------------
+
+testRun :: TestTree
+testRun = testGroup "run"
+ [ testCase "exact" $
+ ( Right $ BM.Proc
+ { BM.command = "xdg-open"
+ , BM.arguments = ["https://nixos.org/"]
+ }
+ , [ "[xdg-open]"
+ , ""
+ , "xdg-open https://nixos.org/"
+ ]
+ ) @=? BM.run config ["nix"]
+ , testCase "prefix" $
+ ( Right $ BM.Proc
+ { BM.command = "xdg-open"
+ , BM.arguments = ["https://nixos.org/"]
+ }
+ , [ "[xdg-open]"
+ , ""
+ , "xdg-open https://nixos.org/"
+ ]
+ ) @=? BM.run config ["n"]
+ , testCase "subExact" $
+ ( Right $ BM.Proc
+ { BM.command = "xdg-open"
+ , BM.arguments = ["https://nixos.org/manual/nixpkgs/stable"]
+ }
+ , [ "[xdg-open]"
+ , ""
+ , ""
+ , ""
+ , "xdg-open https://nixos.org/manual/nixpkgs/stable"
+ ]
+ ) @=? BM.run config ["nix", "pkgs", "manual"]
+ , testCase "subPrefix" $
+ ( Right $ BM.Proc
+ { BM.command = "xdg-open"
+ , BM.arguments = ["https://nixos.org/manual/nixpkgs/stable"]
+ }
+ , [ "[xdg-open]"
+ , ""
+ , ""
+ , ""
+ , "xdg-open https://nixos.org/manual/nixpkgs/stable"
+ ]
+ ) @=? BM.run config ["n", "p", "m"]
+ , testCase "first" $
+ ( Right $ BM.Proc
+ { BM.command = "xdg-open"
+ , BM.arguments =
+ ["https://www.postgresql.org/docs/current/index.html"]
+ }
+ , [ "[xdg-open]"
+ , ""
+ , "xdg-open https://www.postgresql.org/docs/current/index.html"
+ ]
+ ) @=? BM.run config ["p"]
+ , testCase "queryUrlNoArgs" $
+ ( Right $ BM.Proc
+ { BM.command = "xdg-open"
+ , BM.arguments = ["https://duckduckgo.com"]
+ }
+ , [ "[xdg-open]"
+ , ""
+ , "xdg-open https://duckduckgo.com"
+ ]
+ ) @=? BM.run config ["d"]
+ , testCase "queryUrlArgs" $
+ ( Right $ BM.Proc
+ { BM.command = "xdg-open"
+ , BM.arguments = ["https://duckduckgo.com/?q=haskell+nix&ia=web"]
+ }
+ , [ "[xdg-open]"
+ , ""
+ , "xdg-open https://duckduckgo.com/?q=haskell+nix&ia=web"
+ ]
+ ) @=? BM.run config ["d", "haskell", "nix"]
+ , testCase "queryNoUrlArgs" $
+ ( Right $ BM.Proc
+ { BM.command = "xdg-open"
+ , BM.arguments = ["https://www.google.com/search?q=haskell+nix"]
+ }
+ , [ "[xdg-open]"
+ , ""
+ , "xdg-open https://www.google.com/search?q=haskell+nix"
+ ]
+ ) @=? BM.run config ["goo", "haskell", "nix"]
+ , testCase "queryNoUrlNoArgs" $
+ ( Left "no query for google"
+ , [ "[xdg-open]"
+ , ""
+ ]
+ ) @=? BM.run config ["goo"]
+ , testCase "noUrlSub" $
+ ( Right $ BM.Proc
+ { BM.command = "xdg-open"
+ , BM.arguments = ["http://localhost:8001"]
+ }
+ , [ "[xdg-open]"
+ , ""
+ , ""
+ , "xdg-open http://localhost:8001"
+ ]
+ ) @=? BM.run config ["tst"]
+ , testCase "noUrlError" $
+ ( Left "no URL for nourl"
+ , [ "[xdg-open]"
+ , ""
+ , ""
+ ]
+ ) @=? BM.run config ["tst", "nourl"]
+ , testCase "unknownError" $
+ ( Left "unknown argument: unknown"
+ , [ "[xdg-open]"
+ , ""
+ ]
+ ) @=? BM.run config ["tst", "unknown"]
+ , testCase "noArgsError" $
+ ( Left "no arguments"
+ , [ "[xdg-open]"
+ ]
+ ) @=? BM.run config []
+ , testCase "command" $
+ ( Right $ BM.Proc
+ { BM.command = "firefox"
+ , BM.arguments = ["http://localhost:8002"]
+ }
+ , [ "[xdg-open]"
+ , ""
+ , " [firefox]"
+ , "firefox http://localhost:8002"
+ ]
+ ) @=? BM.run config ["tst", "cmd"]
+ , testCase "commandChild" $
+ ( Right $ BM.Proc
+ { BM.command = "firefox"
+ , BM.arguments = ["http://localhost:8003"]
+ }
+ , [ "[xdg-open]"
+ , ""
+ , " [firefox]"
+ , ""
+ , "firefox http://localhost:8003"
+ ]
+ ) @=? BM.run config ["tst", "cmd", "child"]
+ ]
+
+------------------------------------------------------------------------------
+
+testGetCompletion :: TestTree
+testGetCompletion = testGroup "getCompletion"
+ [ testCase "all" $
+ [ "ddg", "google", "nix", "postgres", "python", "tst"
+ ] @=? BM.getCompletion config [""]
+ , testCase "exact" $
+ ["nix"] @=? BM.getCompletion config ["nix"]
+ , testCase "subExact" $
+ ["pkgs"] @=? BM.getCompletion config ["nix", "pkgs"]
+ , testCase "prefix" $
+ ["postgres", "python"] @=? BM.getCompletion config ["p"]
+ , testCase "none" $
+ [] @=? BM.getCompletion config ["google", "maps"]
+ , testCase "noneFirst" $
+ [] @=? BM.getCompletion config ["j", "e"]
+ , testCase "empty" $
+ [] @=? BM.getCompletion config []
+ ]
+
+------------------------------------------------------------------------------
+
+tests :: TestTree
+tests = testGroup "BM"
+ [ testRun
+ , testGetCompletion
+ ]
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,14 @@
+module Main (main) where
+
+-- https://hackage.haskell.org/package/tasty
+import Test.Tasty (defaultMain, testGroup)
+
+-- (bm:test)
+import qualified BM.Test
+
+------------------------------------------------------------------------------
+
+main :: IO ()
+main = defaultMain $ testGroup "test"
+ [ BM.Test.tests
+ ]