Use hashids for index

This commit is contained in:
Mats Rauhala 2021-01-01 08:34:09 +02:00
parent d9445823bb
commit ec5576213f
3 changed files with 17 additions and 8 deletions

View File

@ -54,6 +54,7 @@ library
, vector
, hashids
, text
, lens
hs-source-dirs: src
executable buuka

View File

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

View File

@ -3,21 +3,29 @@ module Operations.List where
import Control.Monad.Buuka
import Control.Monad.Reader
(liftIO, asks)
(asks, liftIO)
import Data.Foldable
(traverse_)
import Data.Semigroup (Max(..))
import Data.Semigroup
(Max(..))
import Data.Buuka
(URL(..), BuukaEntry(..))
(BuukaEntry(..), URL(..))
import qualified Data.Buuka as B
import Web.Hashids
import Control.Lens
import Data.Text.Strict.Lens
(unpacked, utf8)
list :: BuukaM ()
list =
buukaQ (asks (format . B.elements)) >>= traverse_ (liftIO . putStrLn)
where
ctx = hashidsSimple "buuka"
format :: [BuukaEntry] -> [String]
format xs =
let formatted = zipWith formatEntry [1..] xs
@ -25,5 +33,5 @@ list =
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)
BuukaEntry{title=Just t} -> (encode ctx n ^. utf8 . unpacked, t)
BuukaEntry{url=URL u} -> (encode ctx n ^. utf8 . unpacked, u)