{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

module Api
  ( fetchCollections,
    fetchSchema,
    fetchSchemaVersion,
    fetchPosts,
    fetchPost,
    updatePost,
  )
where

#ifndef ghcjs_HOST_OS
import Data.String
import Network.HTTP.Simple
#else
import Data.ByteString.Char8 qualified as B
import Data.Maybe
import Data.String
import JavaScript.Web.XMLHttpRequest
import Miso.String qualified as J
#endif
import Data.Aeson qualified as A
import Data.ByteString.Lazy.Char8 qualified as LB
import Data.ByteString.Lazy.UTF8 qualified as LB
import Data.Function
import Miso
import Safe
import Schema
import Version

fetchCollections :: JSM (Either String [String])
fetchCollections =
  A.eitherDecode <$> fetch (fromString "http://localhost:8081/collections")

fetchSchemaVersion :: JSM (Either String Version)
fetchSchemaVersion =
  A.eitherDecode <$> fetch (fromString "http://localhost:8081/schemaVersion")

fetchSchema :: JSM (Either String Schema)
fetchSchema =
  A.eitherDecode <$> fetch (fromString "http://localhost:8081/posts.schema.json")

fetchPosts :: JSM (Either String [A.Value])
fetchPosts =
  A.eitherDecode
    <$> fetch
      ( fromString "http://localhost:8081"
          & setRequestMethod "POST"
          & setRequestBodyLBS "SELECT posts FROM posts"
      )

fetchPost :: String -> JSM (Either String (Maybe A.Value))
fetchPost fileName =
  fmap headMay . A.eitherDecode
    <$> fetch
      ( fromString "http://localhost:8081"
          & setRequestMethod "POST"
          & setRequestBodyLBS ("SELECT posts FROM posts WHERE posts.$fileName == \"" <> LB.fromString fileName <> "\"")
      )

updatePost :: String -> A.Value -> JSM (Either String ())
updatePost fileName value =
  A.eitherDecode
    <$> fetch
      ( fromString "http://localhost:8081"
          & setRequestMethod "POST"
          & setRequestBodyLBS ("UPDATE posts SET " <> A.encode value <> " WHERE posts.$fileName == \"" <> LB.fromString fileName <> "\"")
      )

fetch :: Request -> JSM LB.ByteString
fetch req = LB.fromStrict . getResponseBody <$> httpBS req

#ifdef ghcjs_HOST_OS
httpBS :: Request -> JSM (Response B.ByteString)
httpBS req = xhrByteString req

instance IsString Request where
  fromString uri =
    Request
      { reqMethod = GET,
        reqURI = J.pack uri,
        reqLogin = Nothing,
        reqHeaders = [],
        reqWithCredentials = False,
        reqData = NoData
      }

setRequestMethod :: B.ByteString -> Request -> Request
setRequestMethod "POST" req = req {reqMethod = POST}

setRequestBodyLBS :: LB.ByteString -> Request -> Request
setRequestBodyLBS body req = req {reqData = StringData (J.pack (LB.unpack body))}

getResponseBody :: Response B.ByteString -> B.ByteString
getResponseBody = fromMaybe "" . contents
#endif