List and format
This commit is contained in:
parent
32afc6ba29
commit
d9445823bb
@ -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")
|
||||||
|
@ -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
|
||||||
|
12
default.nix
12
default.nix
@ -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 = [
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -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
29
src/Operations/List.hs
Normal 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)
|
Loading…
Reference in New Issue
Block a user