Refactor the formatter to its own module

This commit is contained in:
Mats Rauhala 2021-01-02 08:27:18 +02:00
parent 29b71fc216
commit e802f66599
3 changed files with 52 additions and 20 deletions

View File

@ -38,6 +38,7 @@ library
, Control.Monad.Buuka , Control.Monad.Buuka
, Operations.Insert , Operations.Insert
, Operations.List , Operations.List
, Operations.Format
, Operations , Operations
, Data.Environment , Data.Environment
, Data.Buuka , Data.Buuka

48
src/Operations/Format.hs Normal file
View File

@ -0,0 +1,48 @@
{-# LANGUAGE LambdaCase #-}
{-|
Module : Operations.Format
Description : Format the list of bookmarks
Copyright : (c) Mats Rauhala, 2020
License : BSD-3-Clause
Maintainer : mats.rauhala@iki.fi
Stability : experimental
Portability : POSIX
Format the list of bookmarks. It uses the "hashids" module to create a unique
hash for each entry. Some extra (user) security is given by using the hash of
the full entries as the initial context for hashids. If the state has been
modified between operations, the ids change.
-}
module Operations.Format where
import Data.Buuka
(Buuka, BuukaEntry(..), URL(..))
import qualified Data.Buuka as B
import Data.Semigroup
(Max(..))
import Web.Hashids
import Control.Lens
import Data.Text.Strict.Lens
(unpacked, utf8)
-- | Format the entries
formatEntries
:: Buuka -- ^ The full set of entries, for the context
-> [BuukaEntry] -- ^ The list of entries to be formatted
-> [String]
formatEntries buuka 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
where
ctx = mkContext buuka
mkContext :: Buuka -> HashidsContext
mkContext = hashidsSimple . B.fingerprint
formatEntry :: Int -> BuukaEntry -> (String, String)
formatEntry n = \case
BuukaEntry{title=Just t} -> (encode ctx n ^. utf8 . unpacked, t)
BuukaEntry{url=URL u} -> (encode ctx n ^. utf8 . unpacked, u)

View File

@ -8,33 +8,16 @@ import Control.Monad.Reader
import Data.Foldable import Data.Foldable
(traverse_) (traverse_)
import Data.Semigroup
(Max(..))
import Data.Buuka import Data.Buuka
(Buuka, BuukaEntry(..), URL(..)) (Buuka)
import qualified Data.Buuka as B import qualified Data.Buuka as B
import Web.Hashids import Operations.Format
import Control.Lens
import Data.Text.Strict.Lens
(unpacked, utf8)
list :: BuukaM () list :: BuukaM ()
list = list =
buukaQ (asks go) >>= traverse_ (liftIO . putStrLn) buukaQ (asks go) >>= traverse_ (liftIO . putStrLn)
where where
go :: Buuka -> [String] go :: Buuka -> [String]
go b = go b = formatEntries b (B.elements b)
let ctx = hashidsSimple (B.fingerprint b)
in format ctx (B.elements b)
format :: HashidsContext -> [BuukaEntry] -> [String]
format ctx xs =
let formatted = zipWith (formatEntry ctx) [1..] xs
indexWidth = getMax . foldMap (Max . length . fst) $ formatted
in fmap (\(idx,x) -> idx <> replicate (indexWidth - length idx) ' ' <> ". " <> x) formatted
formatEntry :: HashidsContext -> Int -> BuukaEntry -> (String, String)
formatEntry ctx n = \case
BuukaEntry{title=Just t} -> (encode ctx n ^. utf8 . unpacked, t)
BuukaEntry{url=URL u} -> (encode ctx n ^. utf8 . unpacked, u)