Verified Commit cdf9aaa4 authored by Camil Staps's avatar Camil Staps 🚀

Add Database.Native

parent 52347372
Pipeline #11239 passed with stage
in 1 minute and 36 seconds
definition module Database.Native
/**
* This module provides types and functions to build a database on the native
* Clean heap. It can be tedious to add new entries, but access is fast. and
* only little memory is used.
*/
from StdOverloaded import class ==, class <
from Data.Map import :: Map
from Data.Maybe import :: Maybe
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
/**
* A database. Entries can be soft deleted. Entries are indexed with integers
* which can be difficult to work with but at least provide constant time
* access.
* Annotations are not designed to be persistent. If you need to add persistent
* data to the database use a map over values.
*
* @var The type of values stored.
* @var The key type of annotations.
* @var The type of annotations.
*/
:: *NativeDB v ak a
:: Index =: Index Int
:: Entry v ak a =
{ value :: !v
, included :: !Bool
, annotations :: !Map ak a
}
instance == Index
instance < Index
/**
* Two search modes are available.
*/
:: SearchMode
= Intersect //* Only consider included entries (i.e., an AND with previous searches)
| AddExcluded //* Re-include matching entries but don't remove non-matching entries (i.e., an OR with previous searches)
/**
* Create a new database from a list of entries.
*/
newDB :: ![v] -> *NativeDB v ak a
/**
* Save the database to a file.
*/
saveDB :: !*(NativeDB v ak a) !*File -> *(!*NativeDB v ak a, !*File) | JSONEncode{|*|} v
/**
* Open a database from a file.
*/
openDB :: !*File -> *(!Maybe (*NativeDB v ak a), !*File) | JSONDecode{|*|} v
/**
* Reset all entries to included.
*/
resetDB :: !*(NativeDB v ak a) -> *NativeDB v ak a
/**
* Return all entries (whether they have been excluded or not).
*/
allEntries :: !*(NativeDB v ak a) -> *(![v], !*NativeDB v ak a)
/**
* Get all entries that are still included, and their annotations.
*/
getEntries :: !*(NativeDB v ak a) -> *(![(v, Map ak a)], !*NativeDB v ak a)
/**
* An in-place map over all entries (also the excluded ones).
*/
mapInPlace :: !(Int v -> v) !*(NativeDB v ak a) -> *(NativeDB v ak a)
/**
* Linear search for entries. The search function returns whether the entry
* should be included and which annotations should be added (if any). Excluded
* entries are ignored.
*/
search :: !SearchMode !(v -> (Bool, [(ak, a)])) !*(NativeDB v ak a) -> *NativeDB v ak a | ==, < ak
/**
* Like {{`search`}}, but search for specific indices.
*/
searchIndices :: !SearchMode ![(!Index, ![(!ak, !a)])] !*(NativeDB v ak a) -> *NativeDB v ak a | ==, < ak
/**
* Exclude a list of indices.
*/
unsearchIndices :: ![Index] !*(NativeDB v ak a) -> *NativeDB v ak a
/**
* Like {{`searchIndices`}}, but also check on some property.
* This search always uses the {{`AddExcluded`}} {{`SearchMode`}}.
*/
searchWithIndices :: !(v -> (Bool, ![(!ak, !a)])) ![Index] !*(NativeDB v ak a) -> *NativeDB v ak a | ==, < ak
/**
* Get an entry and its annotations.
* Also see {{`getIndices`}}.
*/
getIndex :: !Index !*(NativeDB v ak a) -> *(!Entry v ak a, !*(NativeDB v ak a))
/**
* Like {{`getIndex`}}, but for a list of indices.
*/
getIndices :: ![Index] !*(NativeDB v ak a) -> *(![Entry v ak a], !*(NativeDB v ak a))
implementation module Database.Native
import StdArray
import StdBool
import StdFile
import StdInt
import StdString
import StdTuple
from Data.Func import $, hyperstrict
import Data.Functor
import Data.Map
import Data.Maybe
import Text.GenJSON
:: *NativeDB v ak a = DB *{!Entry v ak a}
instance == Index where == (Index a) (Index b) = a == b
instance < Index where < (Index a) (Index b) = a < b
newDB :: ![v] -> *NativeDB v ak a
newDB vs = DB {{value=hyperstrict v,included=True,annotations=newMap} \\ v <- vs}
saveDB :: !*(NativeDB v ak a) !*File -> *(!*NativeDB v ak a, !*File) | JSONEncode{|*|} v
saveDB (DB db) f
# (s,db) = usize db
# f = f <<< toString s <<< "\n"
# (db,f) = loop 0 (s-1) db f
= (DB db, f)
where
loop :: !Int !Int !*{!Entry v ak a} !*File -> *(*{!Entry v ak a}, !*File) | JSONEncode{|*|} v
loop i s es f
| i > s = (es,f)
# (e,es) = es![i]
# f = f <<< toJSON e.value <<< '\n'
= loop (i+1) s es f
openDB :: !*File -> *(!Maybe (*NativeDB v ak a), !*File) | JSONDecode{|*|} v
openDB f
# (line,f) = freadline f
# n = toInt (line % (0, size line - 2))
# (es,f) = loop n f
= case es of
Nothing -> (Nothing, f)
Just es -> (Just $ newDB es, f)
where
loop :: !Int !*File -> *(Maybe [v], !*File) | JSONDecode{|*|} v
loop 0 f = (Just [], f)
loop n f
# (end,f) = fend f
| end = (Nothing, f)
# (line,f) = freadline f
= case fromJSON $ fromString line of
Nothing -> (Nothing, f)
Just e -> case loop (n-1) f of
(Nothing, f) -> (Nothing, f)
(Just es, f) -> (Just [e:es], f)
resetDB :: !*(NativeDB v ak a) -> *NativeDB v ak a
resetDB (DB db)
# (s,db) = usize db
# db = upd (s-1) db
= DB db
where
upd :: !Int !*{!Entry v ak a} -> *{!Entry v ak a}
upd -1 es = es
upd i es
# (e,es) = es![i]
= upd (i-1) {es & [i]={e & included=True}}
allEntries :: !*(NativeDB v ak a) -> *(![v], !*NativeDB v ak a)
allEntries (DB db)
# (s,db) = usize db
# (es,db) = collect (s-1) db
= (es, DB db)
where
collect :: !Int !*{!Entry v ak a} -> *(![v], !*{!Entry v ak a})
collect -1 es = ([], es)
collect i es
# (e,es) = es![i]
# (r,es) = collect (i-1) es
= ([e.value:r], es)
getEntries :: !*(NativeDB v ak a) -> *(![(v, Map ak a)], !*NativeDB v ak a)
getEntries (DB db)
# (s,db) = usize db
# (es,db) = collect (s-1) db
= (es,DB db)
where
collect :: !Int !*{!Entry v ak a} -> *(![(v, Map ak a)], !*{!Entry v ak a})
collect -1 es = ([], es)
collect i es
# (e,es) = es![i]
# (r,es) = collect (i-1) es
= (if e.included [(e.value,e.annotations):r] r, es)
mapInPlace :: !(Int v -> v) !*(NativeDB v ak a) -> *(NativeDB v ak a)
mapInPlace f (DB db)
# (s,db) = usize db
= DB (upd 0 s db)
where
//upd :: !Int !Int !*{!Entry v ak a} -> *{!Entry v ak a}
upd i s es
| i == s = es
#! (e,es) = es![i]
#! e & value = hyperstrict $ f i e.value
= upd (i+1) s {es & [i]=e}
search :: !SearchMode !(v -> (Bool, [(ak, a)])) !*(NativeDB v ak a) -> *NativeDB v ak a | ==, < ak
search mode f (DB db)
# (s,db) = usize db
= DB (upd (s - 1) db)
where
//upd :: (!Int !*{!Entry v ak a} -> *{!Entry v ak a}) | ==, < ak
upd = case mode of
Intersect -> intersect
AddExcluded -> addExcluded
intersect -1 es = es
intersect i es
# (e,es) = es![i]
| not e.included = intersect (i-1) es
# (include,annotations) = f e.value
= intersect (i-1) {es & [i]=
{ e
& included=include
, annotations=foldr (uncurry put) e.annotations annotations
}}
addExcluded -1 es = es
addExcluded i es
# (e,es) = es![i]
# (include,annotations) = f e.value
= addExcluded (i-1) {es & [i]=
{ e
& included=e.included || include
, annotations=foldr (uncurry put) e.annotations annotations
}}
searchIndices :: !SearchMode ![(!Index, ![(!ak, !a)])] !*(NativeDB v ak a) -> *NativeDB v ak a | ==, < ak
searchIndices mode idxs (DB db)
# (s,db) = usize db
# db = upd 0 (s-1) idxs db
= (DB db)
where
upd :: !Int !Int ![(!Index, ![(!ak, !a)])] !*{!Entry v ak a} -> *{!Entry v ak a} | ==, < ak
upd i s _ es
| i > s = es
upd i s [] es
| mode=:AddExcluded = es
# (e,es) = es![i]
= upd (i+1) s [] {es & [i]={e & included=False}}
upd i s allidxs=:[match=:(Index idx,annots):idxs] es
# (e,es) = es![i]
# e & included = case mode of
Intersect -> e.included && match
AddExcluded -> e.included || match
# e & annotations = if e.included (foldr (uncurry put) e.annotations annots) e.annotations
= upd (i+1) s (if match idxs allidxs) {es & [i]=e}
where
match = i == idx
unsearchIndices :: ![Index] !*(NativeDB v ak a) -> *NativeDB v ak a
unsearchIndices idxs (DB db)
# db = upd idxs db
= (DB db)
where
upd :: ![Index] !*{!Entry v ak a} -> *{!Entry v ak a}
upd [] es = es
upd [Index i:is] es
# (e,es) = es![i]
= upd is {es & [i].included=False}
searchWithIndices :: !(v -> (Bool, ![(!ak, !a)])) ![Index] !*(NativeDB v ak a) -> *NativeDB v ak a | ==, < ak
searchWithIndices prop idxs (DB db)
# db = upd idxs db
= (DB db)
where
upd [] es = es
upd [Index i:is] es
# (e,es) = es![i]
# e = case prop e.value of
(False, _) -> {e & included=False}
(True, annots) -> {e & included=True, annotations=foldr (uncurry put) e.annotations annots}
= upd is {es & [i]=e}
getIndex :: !Index !*(NativeDB v ak a) -> *(!Entry v ak a, !*(NativeDB v ak a))
getIndex (Index n) (DB db)
# (e,db) = db![n]
= (e, DB db)
getIndices :: ![Index] !*(NativeDB v ak a) -> *(![Entry v ak a], !*(NativeDB v ak a))
getIndices is (DB db)
# (es,db) = get is db
= (es, DB db)
where
get :: ![Index] !*{!Entry v ak a} -> *(![Entry v ak a], !*{!Entry v ak a})
get [] db = ([], db)
get [Index i:is] db
# (e,db) = db![i]
# (es,db) = get is db
= ([e:es], db)
......@@ -93,6 +93,7 @@ import qualified Data.Tuple
import qualified Data.Word8
import qualified Data._Array
import qualified Data.Generics
import qualified Database.Native
import qualified Database.SQL
import qualified Database.SQL.MySQL
import qualified Database.SQL.RelationalMapping
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment