content: {-# LANGUAGE JavaScriptFFI #-}
  -- | Saving/loading to JS storeage, mimicking operations on files.
  module Game.LambdaHack.Common.JSFile
    (
  #ifdef USE_JSFILE
  -- to molify doctest, but don't break stylish-haskell parsing
      encodeEOF, strictDecodeEOF
    , tryCreateDir, doesFileExist, tryWriteFile, readFile, renameFile
  #endif
    ) where
  
  #ifdef USE_JSFILE
  import Prelude ()
  
  import Game.LambdaHack.Core.Prelude
  
  import           Data.Binary
  import qualified Data.ByteString.Lazy.Char8 as LBS
  import qualified Data.Text as T
  import           Data.Text.Encoding (decodeLatin1)
  import           Data.Version
  
  import qualified Data.JSString as JSString
  import           Data.JSString.Text (textToJSString)
  import           GHCJS.DOM (currentWindow)
  import           GHCJS.DOM.Storage (getItem, removeItem, setItem)
  import           GHCJS.DOM.Types (JSString, runDOM)
  import           GHCJS.DOM.Window (getLocalStorage)
  
  foreign import javascript safe "$r = LZString.compressToUTF16($1);"
    compressToUTF16 :: JSString -> IO JSString
  
  foreign import javascript safe "$r = LZString.decompressFromUTF16($1);"
    decompressFromUTF16 :: JSString -> IO JSString
  
  -- | Serialize and save data with an EOF marker, compressing.
  -- We treat the bytestring as Latin1 characters and so ensure
  -- we never run into illegal characters in the aribtrary binary data,
  -- unlike when treating it as UTF16 characters. This is also reasonably fast.
  -- The @OK@ is used as an EOF marker to ensure any apparent problems with
  -- corrupted files are reported to the user ASAP.
  encodeEOF :: Binary b => FilePath -> Version -> b -> IO ()
  encodeEOF path v b = flip runDOM undefined $ do
    Just win <- currentWindow
    storage <- getLocalStorage win
    let t = decodeLatin1 $ LBS.toStrict $ encode (v, (encode b, "OK" :: String))
    item <- compressToUTF16 $ textToJSString t
    setItem storage path item
  
  -- | Read and deserialize data with an EOF marker.
  -- The @OK@ EOF marker ensures any easily detectable file corruption
  -- is discovered and reported before any value is decoded from
  -- the second component.
  -- OTOH, binary encoding corruption is not discovered until a version
  -- check elsewhere ensures that binary formats are compatible.
  strictDecodeEOF :: Binary b => FilePath -> IO (Version, b)
  strictDecodeEOF path = flip runDOM undefined $ do
    Just win <- currentWindow
    storage <- getLocalStorage win
    Just item <- getItem storage path
    t <- decompressFromUTF16 item
    -- TODO: is @LBS.toLazy . encodeUtf8 . textFromJSString@ faster and correct?
    let c1 = LBS.pack $ JSString.unpack t
        (v1, (c2, s)) = decode c1
    return $! if s == ("OK" :: String)
              then (v1, decode c2)
              else error $ "Fatal error: corrupted file " ++ path
  
  -- | Try to create a directory; not needed with local storage in JS.
  tryCreateDir :: FilePath -> IO ()
  tryCreateDir _dir = return ()
  
  doesFileExist :: FilePath -> IO Bool
  doesFileExist path = flip runDOM undefined $ do
    Just win <- currentWindow
    storage <- getLocalStorage win
    mitem <- getItem storage path
    let fileExists = isJust (mitem :: Maybe String)
    return $! fileExists
  
  tryWriteFile :: FilePath -> String -> IO ()
  tryWriteFile path content = flip runDOM undefined $ do
    Just win <- currentWindow
    storage <- getLocalStorage win
    mitem <- getItem storage path
    let fileExists = isJust (mitem :: Maybe String)
    unless fileExists $
      setItem storage path $ T.unpack content
  
  readFile :: FilePath -> IO String
  readFile path = flip runDOM undefined $ do
    Just win <- currentWindow
    storage <- getLocalStorage win
    mitem <- getItem storage path
    case mitem of
      Nothing -> fail $ "Fatal error: no file " ++ path
      Just item -> return item
  
  renameFile :: FilePath -> FilePath -> IO ()
  renameFile path path2 = flip runDOM undefined $ do
    Just win <- currentWindow
    storage <- getLocalStorage win
    mitem <- getItem storage path
    case mitem :: Maybe String of
      Nothing -> fail $ "Fatal error: no file " ++ path
      Just item -> do
        setItem storage path2 item  -- overwrites
        removeItem storage path
  #endif
  