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 :: Parser (BuukaM ())
commands = subparser 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 where
insertOpts f = insertOpts f =
f <$> strOption (long "url" <> short 'u' <> metavar "URL") f <$> strOption (long "url" <> short 'u' <> metavar "URL")

View File

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

View File

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

View File

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

View File

@ -1,6 +1,10 @@
module Operations module Operations
( module Operations.Insert ) ( module Operations.Insert
, module Operations.List
)
where where
import Operations.Insert import Operations.Insert
(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)