{-# LANGUAGE OverloadedStrings #-}
module DB
( dbDir
, readKV
, lookupKV
, prependKV
, writeKV
, fetch
, store
) where
import Control.Monad ( liftM )
import Data.Maybe ( fromMaybe
, isNothing )
import Data.ByteString.Lazy as BS ( ByteString
, readFile
, writeFile )
import Data.Csv ( encode
, decode
, HasHeader (NoHeader)
)
import Data.Text as T
import Data.Vector as V
import System.Directory ( createDirectoryIfMissing
, getXdgDirectory
, XdgDirectory( XdgData )
)
import CSV ( configDir )
dbDir :: IO FilePath
dbDir :: IO FilePath
dbDir = XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgData FilePath
"owen/db/"
lockFile :: FilePath -> IO ()
lockFile :: FilePath -> IO ()
lockFile FilePath
file = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
isFileLocked :: FilePath -> IO Bool
isFileLocked :: FilePath -> IO Bool
isFileLocked FilePath
file = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
readDB :: FilePath -> IO ByteString
readDB :: FilePath -> IO ByteString
readDB FilePath
file = do
FilePath
base <- IO FilePath
dbDir
FilePath -> IO ByteString
BS.readFile (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
base FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
file
writeDB :: FilePath -> ByteString -> IO ()
writeDB :: FilePath -> ByteString -> IO ()
writeDB FilePath
file ByteString
db = do
FilePath
base <- IO FilePath
dbDir
FilePath -> ByteString -> IO ()
BS.writeFile (FilePath
base FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
file) ByteString
db
type KeyValue = Vector (T.Text, T.Text)
readKV :: FilePath -> IO KeyValue
readKV :: FilePath -> IO KeyValue
readKV FilePath
file = do
ByteString
contents <- FilePath -> IO ByteString
readDB FilePath
file
case HasHeader -> ByteString -> Either FilePath KeyValue
forall a.
FromRecord a =>
HasHeader -> ByteString -> Either FilePath (Vector a)
decode HasHeader
NoHeader ByteString
contents of
Left FilePath
_ -> KeyValue -> IO KeyValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyValue -> IO KeyValue) -> KeyValue -> IO KeyValue
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> KeyValue
forall a. a -> Vector a
V.singleton (Text
"",Text
"")
Right KeyValue
db -> KeyValue -> IO KeyValue
forall (m :: * -> *) a. Monad m => a -> m a
return KeyValue
db
writeKV :: FilePath -> KeyValue -> IO ()
writeKV :: FilePath -> KeyValue -> IO ()
writeKV FilePath
file = FilePath -> ByteString -> IO ()
writeDB FilePath
file (ByteString -> IO ())
-> (KeyValue -> ByteString) -> KeyValue -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> ByteString
forall a. ToRecord a => [a] -> ByteString
encode ([(Text, Text)] -> ByteString)
-> (KeyValue -> [(Text, Text)]) -> KeyValue -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyValue -> [(Text, Text)]
forall a. Vector a -> [a]
V.toList
lookupKV :: T.Text -> KeyValue -> Maybe T.Text
lookupKV :: Text -> KeyValue -> Maybe Text
lookupKV Text
k = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k ([(Text, Text)] -> Maybe Text)
-> (KeyValue -> [(Text, Text)]) -> KeyValue -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyValue -> [(Text, Text)]
forall a. Vector a -> [a]
V.toList
prependKV :: T.Text -> T.Text -> KeyValue -> KeyValue
prependKV :: Text -> Text -> KeyValue -> KeyValue
prependKV Text
k Text
v = (Text, Text) -> KeyValue -> KeyValue
forall a. a -> Vector a -> Vector a
V.cons (Text
k,Text
v)
appendKV :: T.Text -> T.Text -> KeyValue -> KeyValue
appendKV :: Text -> Text -> KeyValue -> KeyValue
appendKV Text
k Text
v KeyValue
db = KeyValue -> (Text, Text) -> KeyValue
forall a. Vector a -> a -> Vector a
V.snoc KeyValue
db (Text
k,Text
v)
fetch :: FilePath -> T.Text -> IO T.Text
fetch :: FilePath -> Text -> IO Text
fetch FilePath
path Text
k = do
KeyValue
db <- FilePath -> IO KeyValue
readKV FilePath
path
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> KeyValue -> Maybe Text
lookupKV Text
k KeyValue
db
store :: FilePath -> T.Text -> T.Text -> IO ()
store :: FilePath -> Text -> Text -> IO ()
store FilePath
path Text
k Text
v = do
KeyValue
db <- FilePath -> IO KeyValue
readKV FilePath
path
case Text -> KeyValue -> Maybe Text
lookupKV Text
k KeyValue
db of
Just Text
v -> FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"[KeyValue] " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
v FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" was already in the KeyValue!"
Maybe Text
Nothing -> FilePath -> KeyValue -> IO ()
writeKV FilePath
path (KeyValue -> IO ()) -> KeyValue -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> KeyValue -> KeyValue
prependKV Text
k Text
v KeyValue
db