{-# 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
    (  -- * Records #Records#

    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 {
        MegaStore -> [(Text, ByteString)]
_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(Eq MegaStore
MegaStore -> MegaStore -> Bool
MegaStore -> MegaStore -> Ordering
MegaStore -> MegaStore -> MegaStore
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MegaStore -> MegaStore -> MegaStore
$cmin :: MegaStore -> MegaStore -> MegaStore
max :: MegaStore -> MegaStore -> MegaStore
$cmax :: MegaStore -> MegaStore -> MegaStore
>= :: MegaStore -> MegaStore -> Bool
$c>= :: MegaStore -> MegaStore -> Bool
> :: MegaStore -> MegaStore -> Bool
$c> :: MegaStore -> MegaStore -> Bool
<= :: MegaStore -> MegaStore -> Bool
$c<= :: MegaStore -> MegaStore -> Bool
< :: MegaStore -> MegaStore -> Bool
$c< :: MegaStore -> MegaStore -> Bool
compare :: MegaStore -> MegaStore -> Ordering
$ccompare :: MegaStore -> MegaStore -> Ordering
Ord, MegaStore -> MegaStore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MegaStore -> MegaStore -> Bool
$c/= :: MegaStore -> MegaStore -> Bool
== :: MegaStore -> MegaStore -> Bool
$c== :: MegaStore -> MegaStore -> Bool
Eq, Int -> MegaStore -> ShowS
[MegaStore] -> ShowS
MegaStore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MegaStore] -> ShowS
$cshowList :: [MegaStore] -> ShowS
show :: MegaStore -> String
$cshow :: MegaStore -> String
showsPrec :: Int -> MegaStore -> ShowS
$cshowsPrec :: Int -> MegaStore -> ShowS
Show)
 
makeLenses ''MegaStore

-- | The MegaStore Data Type's instance for serializing the data structure to file type,

instance Binary MegaStore where
      put :: MegaStore -> Put
put (MegaStore [(Text, ByteString)]
cont) = forall t. Binary t => t -> Put
put [(Text, ByteString)]
cont
      get :: Get MegaStore
get = [(Text, ByteString)] -> MegaStore
MegaStore forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
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 :: String -> MegaStore -> IO ()
saveStore String
name MegaStore
store = String -> ByteString -> IO ()
BL.writeFile (String
name forall a. [a] -> [a] -> [a]
++ String
".megastore") (ByteString -> ByteString
compress forall a b. (a -> b) -> a -> b
$ forall a. Binary a => a -> ByteString
encode MegaStore
store)

-- | Read a MegaStore from file system path, it reads the file, decodes, and decompresses the data

loadStore :: FilePath -> IO MegaStore
loadStore :: String -> IO MegaStore
loadStore String
path = do
    ByteString
file <- String -> IO ByteString
BL.readFile String
path
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Binary a => ByteString -> a
decode (ByteString -> ByteString
decompress ByteString
file)

-- | Convert a ByteString back into it's original Image Data Type

unpackStore :: BS.ByteString -> IO (Image PixelRGBA8)
unpackStore :: ByteString -> IO (Image PixelRGBA8)
unpackStore ByteString
byteString = case ByteString -> Either String DynamicImage
decodePng ByteString
byteString of
                                 Left  String
_   -> forall a. HasCallStack => String -> a
error String
"bad image"
                                 Right DynamicImage
img -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DynamicImage -> Image PixelRGBA8
convertRGBA8 DynamicImage
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' :: String -> Image PixelRGBA8 -> IO ()
unpackStore' String
unpackPath Image PixelRGBA8
bytesS = forall pixel. PngSavable pixel => String -> Image pixel -> IO ()
writePng String
unpackPath Image PixelRGBA8
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 :: String -> MegaStore -> IO ()
autoUnpack String
savePath MegaStore
ks = do
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
savePath
    let conts :: [(String, Image PixelRGBA8)]
conts = forall a b. (a -> b) -> [a] -> [b]
map (\(Text, ByteString)
x -> (Text -> String
unpack forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Text, ByteString)
x,  DynamicImage -> Image PixelRGBA8
convertRGBA8 forall a b. (a -> b) -> a -> b
$ forall b a. b -> Either a b -> b
fromRight (forall a. HasCallStack => String -> a
error String
"bad") (ByteString -> Either String DynamicImage
decodePng forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (Text, ByteString)
x))) (MegaStore -> [(Text, ByteString)]
_contents MegaStore
ks)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(String, Image PixelRGBA8)
x ->  String -> Image PixelRGBA8 -> IO ()
unpackStore' (String
savePath forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall a b. (a, b) -> a
fst (String, Image PixelRGBA8)
x forall a. [a] -> [a] -> [a]
++ String
".png") forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (String, Image PixelRGBA8)
x) [(String, Image PixelRGBA8)]
conts

