megastore (empty) → 0.1.0.0

raw patch · 7 files changed

+309/−0 lines, 7 filesdep +JuicyPixelsdep +adjunctionsdep +basesetup-changed

Dependencies added: JuicyPixels, adjunctions, base, binary, bytestring, containers, directory, ghc, hashable, lens, megastore, mtl, random, text, text-show, vector, zlib

Files

CHANGELOG.md +11/−0
LICENSE +30/−0
README.md +3/−0
Setup.hs +2/−0
app/Main.hs +22/−0
megastore.cabal +80/−0
src/MegaStore.hs +161/−0

+ CHANGELOG.md view

@@ -0,0 +1,11 @@+# Changelog for `keystore`
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## Unreleased
+
+## 0.1.0.0 - YYYY-MM-DD

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2022
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,3 @@+# MegaStore
+A Haskell Filetype and Data Structure for super 
+efficient storage of big image sets as one file

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

+ app/Main.hs view

@@ -0,0 +1,22 @@+module Main (main) where
+
+import MegaStore
+import Data.Text (pack)
+import System.Directory (createDirectoryIfMissing)
+
+main :: IO ()
+main = do
+    a1  <- loadFile "./assets/s1.png"
+    a2  <- loadFile "./assets/s2.png"
+    a3  <- loadFile "./assets/s3.png"
+    a4  <- loadFile "./assets/s4.png"
+    a5  <- loadFile "./assets/s5.png"
+
+    let testSet = MegaStore [(pack "s1", a1), (pack "s2", a2), (pack "s3", a3), (pack "s4", a4), (pack "s5", a5)]
+    createDirectoryIfMissing False "./test"
+    saveStore "./test/testSet" testSet -- keystore of images
+    print "Loading MegaStore testSet"
+    loadedContents <- loadStore "./test/testSet.megastore"
+    print "autoUnpack into ./test"
+    autoUnpack "./test" loadedContents
+    print "autoUnpack complete check folder"

+ megastore.cabal view

@@ -0,0 +1,80 @@+cabal-version: 1.12
++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           megastore+version:        0.1.0.0+synopsis:       Bulk image or strict bytestring storage+description:    Please see the README on GitHub at <https://github.com/MilesLitteral/megastore/tree/release#readme>+category:       Data Structures, Data, Image+homepage:       https://github.com/MilesLitteral/megastore#readme+bug-reports:    https://github.com/MilesLitteral/megastore/issues+author:         Miles J. Litteral+maintainer:     mandaloe2@gmail.com+copyright:      2023 Miles J. Litteral+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/MilesLitteral/megastore++library+  exposed-modules:+      MegaStore+  other-modules:+      Paths_megastore+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      JuicyPixels >3.3.4 && <=3.3.8+    , adjunctions >4.2 && <=4.4.2+    , base >=4.7 && <5+    , binary >0.8.0.0 && <=0.8.9.1+    , bytestring >0.10.0.0 && <=0.11.4.0+    , containers >=0.6.4.1 && <=0.6.7+    , directory >1.3.0.0 && <=1.3.8.0+    , ghc >=9.0.2 && <=9.4.2+    , hashable >1.2.3.0 && <=1.4.2.0+    , lens >5 && <=5.2+    , mtl >2.2 && <=2.2.2+    , random >=1.1 && <=1.2.1.1+    , text >=2.0 && <=2.0.2+    , text-show >=3.9.5 && <=3.10+    , vector >0.12.1.2 && <=0.13.0.0+    , zlib >0.6.0.0 && <=0.6.3.0+  default-language: Haskell2010++executable megastore+  main-is: Main.hs+  other-modules:+      Paths_megastore+  hs-source-dirs:+      app+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      JuicyPixels >3.3.4 && <=3.3.8+    , adjunctions >4.2 && <=4.4.2+    , base >=4.7 && <5+    , binary >0.8.0.0 && <=0.8.9.1+    , bytestring >0.10.0.0 && <=0.11.4.0+    , containers >=0.6.4.1 && <=0.6.7+    , directory >1.3.0.0 && <=1.3.8.0+    , ghc >=9.0.2 && <=9.4.2+    , hashable >1.2.3.0 && <=1.4.2.0+    , lens >5 && <=5.2+    , megastore+    , mtl >2.2 && <=2.2.2+    , random >=1.1 && <=1.2.1.1+    , text >=2.0 && <=2.0.2+    , text-show >=3.9.5 && <=3.10+    , vector >0.12.1.2 && <=0.13.0.0+    , zlib >0.6.0.0 && <=0.6.3.0+  default-language: Haskell2010

