List and format

This commit is contained in:
Mats Rauhala 2021-01-01 08:29:24 +02:00
parent 32afc6ba29
commit d9445823bb
6 changed files with 49 additions and 10 deletions

View File

@ -14,7 +14,9 @@ import qualified Operations
commands :: Parser (BuukaM ())
commands = subparser
( command "insert" (info (insertOpts Operations.insert) (progDesc "Insert a new bookmark")))
( command "insert" (info (insertOpts Operations.insert) (progDesc "Insert a new bookmark"))
<> command "list" (info (pure Operations.list) (progDesc "List all the bookmarks"))
)
where
insertOpts f =
f <$> strOption (long "url" <> short 'u' <> metavar "URL")

View File

@ -37,6 +37,7 @@ library
, Database.Migrations
, Control.Monad.Buuka
, Operations.Insert
, Operations.List
, Operations
, Data.Environment
, Data.Buuka
@ -46,14 +47,13 @@ library
, mtl
, transformers
, unliftio
, conduit
, conduit-extra
, containers
, exceptions
, bytestring
, filepath
, vector
, hashids
, text
hs-source-dirs: src
executable buuka

View File

@ -1,7 +1,7 @@
{ mkDerivation, aeson, base, bytestring, conduit, conduit-extra
, containers, exceptions, filepath, hashids, hedgehog
, hedgehog-corpus, mtl, optparse-applicative, stdenv, tasty
, tasty-hedgehog, text, transformers, unliftio, vector, yaml
{ mkDerivation, aeson, base, bytestring, containers, exceptions
, filepath, hashids, hedgehog, hedgehog-corpus, mtl
, optparse-applicative, stdenv, tasty, tasty-hedgehog, text
, transformers, unliftio, vector, yaml
}:
mkDerivation {
pname = "buuka";
@ -10,8 +10,8 @@ mkDerivation {
isLibrary = true;
isExecutable = true;
libraryHaskellDepends = [
aeson base bytestring conduit conduit-extra containers exceptions
filepath hashids mtl transformers unliftio vector yaml
aeson base bytestring containers exceptions filepath hashids mtl
text transformers unliftio vector yaml
];
executableHaskellDepends = [ base optparse-applicative unliftio ];
testHaskellDepends = [

View File

@ -8,6 +8,7 @@ module Data.Buuka
, Buuka
, insert
, elements
)
where
@ -41,6 +42,9 @@ newtype Buuka = Buuka [BuukaEntry]
insert :: BuukaEntry -> Buuka -> Buuka
insert e (Buuka b) = Buuka (e : b)
elements :: Buuka -> [BuukaEntry]
elements (Buuka b) = b
instance SafeJSON Buuka where
type Version Buuka = 0

View File

@ -1,6 +1,10 @@
module Operations
( module Operations.Insert )
( module Operations.Insert
, module Operations.List
)
where
import Operations.Insert
(insert)
import Operations.List
(list)

29
src/Operations/List.hs Normal file
View File

@ -0,0 +1,29 @@
{-# LANGUAGE LambdaCase #-}
module Operations.List where
import Control.Monad.Buuka
import Control.Monad.Reader
(liftIO, asks)
import Data.Foldable
(traverse_)
import Data.Semigroup (Max(..))
import Data.Buuka
(URL(..), BuukaEntry(..))
import qualified Data.Buuka as B
list :: BuukaM ()
list =
buukaQ (asks (format . B.elements)) >>= traverse_ (liftIO . putStrLn)
where
format :: [BuukaEntry] -> [String]
format xs =
let formatted = zipWith formatEntry [1..] xs
indexWidth = getMax . foldMap (Max . length . fst) $ formatted
in fmap (\(idx,x) -> idx <> replicate (indexWidth - length idx) ' ' <> ". " <> x) formatted
formatEntry :: Int -> BuukaEntry -> (String, String)
formatEntry n = \case
BuukaEntry{title=Just t} -> (show n, t)
BuukaEntry{url=URL u} -> (show n, u)