app/Main.hs

@@ -14,9 +14,7 @@ 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,7 +37,6 @@ library
                      , Database.Migrations
                      , Control.Monad.Buuka
                      , Operations.Insert
-                     , Operations.List
                      , Operations
                      , Data.Environment
                      , Data.Buuka
@@ -47,15 +46,12 @@ 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, containers, exceptions
+{ mkDerivation, aeson, base, bytestring, conduit, conduit-extra
-, filepath, hashable, hashids, hedgehog, hedgehog-corpus, lens, mtl
+, containers, exceptions, filepath, hedgehog, hedgehog-corpus, mtl
 , optparse-applicative, stdenv, tasty, tasty-hedgehog, text
-, transformers, unliftio, vector, yaml
+, transformers, unliftio, yaml
 }:
 mkDerivation {
   pname = "buuka";
@@ -10,8 +10,8 @@ mkDerivation {
   isLibrary = true;
   isExecutable = true;
   libraryHaskellDepends = [
-    aeson base bytestring containers exceptions filepath hashable
+    aeson base bytestring conduit conduit-extra containers exceptions
-    hashids lens mtl text transformers unliftio vector yaml
+    filepath mtl transformers unliftio 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, createDirectoryIfMissing)
+       (copyFile)
 import UnliftIO.Temporary
        (withSystemTempDirectory)
 
@@ -44,9 +44,7 @@ newtype BuukaM a = BuukaM (ReaderT Environment IO a)
                    )
 
 runBuukaM :: Environment -> BuukaM a -> IO a
-runBuukaM env (BuukaM f) = do
+runBuukaM env (BuukaM f) = runReaderT f env
-  createDirectoryIfMissing True (workdir env)
-  runReaderT f env
 
 data DecodeException
   = YamlParseException ParseException
@@ -58,7 +56,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,59 +8,42 @@ 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, Hashable)
+  deriving newtype (ToJSON, FromJSON, FromJSONKey, ToJSONKey)
 
 data BuukaEntry
   = BuukaEntry { url :: URL
                , title :: Maybe String
                }
   deriving stock (Show, Eq, Generic)
-  deriving anyclass (ToJSON, FromJSON, Hashable)
+  deriving anyclass (ToJSON, FromJSON)
 
 instance SafeJSON BuukaEntry where
   type Version BuukaEntry = 0
 
-newtype Buuka = Buuka [BuukaEntry]
+newtype Buuka = Buuka ( Map URL BuukaEntry )
   deriving stock (Show, Eq)
-  deriving newtype (Semigroup, Monoid, FromJSON, ToJSON, Hashable)
+  deriving newtype (Semigroup, Monoid, FromJSON, ToJSON)
 
 insert :: BuukaEntry -> Buuka -> Buuka
-insert e (Buuka b) = Buuka (e : b)
+insert e (Buuka b) = Buuka (M.insert (url e) 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,10 +1,6 @@
 module Operations
-  ( module Operations.Insert
+  ( module Operations.Insert )
-  , module Operations.List
-  )
   where
 
 import Operations.Insert
        (insert)
-import Operations.List
-       (list)

src/Operations/List.hs

@@ -1,40 +0,0 @@
-{-# 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)