You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

150 lines
4.2 KiB

module StorageWrapper exposing ( init
, addHandler
, handleItem
, handleItemWithDefault
, handleKeyList
, handleItemNotFound
, handleError
, update
, subscribe
, getItem
, setItem
, clear
, listKeys
, Error
, Handler
, LSOps
)
import LocalStoragePorts as Ports
import LocalStorage exposing (LocalStorage, Response)
import Json.Decode as D
import Json.Encode as E
type alias LSOps = Response
type Sled msg
= Done msg
| DecodeError D.Error
| Pass
type alias Handler msg =
{ portHandle : LocalStorage LSOps
, responseHandlers : List (LSOps -> Sled msg)
}
type Error
= JsonDecode D.Error
| UnhandledResponse Response
init : String -> Handler msg
init pfx =
Handler (Ports.make pfx) []
addHandler : Handler msg -> (LSOps -> Sled msg) -> Handler msg
addHandler handler proc =
let hlers = handler.responseHandlers in
{ handler | responseHandlers = proc :: hlers}
handleItem : String -> D.Decoder a -> (a -> msg) -> Handler msg -> Handler msg
handleItem key decoder wrapper handler=
addHandler handler
(\r ->
case r of
LocalStorage.Item k v ->
if k == key then
case D.decodeValue decoder v of
Ok val -> Done (wrapper val)
Err e -> DecodeError e
else
Pass
_ -> Pass
)
handleItemWithDefault : String -> D.Decoder a -> a -> (a -> msg) -> Handler msg
-> Handler msg
handleItemWithDefault key decoder default wrapper handler =
addHandler handler
(\r ->
case r of
LocalStorage.Item k v ->
if k == key then
let val = D.decodeValue decoder v in
Done (wrapper
<| Result.withDefault default val)
else
Pass
_ -> Pass
)
handleKeyList : (List String -> msg) -> Handler msg -> Handler msg
handleKeyList wrapper handler =
addHandler handler
(\r ->
case r of
LocalStorage.KeyList list ->
Done (wrapper list)
_ -> Pass
)
handleItemNotFound : String -> msg -> Handler msg -> Handler msg
handleItemNotFound key wrapper handler =
addHandler handler
(\r ->
case r of
LocalStorage.ItemNotFound k ->
if k == key then Done wrapper
else Pass
_ -> Pass
)
handleError : (String -> msg) -> Handler msg -> Handler msg
handleError wrapper handler =
addHandler handler
(\r ->
case r of
LocalStorage.Error err ->
Done (wrapper err)
_ -> Pass
)
update : Handler msg -> LSOps -> Result Error msg
update handler response =
let runner = (\h sl -> case sl of
Pass -> h response
DecodeError _ -> sl
Done _ -> sl ) in
case List.foldl runner Pass handler.responseHandlers of
Pass -> Err <| UnhandledResponse response
DecodeError err -> Err <| JsonDecode err
Done v -> Ok v
subscribe : Handler msg -> (LSOps -> resp) -> Sub resp
subscribe handler respWrapper =
Sub.map respWrapper
( handler.portHandle
|> LocalStorage.responseHandler identity
|> Ports.response
)
getItem : Handler msg -> String -> (LSOps -> resp) -> Cmd resp
getItem handler key wrapper =
LocalStorage.getItem handler.portHandle key
|> Cmd.map wrapper
clear : Handler msg -> (LSOps -> resp) -> Cmd resp
clear handler wrapper =
LocalStorage.clear handler.portHandle
|> Cmd.map wrapper
setItem : Handler msg -> String -> E.Value -> (LSOps -> resp) -> Cmd resp
setItem handler key value wrapper =
LocalStorage.setItem handler.portHandle key value
|> Cmd.map wrapper
listKeys : Handler msg -> String -> (LSOps -> resp) -> Cmd resp
listKeys handler pfx wrapper =
LocalStorage.listKeys handler.portHandle pfx
|> Cmd.map wrapper