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 ...@@ -93,6 +93,7 @@ import qualified Data.Tuple
import qualified Data.Word8 import qualified Data.Word8
import qualified Data._Array import qualified Data._Array
import qualified Data.Generics import qualified Data.Generics
import qualified Database.Native
import qualified Database.SQL import qualified Database.SQL
import qualified Database.SQL.MySQL import qualified Database.SQL.MySQL
import qualified Database.SQL.RelationalMapping 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