{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Miso.Storage
(
getLocalStorage
, setLocalStorage
, removeLocalStorage
, clearLocalStorage
, localStorageLength
, getSessionStorage
, setSessionStorage
, removeSessionStorage
, clearSessionStorage
, sessionStorageLength
) where
import Control.Monad (void)
import Data.Aeson (FromJSON(..), ToJSON, fromJSON)
import qualified Data.Aeson as A
import Language.Javascript.JSaddle hiding (obj, val)
import Miso.FFI.Internal (jsonParse, jsonStringify)
import Miso.String (MisoString, ms)
getStorageCommon
:: FromJSON b
=> (t -> JSM (Maybe JSVal))
-> t
-> JSM (Either String b)
getStorageCommon :: forall b t.
FromJSON b =>
(t -> JSM (Maybe JSVal)) -> t -> JSM (Either String b)
getStorageCommon t -> JSM (Maybe JSVal)
f t
key = do
result <- t -> JSM (Maybe JSVal)
f t
key
case result of
Maybe JSVal
Nothing ->
Either String b -> JSM (Either String b)
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String b
forall a b. a -> Either a b
Left String
"Not Found")
Just JSVal
v -> do
r <- JSVal -> JSM Value
forall json. FromJSON json => JSVal -> JSM json
jsonParse JSVal
v
pure $ case fromJSON r of
A.Success b
x -> b -> Either String b
forall a b. b -> Either a b
Right b
x
A.Error String
y -> String -> Either String b
forall a b. a -> Either a b
Left String
y
getSessionStorage
:: FromJSON model
=> MisoString
-> JSM (Either String model)
getSessionStorage :: forall model.
FromJSON model =>
MisoString -> JSM (Either String model)
getSessionStorage =
(MisoString -> JSM (Maybe JSVal))
-> MisoString -> JSM (Either String model)
forall b t.
FromJSON b =>
(t -> JSM (Maybe JSVal)) -> t -> JSM (Either String b)
getStorageCommon ((MisoString -> JSM (Maybe JSVal))
-> MisoString -> JSM (Either String model))
-> (MisoString -> JSM (Maybe JSVal))
-> MisoString
-> JSM (Either String model)
forall a b. (a -> b) -> a -> b
$ \MisoString
t -> do
s <- JSM Storage
sessionStorage
r <- getItem s t
fromJSVal r
getLocalStorage
:: FromJSON model
=> MisoString
-> JSM (Either String model)
getLocalStorage :: forall model.
FromJSON model =>
MisoString -> JSM (Either String model)
getLocalStorage = (MisoString -> JSM (Maybe JSVal))
-> MisoString -> JSM (Either String model)
forall b t.
FromJSON b =>
(t -> JSM (Maybe JSVal)) -> t -> JSM (Either String b)
getStorageCommon ((MisoString -> JSM (Maybe JSVal))
-> MisoString -> JSM (Either String model))
-> (MisoString -> JSM (Maybe JSVal))
-> MisoString
-> JSM (Either String model)
forall a b. (a -> b) -> a -> b
$ \MisoString
t -> do
s <- JSM Storage
localStorage
r <- getItem s t
fromJSVal r
setLocalStorage
:: ToJSON model
=> MisoString
-> model
-> JSM ()
setLocalStorage :: forall model. ToJSON model => MisoString -> model -> JSM ()
setLocalStorage MisoString
key model
model = do
s <- JSM Storage
localStorage
setItem s key =<< jsonStringify model
setSessionStorage
:: ToJSON model
=> MisoString
-> model
-> JSM ()
setSessionStorage :: forall model. ToJSON model => MisoString -> model -> JSM ()
setSessionStorage MisoString
key model
model = do
s <- JSM Storage
sessionStorage
setItem s key =<< jsonStringify model
removeLocalStorage
:: MisoString
-> JSM ()
removeLocalStorage :: MisoString -> JSM ()
removeLocalStorage MisoString
key = do
s <- JSM Storage
localStorage
removeItem s key
removeSessionStorage
:: MisoString
-> JSM ()
removeSessionStorage :: MisoString -> JSM ()
removeSessionStorage MisoString
key = do
s <- JSM Storage
sessionStorage
removeItem s key
clearLocalStorage :: JSM ()
clearLocalStorage :: JSM ()
clearLocalStorage = Storage -> JSM ()
clear (Storage -> JSM ()) -> JSM Storage -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM Storage
localStorage
clearSessionStorage :: JSM ()
clearSessionStorage :: JSM ()
clearSessionStorage = Storage -> JSM ()
clear (Storage -> JSM ()) -> JSM Storage -> JSM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM Storage
sessionStorage
localStorageLength :: JSM Int
localStorageLength :: JSM Int
localStorageLength = JSVal -> JSM Int
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Int) -> JSM JSVal -> JSM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM Storage
localStorage JSM Storage -> MisoString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms String
"length")
sessionStorageLength :: JSM Int
sessionStorageLength :: JSM Int
sessionStorageLength = JSVal -> JSM Int
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Int) -> JSM JSVal -> JSM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM Storage
sessionStorage JSM Storage -> MisoString -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! (String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms String
"length")
localStorage :: JSM Storage
localStorage :: JSM Storage
localStorage = JSVal -> Storage
Storage (JSVal -> Storage) -> JSM JSVal -> JSM Storage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"window" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"localStorage")
sessionStorage :: JSM Storage
sessionStorage :: JSM Storage
sessionStorage = JSVal -> Storage
Storage (JSVal -> Storage) -> JSM JSVal -> JSM Storage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"window" JSM JSVal -> String -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! String
"sessionStorage")
getItem :: Storage -> MisoString -> JSM JSVal
getItem :: Storage -> MisoString -> JSM JSVal
getItem (Storage JSVal
s) MisoString
key = JSVal
s JSVal -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"getItem" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
key]
removeItem :: Storage -> MisoString -> JSM ()
removeItem :: Storage -> MisoString -> JSM ()
removeItem (Storage JSVal
s) MisoString
key = JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal
s JSVal -> String -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"removeItem" ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ [MisoString
key]
setItem :: Storage -> MisoString -> MisoString -> JSM ()
setItem :: Storage -> MisoString -> MisoString -> JSM ()
setItem (Storage JSVal
s) MisoString
key MisoString
val = do
_ <- JSVal
s JSVal -> String -> (MisoString, MisoString) -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"setItem" ((MisoString, MisoString) -> JSM JSVal)
-> (MisoString, MisoString) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (MisoString
key, MisoString
val)
pure ()
clear :: Storage -> JSM ()
clear :: Storage -> JSM ()
clear (Storage JSVal
s) = do
_ <- JSVal
s JSVal -> String -> () -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# String
"clear" (() -> JSM JSVal) -> () -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ ()
pure ()
newtype Storage = Storage JSVal
deriving (Storage -> JSM Object
(Storage -> JSM Object) -> MakeObject Storage
forall this. (this -> JSM Object) -> MakeObject this
$cmakeObject :: Storage -> JSM Object
makeObject :: Storage -> JSM Object
MakeObject, [Storage] -> JSM JSVal
Storage -> JSM JSVal
(Storage -> JSM JSVal)
-> ([Storage] -> JSM JSVal) -> ToJSVal Storage
forall a. (a -> JSM JSVal) -> ([a] -> JSM JSVal) -> ToJSVal a
$ctoJSVal :: Storage -> JSM JSVal
toJSVal :: Storage -> JSM JSVal
$ctoJSValListOf :: [Storage] -> JSM JSVal
toJSValListOf :: [Storage] -> JSM JSVal
ToJSVal)