Refactor the formatter to its own module
This commit is contained in:
		@@ -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)
 | 
					 | 
				
			||||||
 
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user