module Database.Stash (
Stashable(..),
Meta,
put,
get,
find,
find',
getType,
findType,
findType',
) where
import Control.Monad (forM, join)
import Data.Aeson (FromJSON, ToJSON)
import Data.Maybe (listToMaybe)
import Data.Maybe (catMaybes)
import Data.Typeable (Typeable)
import qualified Data.Aeson
import qualified Data.Aeson.Parser
import qualified Data.ByteString.Lazy as ByteString
import qualified Data.ByteString as SByteString
import qualified Data.Hashable
import qualified Data.String
import qualified Data.Typeable
import qualified Data.Vector
import qualified System.Directory
import qualified Data.Attoparsec.ByteString
import qualified Data.Text
type Stashable a = (ToJSON a, FromJSON a, Typeable a, Show a)
type Meta = Data.Aeson.Value
emptyMeta = Data.Aeson.Null
put :: Stashable a => Meta -> a -> IO ()
put k v = do
let meta_ = Data.Aeson.encode $ k
let type_ = Data.Aeson.encode $ Data.Aeson.String $ Data.String.fromString $ show $ Data.Typeable.typeOf v
let data_ = Data.Aeson.encode v
let hash = Data.Hashable.hash k
let dirPath = stashPath ++ "/" ++ (tail $ show hash)
System.Directory.createDirectoryIfMissing True stashPath
System.Directory.createDirectoryIfMissing True dirPath
ByteString.writeFile (dirPath++"/"++"meta.json") meta_
ByteString.writeFile (dirPath++"/"++"type.json") type_
ByteString.writeFile (dirPath++"/"++"data.json") data_
return ()
get :: Stashable a => Meta -> IO (Maybe a)
get k = fmap (listToMaybe) $ find (== k)
find :: Stashable a => (Meta -> Bool) -> IO [a]
find = fmap (fmap (\(_,_,x)->x)) . find'
find' :: Stashable a => (Meta -> Bool) -> IO [(Meta,String,a)]
find' p = do
stashSubDirectories <- fmap (filter ((> 11) . length)) $
System.Directory.getDirectoryContents stashPath
fmap catMaybes $ forM stashSubDirectories $ \subDirectoryName -> do
let dirPath = stashPath ++ "/" ++ subDirectoryName
_meta <- SByteString.readFile (dirPath++"/"++"meta.json")
_type <- SByteString.readFile (dirPath++"/"++"type.json")
_data <- ByteString.readFile (dirPath++"/"++"data.json")
let k = (dec _meta :: Data.Aeson.Value)
let ok = p k
let da = (Data.Aeson.decode $ _data)
let ty = getS (dec _type)
let res = (join $ if ok then Just (fmap (k,ty,) da) else Nothing)
return res
getType :: Meta -> IO (Maybe String)
getType k = fmap (listToMaybe) $ findType (== k)
findType :: (Meta -> Bool) -> IO [String]
findType = fmap (fmap snd) . findType'
findType' :: (Meta -> Bool) -> IO [(Meta,String)]
findType' p = do
stashSubDirectories <- fmap (filter ((> 11) . length)) $
System.Directory.getDirectoryContents stashPath
fmap catMaybes $ forM stashSubDirectories $ \subDirectoryName -> do
let dirPath = stashPath ++ "/" ++ subDirectoryName
_meta <- SByteString.readFile (dirPath++"/"++"meta.json")
_type <- SByteString.readFile (dirPath++"/"++"type.json")
_data <- ByteString.readFile (dirPath++"/"++"data.json")
let k = (dec _meta :: Data.Aeson.Value)
let ok = p $ (dec _meta :: Data.Aeson.Value)
let ty = getS (dec _type)
let res = (if ok then Just (k, ty) else Nothing)
return res
getS (Data.Aeson.String x) = Data.Text.unpack x
dec :: SByteString.ByteString -> Data.Aeson.Value
dec = fromEither . Data.Attoparsec.ByteString.parseOnly Data.Aeson.Parser.value
fromEither (Right x) = x
fromJust (Just x) = x
stashPath = "/Users/hans/.stash"