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 , vector
, hashids , hashids
, text , text
, lens
hs-source-dirs: src hs-source-dirs: src
executable buuka executable buuka

View File

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

View File

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