Refactor the formatter to its own module
This commit is contained in:
parent
29b71fc216
commit
e802f66599
@ -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
48
src/Operations/Format.hs
Normal 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)
|
@ -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)
|
|
||||||
|
Loading…
Reference in New Issue
Block a user