-- | Load an Image as a ByteString via Path

loadFile :: FilePath -> IO BS.ByteString
loadFile :: String -> IO ByteString
loadFile String
path = String -> IO ByteString
BS.readFile String
path

-- | Load a directory of Images as ByteStrings via FilePath

loadDirectory :: FilePath -> IO [BS.ByteString]
loadDirectory :: String -> IO [ByteString]
loadDirectory String
folderPath = do
  [String]
directory <- String -> IO [String]
listDirectory String
folderPath
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> IO ByteString
BS.readFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
folderPath forall a. [a] -> [a] -> [a]
++)) [String]
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 :: [ByteString] -> Text -> MegaStore
createMegaStoreWithBulk [ByteString]
bytes Text
nameScheme = [(Text, ByteString)] -> MegaStore
MegaStore forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (\Integer
x -> forall a. TextShow a => a -> Text
showt forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
nameScheme forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Integer
x :: Integer)) [Integer
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
bytes)]) [ByteString]
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 :: (Text, ByteString) -> MegaStore -> MegaStore
append (Text, ByteString)
info MegaStore
megastore = [(Text, ByteString)] -> MegaStore
MegaStore forall a b. (a -> b) -> a -> b
$ (Text, ByteString)
info forall a. a -> [a] -> [a]
: (MegaStore
megastore forall s a. s -> Getting a s a -> a
^. Iso' MegaStore [(Text, ByteString)]
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 :: String -> [(Text, ByteString)] -> Maybe ByteString
search String
a = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== forall a. TextShow a => a -> Text
showt String
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- | all the side effects of search come with this function

keyExists :: String -> [(Text, BS.ByteString)] -> Bool
keyExists :: String -> [(Text, ByteString)] -> Bool
keyExists String
a [(Text, ByteString)]
store = case String -> [(Text, ByteString)] -> Maybe ByteString
search String
a [(Text, ByteString)]
store of
    Maybe ByteString
Nothing -> Bool
False
    Just ByteString
_  -> Bool
True

-- | Search the entire store for a key and delete it's associated entry

remove :: String -> MegaStore -> MegaStore
remove :: String -> MegaStore -> MegaStore
remove String
str MegaStore
megastore = [(Text, ByteString)] -> MegaStore
MegaStore forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== forall a. TextShow a => a -> Text
showt String
str) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (MegaStore
megastore forall s a. s -> Getting a s a -> a
^. Iso' MegaStore [(Text, ByteString)]
contents)

-- | Remove an entry by literal index in the MegaStore

remove' :: Int -> MegaStore -> MegaStore
remove' :: Int -> MegaStore -> MegaStore
remove' Int
idx MegaStore
ls = [(Text, ByteString)] -> MegaStore
MegaStore forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
idx (MegaStore
ls forall s a. s -> Getting a s a -> a
^. Iso' MegaStore [(Text, ByteString)]
contents) forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop (Int
idx forall a. Num a => a -> a -> a
+ Int
1) (MegaStore
ls forall s a. s -> Getting a s a -> a
^. Iso' MegaStore [(Text, ByteString)]
contents)

-- | Convenience Function for easy conversion to a Data.Map

megastoreToMap :: MegaStore -> Map Text BS.ByteString
megastoreToMap :: MegaStore -> Map Text ByteString
megastoreToMap MegaStore
k = forall k a. Ord k => [(k, a)] -> Map k a
fromList (MegaStore -> [(Text, ByteString)]
_contents MegaStore
k)

-- |  Convenience Function for easy conversion from a Data.Map

mapToMegaStore :: Map Text BS.ByteString -> MegaStore 
mapToMegaStore :: Map Text ByteString -> MegaStore
mapToMegaStore Map Text ByteString
m = [(Text, ByteString)] -> MegaStore
MegaStore forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
toList Map Text ByteString
m