+ src/MegaStore.hs view

@@ -0,0 +1,161 @@+{-# LANGUAGE RankNTypes, FlexibleInstances, PolyKinds, TemplateHaskell, ScopedTypeVariables #-}
+
+{-|
+Module      : MegaStore
+Description : a haskell data and file type for efficient image storage 
+Copyright   : (c) Miles J. Litteral 2023
+License     : BSD-3
+Maintainer  : mandaloe2@gmail.com
+Stability   : release
+Portability : POSIX
+
+A Module for taking a directory of images (for example) and turning them into a key referencable data structure
+that will efficiently store all images. Here is a quick crash course:
+
+    @
+        a1  <- loadFile "s1.png"
+        a2  <- loadFile "s2.png"
+        a3  <- loadFile "s3.png"
+
+        let testSet = KeyStore [("s1", a1), ("s2", a2), ("s3", a3)]
+        saveStore "./test/testSet" testSet
+
+        loadedContents <- loadStore "./test/testSet.keystore"
+        autoUnpack "./results" loadedContents
+    @
+-}
+module MegaStore
+    (  -- * Data Types #Data Type#
+    MegaStore(..)
+    -- * I/O Functions     #Functions#
+    , saveStore
+    , loadStore
+    , loadFile
+    , loadDirectory
+    , createMegaStoreWithBulk
+    , unpackStore
+    , unpackStore'
+    , autoUnpack
+    -- ** Utility Functions #Functions#
+    , append
+    , search
+    , keyExists
+    , remove
+    , remove'
+    , megastoreToMap
+    , mapToMegaStore
+    ) where
+
+import Codec.Picture
+import Codec.Compression.GZip
+
+import Data.Either
+import Data.Binary
+import Data.Maybe ()
+import Data.List  (find)
+import Data.Map   (Map, toList, fromList)
+import Data.Text hiding (append, take, drop, map, find, filter, zip, length)
+import System.Directory
+import qualified Data.ByteString.Internal as BS
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BL
+
+import TextShow
+import Control.Lens
+import Control.Lens.TH ()
+
+-- | The MegaStore Data Type itself, fundamentally it is a List of Tuples
+newtype MegaStore =
+    MegaStore {
+        _contents :: [(Text, BS.ByteString)] -- ^ the contents of the MegaStore, while made for images it is acknowledged anything that satisfies the constraint/assertion may be a KeyStore
+    } deriving(Ord, Eq, Show)
+ 
+makeLenses ''MegaStore
+
+-- | The MegaStore Data Type's instance for serializing the data structure to file type,
+instance Binary MegaStore where
+      put (MegaStore cont) = put cont
+      get = MegaStore <$> get
+
+-- | Writes a MegaStore to physical memory, it does so via Data.ByteString.Lazy.WriteFile
+-- Where the data is compressed and encoded to Strict ByteStrings
+saveStore :: String -> MegaStore -> IO ()
+saveStore name store = BL.writeFile (name ++ ".megastore") (compress $ encode store)
+
+-- | Read a MegaStore from file system path, it reads the file, decodes, and decompresses the data
+loadStore :: FilePath -> IO MegaStore
+loadStore path = do
+    file <- BL.readFile path
+    return $ decode (decompress file)
+
+-- | Convert a ByteString back into it's original Image Data Type
+unpackStore :: BS.ByteString -> IO (Image PixelRGBA8)
+unpackStore byteString = case decodePng byteString of
+                                 Left  _   -> error "bad image"
+                                 Right img -> return $ convertRGBA8 img
+
+-- | Convert a ByteString back into it's original Image File Type 
+-- You have the added option of designating where the file will be savved
+unpackStore' :: String -> Image PixelRGBA8 -> IO ()
+unpackStore' unpackPath bytesS = writePng unpackPath bytesS
+
+-- | Similar to unpackStore' except that it will turn an entire MegaStore record into it's 
+-- Original Image File Type(s) and save the result at a designated file save path 
+autoUnpack :: String -> MegaStore -> IO ()
+autoUnpack savePath ks = do
+    createDirectoryIfMissing False savePath
+    let conts = map (\x -> (unpack $ fst x,  convertRGBA8 $ fromRight (error "bad") (decodePng $ snd x))) (_contents ks)
+    mapM_ (\x ->  unpackStore' (savePath ++ "/" ++ fst x ++ ".png") $ snd x) conts
+
+-- | Load an Image as a ByteString via Path
+loadFile :: FilePath -> IO BS.ByteString
+loadFile path = BS.readFile path
+
+-- | Load a directory of Images as ByteStrings via FilePath
+loadDirectory :: FilePath -> IO [BS.ByteString]
+loadDirectory folderPath = do
+  directory <- listDirectory folderPath
+  mapM (BS.readFile . (folderPath ++)) directory
+
+-- | Pass a List of ByteStrings (this is intended to work with loadImageDirectory), and a String for a naming scheme (ie: 'S' results in ['S0'..]) 
+-- Example (Loading a Directory all at once):
+-- @
+--     assets <- loadDirectory "./assets"
+--     saveStore "./test/testSet" $ createMegastoreWithBulk assets "s"
+
+--     loadedContents <- loadStore "./test/testSet.megastore"
+--     autoUnpack "./results" loadedContents
+-- @
+createMegaStoreWithBulk :: [BS.ByteString] -> Text -> MegaStore
+createMegaStoreWithBulk bytes nameScheme = MegaStore $ zip (map (\x -> showt $ unpack nameScheme ++ show (x :: Integer)) [0..(fromIntegral $ length bytes)]) bytes
+
+-- | Key can be Str here which will be hashed, either way 
+-- it will end up as a (String, BS.ByteString)
+append :: (Text, BS.ByteString) -> MegaStore -> MegaStore
+append info megastore = MegaStore $ info : (megastore ^. contents)
+
+-- | This takes a key and returns a strict bytestring if the key is valid, Nothing is returned otherwise
+search :: String -> [(Text, BS.ByteString)] -> Maybe BS.ByteString
+search a = fmap snd . find ((== showt a) . fst)
+
+-- | all the side effects of search come with this function
+keyExists :: String -> [(Text, BS.ByteString)] -> Bool
+keyExists a store = case search a store of
+    Nothing -> False
+    Just _  -> True
+
+-- | Search the entire store for a key and delete it's associated entry
+remove :: String -> MegaStore -> MegaStore
+remove str megastore = MegaStore $ filter ((== showt str) . fst) (megastore ^. contents)
+
+-- | Remove an entry by literal index in the MegaStore
+remove' :: Int -> MegaStore -> MegaStore
+remove' idx ls = MegaStore $ take idx (ls ^. contents) ++ drop (idx + 1) (ls ^. contents)
+
+-- | Convenience Function for easy conversion to a Data.Map
+megastoreToMap :: MegaStore -> Map Text BS.ByteString
+megastoreToMap k = fromList (_contents k)
+
+-- |  Convenience Function for easy conversion from a Data.Map
+mapToMegaStore :: Map Text BS.ByteString -> MegaStore 
+mapToMegaStore m = MegaStore $ toList m