Fingerprint the 'Buuka' and use it as context

app/Main.hs

@@ -14,7 +14,9 @@ import qualified Operations
 
 commands :: Parser (BuukaM ())
 commands = subparser
-  (  command "insert" (info (insertOpts Operations.insert) (progDesc "Insert a new bookmark")))
+  (  command "insert" (info (insertOpts Operations.insert) (progDesc "Insert a new bookmark"))
+  <> command "list" (info (pure Operations.list) (progDesc "List all the bookmarks"))
+  )
   where
     insertOpts f =
         f <$> strOption (long "url" <> short 'u' <> metavar "URL")

buuka.cabal

@@ -37,6 +37,7 @@ library
                      , Database.Migrations
                      , Control.Monad.Buuka
                      , Operations.Insert
+                     , Operations.List
                      , Operations
                      , Data.Environment
                      , Data.Buuka
@@ -46,12 +47,15 @@ library
                      , mtl
                      , transformers
                      , unliftio
-                     , conduit
-                     , conduit-extra
                      , containers
                      , exceptions
                      , bytestring
                      , filepath
+                     , vector
+                     , hashids
+                     , text
+                     , lens
+                     , hashable
   hs-source-dirs:      src
 
 executable buuka

default.nix

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

src/Control/Monad/Buuka.hs

@@ -25,7 +25,7 @@ import Control.Monad.State
 import UnliftIO
        (MonadUnliftIO(..))
 import UnliftIO.Directory
-       (copyFile)
+       (copyFile, createDirectoryIfMissing)
 import UnliftIO.Temporary
        (withSystemTempDirectory)
 
@@ -44,7 +44,9 @@ newtype BuukaM a = BuukaM (ReaderT Environment IO a)
                    )
 
 runBuukaM :: Environment -> BuukaM a -> IO a
-runBuukaM env (BuukaM f) = runReaderT f env
+runBuukaM env (BuukaM f) = do
+  createDirectoryIfMissing True (workdir env)
+  runReaderT f env
 
 data DecodeException
   = YamlParseException ParseException
@@ -56,7 +58,7 @@ buukaQ :: BuukaQ a -> BuukaM a
 buukaQ q = do
   w <- asks workdir
   decoded <- (decode <$> liftIO (B.readFile (w </> "buuka.yaml"))) `catch` handleNotFound
-  either (throwM) (pure . runReader (runBuukaQ q)) decoded
+  either throwM (pure . runReader (runBuukaQ q)) decoded
   where
     handleNotFound IOError{ioe_type = NoSuchThing} = pure (Right mempty)
     handleNotFound e = throwM e

src/Data/Buuka.hs

@@ -8,42 +8,59 @@ module Data.Buuka
   , Buuka
 
   , insert
+  , elements
+  , fingerprint
   )
   where
 
-import Data.Map
-       (Map)
-import qualified Data.Map.Strict as M
-
 import Database.Migrations
 
 import Data.Aeson
+import Data.Bits
+       (finiteBitSize, shiftR, (.&.))
+import Data.Hashable
+       (Hashable, hash)
 import GHC.Generics
        (Generic)
 
 import Control.Monad.Reader
 import Control.Monad.State
 
+import Data.ByteString
+       (ByteString)
+import qualified Data.ByteString as B
+
 newtype URL = URL String
   deriving stock (Show, Eq, Generic, Ord)
-  deriving newtype (ToJSON, FromJSON, FromJSONKey, ToJSONKey)
+  deriving newtype (ToJSON, FromJSON, FromJSONKey, ToJSONKey, Hashable)
 
 data BuukaEntry
   = BuukaEntry { url :: URL
                , title :: Maybe String
                }
   deriving stock (Show, Eq, Generic)
-  deriving anyclass (ToJSON, FromJSON)
+  deriving anyclass (ToJSON, FromJSON, Hashable)
 
 instance SafeJSON BuukaEntry where
   type Version BuukaEntry = 0
 
-newtype Buuka = Buuka ( Map URL BuukaEntry )
+newtype Buuka = Buuka [BuukaEntry]
   deriving stock (Show, Eq)
-  deriving newtype (Semigroup, Monoid, FromJSON, ToJSON)
+  deriving newtype (Semigroup, Monoid, FromJSON, ToJSON, Hashable)
 
 insert :: BuukaEntry -> Buuka -> Buuka
-insert e (Buuka b) = Buuka (M.insert (url e) e b)
+insert e (Buuka b) = Buuka (e : b)
+
+elements :: Buuka -> [BuukaEntry]
+elements (Buuka b) = b
+
+-- | Create a (non-cryptographic) hash out of the 'Buuka'
+fingerprint :: Buuka -> ByteString
+fingerprint = toBS . hash
+  where
+    toBS x =
+      let bs = finiteBitSize x
+      in B.pack [fromIntegral ((x `shiftR` s) .&. 255) | s <- [0..bs - 1]]
 
 instance SafeJSON Buuka where
   type Version Buuka = 0

src/Operations.hs

@@ -1,6 +1,10 @@
 module Operations
-  ( module Operations.Insert )
+  ( module Operations.Insert
+  , module Operations.List
+  )
   where
 
 import Operations.Insert
        (insert)
+import Operations.List
+       (list)

src/Operations/List.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE LambdaCase #-}
+module Operations.List where
+
+import Control.Monad.Buuka
+import Control.Monad.Reader
+       (asks, liftIO)
+
+import Data.Foldable
+       (traverse_)
+
+import Data.Semigroup
+       (Max(..))
+
+import Data.Buuka
+       (Buuka, 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 go) >>= traverse_ (liftIO . putStrLn)
+  where
+    go :: Buuka -> [String]
+    go 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)