{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module BM
(
version
, Argument
, Command
, Error
, Keyword
, ParameterName
, ParameterValue
, Trace
, Url
, Config(..)
, Bookmark(..)
, Query(..)
, Parameter(..)
, Proc(..)
, run
, getCompletion
) where
import qualified Data.Aeson as A
import Data.Aeson (FromJSON, (.:), (.:?), (.!=))
import qualified Data.Aeson.Types as AT
import Data.List (intercalate, isPrefixOf)
import Data.Maybe (fromMaybe)
import Data.Version (showVersion)
import qualified System.Info
import qualified Data.DList as DList
import Data.DList (DList)
import qualified Network.URI as URI
import qualified Data.Scientific as Sci
import qualified Data.Text as T
import Control.Monad.Trans.Writer (Writer, runWriter, tell)
import qualified Data.Vector as V
import Data.Vector (Vector)
import qualified Paths_bm as Project
version :: String
version :: String
version = String
"bm-haskell " forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
Project.version
defaultCommand :: Command
defaultCommand :: String
defaultCommand = case String
System.Info.os of
String
"mingw32" -> String
"start"
String
"darwin" -> String
"open"
String
_other -> String
"xdg-open"
defaultParameter :: ParameterName
defaultParameter :: String
defaultParameter = String
"q"
type Argument = String
type Command = FilePath
type Error = String
type Keyword = String
type ParameterName = String
type ParameterValue = String
type Trace = String
type Url = String
data Config
= Config
{ Config -> String
configCommand :: !Command
, Config -> Vector Bookmark
configArgs :: !(Vector Bookmark)
}
deriving Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show
instance FromJSON Config where
parseJSON :: Value -> Parser Config
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Config" forall a b. (a -> b) -> a -> b
$ \Object
o ->
String -> Vector Bookmark -> Config
Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"command" forall a. Parser (Maybe a) -> a -> Parser a
.!= String
defaultCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"args"
data Bookmark
= Bookmark
{ Bookmark -> String
keyword :: !Keyword
, Bookmark -> Maybe String
mCommand :: !(Maybe Command)
, Bookmark -> Maybe String
mUrl :: !(Maybe Url)
, Bookmark -> Either Query (Vector Bookmark)
queryOrArgs :: !(Either Query (Vector Bookmark))
}
deriving Int -> Bookmark -> ShowS
[Bookmark] -> ShowS
Bookmark -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bookmark] -> ShowS
$cshowList :: [Bookmark] -> ShowS
show :: Bookmark -> String
$cshow :: Bookmark -> String
showsPrec :: Int -> Bookmark -> ShowS
$cshowsPrec :: Int -> Bookmark -> ShowS
Show
instance FromJSON Bookmark where
parseJSON :: Value -> Parser Bookmark
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Bookmark" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
String
keyword <- Value -> Parser String
parseToString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keyword"
Maybe String
mCommand <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"command"
Maybe String
mUrl <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url"
Maybe Query
mQuery <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"query"
Maybe (Vector Bookmark)
mArgs <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"args"
Either Query (Vector Bookmark)
queryOrArgs <- case (Maybe Query
mQuery, Maybe (Vector Bookmark)
mArgs) of
(Maybe Query
Nothing, Just Vector Bookmark
args) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Vector Bookmark
args
(Just Query
query, Maybe (Vector Bookmark)
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Query
query
(Maybe Query
Nothing, Maybe (Vector Bookmark)
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Vector a
V.empty
(Just{}, Just{}) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
String
"bookmark has both query and args: " forall a. [a] -> [a] -> [a]
++ String
keyword
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bookmark{String
Maybe String
Either Query (Vector Bookmark)
queryOrArgs :: Either Query (Vector Bookmark)
mUrl :: Maybe String
mCommand :: Maybe String
keyword :: String
queryOrArgs :: Either Query (Vector Bookmark)
mUrl :: Maybe String
mCommand :: Maybe String
keyword :: String
..}
data Query
= Query
{ Query -> String
action :: !Url
, Query -> String
parameter :: !ParameterName
, Query -> Vector Parameter
hiddenParameters :: !(Vector Parameter)
}
deriving Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Query] -> ShowS
$cshowList :: [Query] -> ShowS
show :: Query -> String
$cshow :: Query -> String
showsPrec :: Int -> Query -> ShowS
$cshowsPrec :: Int -> Query -> ShowS
Show
instance FromJSON Query where
parseJSON :: Value -> Parser Query
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Query" forall a b. (a -> b) -> a -> b
$ \Object
o ->
String -> String -> Vector Parameter -> Query
Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"action"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parameter" forall a. Parser (Maybe a) -> a -> Parser a
.!= String
defaultParameter
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hidden" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Vector a
V.empty
data Parameter
= Parameter
{ Parameter -> String
name :: !ParameterName
, Parameter -> String
value :: !ParameterValue
}
deriving Int -> Parameter -> ShowS
[Parameter] -> ShowS
Parameter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parameter] -> ShowS
$cshowList :: [Parameter] -> ShowS
show :: Parameter -> String
$cshow :: Parameter -> String
showsPrec :: Int -> Parameter -> ShowS
$cshowsPrec :: Int -> Parameter -> ShowS
Show
instance FromJSON Parameter where
parseJSON :: Value -> Parser Parameter
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Parameter" forall a b. (a -> b) -> a -> b
$ \Object
o ->
String -> String -> Parameter
Parameter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser String
parseToString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value")
encodeParameter :: Parameter -> String
encodeParameter :: Parameter -> String
encodeParameter Parameter{String
value :: String
name :: String
value :: Parameter -> String
name :: Parameter -> String
..} = ShowS
encodePart String
name forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ ShowS
encodePart String
value
where
encodePart :: String -> String
encodePart :: ShowS
encodePart
= forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' then Char
'+' else Char
c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
URI.escapeURIString (Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Bool
URI.isUnreserved forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Eq a => a -> a -> Bool
== Char
' '))
data Proc
= Proc
{ Proc -> String
command :: !Command
, Proc -> [String]
arguments :: ![Argument]
}
deriving (Proc -> Proc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Proc -> Proc -> Bool
$c/= :: Proc -> Proc -> Bool
== :: Proc -> Proc -> Bool
$c== :: Proc -> Proc -> Bool
Eq, Int -> Proc -> ShowS
[Proc] -> ShowS
Proc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Proc] -> ShowS
$cshowList :: [Proc] -> ShowS
show :: Proc -> String
$cshow :: Proc -> String
showsPrec :: Int -> Proc -> ShowS
$cshowsPrec :: Int -> Proc -> ShowS
Show)
run
:: Config
-> [Argument]
-> (Either Error Proc, [Trace])
run :: Config -> [String] -> (Either String Proc, [String])
run Config{String
Vector Bookmark
configArgs :: Vector Bookmark
configCommand :: String
configArgs :: Config -> Vector Bookmark
configCommand :: Config -> String
..} [String]
cliArgs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. DList a -> [a]
DList.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w a. Writer w a -> (a, w)
runWriter forall a b. (a -> b) -> a -> b
$ do
String -> Writer (DList String) ()
trace forall a b. (a -> b) -> a -> b
$ ShowS
formatCommand String
configCommand
String
-> Vector Bookmark
-> [String]
-> Writer (DList String) (Either String Proc)
loop String
configCommand Vector Bookmark
configArgs [String]
cliArgs
where
loop
:: Command
-> Vector Bookmark
-> [Argument]
-> Writer (DList Trace) (Either Error Proc)
loop :: String
-> Vector Bookmark
-> [String]
-> Writer (DList String) (Either String Proc)
loop String
cmd Vector Bookmark
bms (String
arg:[String]
args) = case forall a. (a -> Bool) -> Vector a -> Maybe a
V.find (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
arg forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bookmark -> String
keyword) Vector Bookmark
bms of
Just Bookmark
bm -> do
String -> Writer (DList String) ()
trace forall a b. (a -> b) -> a -> b
$ Bookmark -> String
formatBookmark Bookmark
bm
case Bookmark -> Either Query (Vector Bookmark)
queryOrArgs Bookmark
bm of
Left Query
query
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args -> case Bookmark -> Maybe String
mUrl Bookmark
bm of
Just String
url -> String -> String -> Writer (DList String) (Either String Proc)
openUrl (forall a. a -> Maybe a -> a
fromMaybe String
cmd forall a b. (a -> b) -> a -> b
$ Bookmark -> Maybe String
mCommand Bookmark
bm) String
url
Maybe String
Nothing -> String -> Writer (DList String) (Either String Proc)
returnError forall a b. (a -> b) -> a -> b
$ String
"no query for " forall a. [a] -> [a] -> [a]
++ Bookmark -> String
keyword Bookmark
bm
| Bool
otherwise -> String
-> Query -> [String] -> Writer (DList String) (Either String Proc)
openQuery (forall a. a -> Maybe a -> a
fromMaybe String
cmd forall a b. (a -> b) -> a -> b
$ Bookmark -> Maybe String
mCommand Bookmark
bm) Query
query [String]
args
Right Vector Bookmark
bms'
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args -> case Bookmark -> Maybe String
mUrl Bookmark
bm of
Just String
url -> String -> String -> Writer (DList String) (Either String Proc)
openUrl (forall a. a -> Maybe a -> a
fromMaybe String
cmd forall a b. (a -> b) -> a -> b
$ Bookmark -> Maybe String
mCommand Bookmark
bm) String
url
Maybe String
Nothing -> case Vector Bookmark
bms' forall a. Vector a -> Int -> Maybe a
V.!? Int
0 of
Just Bookmark
bm' ->
String
-> Vector Bookmark
-> [String]
-> Writer (DList String) (Either String Proc)
loop (forall a. a -> Maybe a -> a
fromMaybe String
cmd forall a b. (a -> b) -> a -> b
$ Bookmark -> Maybe String
mCommand Bookmark
bm) Vector Bookmark
bms' [Bookmark -> String
keyword Bookmark
bm']
Maybe Bookmark
Nothing -> String -> Writer (DList String) (Either String Proc)
returnError forall a b. (a -> b) -> a -> b
$ String
"no URL for " forall a. [a] -> [a] -> [a]
++ Bookmark -> String
keyword Bookmark
bm
| Bool
otherwise -> String
-> Vector Bookmark
-> [String]
-> Writer (DList String) (Either String Proc)
loop (forall a. a -> Maybe a -> a
fromMaybe String
cmd forall a b. (a -> b) -> a -> b
$ Bookmark -> Maybe String
mCommand Bookmark
bm) Vector Bookmark
bms' [String]
args
Maybe Bookmark
Nothing -> String -> Writer (DList String) (Either String Proc)
returnError forall a b. (a -> b) -> a -> b
$ String
"unknown argument: " forall a. [a] -> [a] -> [a]
++ String
arg
loop String
_cmd Vector Bookmark
_bms [] = String -> Writer (DList String) (Either String Proc)
returnError String
"no arguments"
returnError :: Error -> Writer (DList Trace) (Either Error Proc)
returnError :: String -> Writer (DList String) (Either String Proc)
returnError = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
openUrl :: Command -> Url -> Writer (DList Trace) (Either Error Proc)
openUrl :: String -> String -> Writer (DList String) (Either String Proc)
openUrl String
cmd String
url = do
String -> Writer (DList String) ()
trace forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
cmd, String
url]
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> [String] -> Proc
Proc String
cmd [String
url]
openQuery
:: Command
-> Query
-> [Argument]
-> Writer (DList Trace) (Either Error Proc)
openQuery :: String
-> Query -> [String] -> Writer (DList String) (Either String Proc)
openQuery String
cmd Query{String
Vector Parameter
hiddenParameters :: Vector Parameter
parameter :: String
action :: String
hiddenParameters :: Query -> Vector Parameter
parameter :: Query -> String
action :: Query -> String
..} [String]
args
= String -> String -> Writer (DList String) (Either String Proc)
openUrl String
cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
action forall a. [a] -> [a] -> [a]
++)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'?' forall a. a -> [a] -> [a]
:)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate String
"&"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Parameter -> String
encodeParameter
forall a b. (a -> b) -> a -> b
$ String -> String -> Parameter
Parameter String
parameter ([String] -> String
unwords [String]
args) forall a. a -> [a] -> [a]
: forall a. Vector a -> [a]
V.toList Vector Parameter
hiddenParameters
trace :: Trace -> Writer (DList Trace) ()
trace :: String -> Writer (DList String) ()
trace = forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> DList a
DList.singleton
formatCommand :: Command -> Trace
formatCommand :: ShowS
formatCommand = (Char
'[' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
"]")
formatKeyword :: Keyword -> Trace
formatKeyword :: ShowS
formatKeyword = (Char
'<' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
">")
formatBookmark :: Bookmark -> Trace
formatBookmark :: Bookmark -> String
formatBookmark Bookmark{String
Maybe String
Either Query (Vector Bookmark)
queryOrArgs :: Either Query (Vector Bookmark)
mUrl :: Maybe String
mCommand :: Maybe String
keyword :: String
queryOrArgs :: Bookmark -> Either Query (Vector Bookmark)
mUrl :: Bookmark -> Maybe String
mCommand :: Bookmark -> Maybe String
keyword :: Bookmark -> String
..} = case Maybe String
mCommand of
Just String
command -> [String] -> String
unwords [ShowS
formatKeyword String
keyword, ShowS
formatCommand String
command]
Maybe String
Nothing -> ShowS
formatKeyword String
keyword
getCompletion
:: Config
-> [Argument]
-> [Argument]
getCompletion :: Config -> [String] -> [String]
getCompletion Config{String
Vector Bookmark
configArgs :: Vector Bookmark
configCommand :: String
configArgs :: Config -> Vector Bookmark
configCommand :: Config -> String
..} = Vector Bookmark -> [String] -> [String]
loop Vector Bookmark
configArgs
where
loop :: Vector Bookmark -> [Argument] -> [Argument]
loop :: Vector Bookmark -> [String] -> [String]
loop Vector Bookmark
bms [String
arg] = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
arg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Bookmark -> String
keyword forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Vector Bookmark
bms
loop Vector Bookmark
bms (String
arg:[String]
args) = case forall a. (a -> Bool) -> Vector a -> Maybe a
V.find (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
arg forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bookmark -> String
keyword) Vector Bookmark
bms of
Just Bookmark
bm -> case Bookmark -> Either Query (Vector Bookmark)
queryOrArgs Bookmark
bm of
Left{} -> []
Right Vector Bookmark
bms' -> Vector Bookmark -> [String] -> [String]
loop Vector Bookmark
bms' [String]
args
Maybe Bookmark
Nothing -> []
loop Vector Bookmark
_bms [] = []
parseToString :: A.Value -> AT.Parser String
parseToString :: Value -> Parser String
parseToString = \case
(A.String Text
t) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
(A.Number Scientific
n) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Show a => a -> String
show @Double) (forall a. Show a => a -> String
show @Integer) forall a b. (a -> b) -> a -> b
$
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Sci.floatingOrInteger Scientific
n
(A.Bool Bool
b) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
b then String
"true" else String
"false"
Value
A.Null -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"null"
A.Array{} -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected array"
A.Object{} -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected object"