aboutsummaryrefslogtreecommitdiffstats
path: root/frontend
diff options
context:
space:
mode:
Diffstat (limited to 'frontend')
-rw-r--r--frontend/LICENSE30
-rw-r--r--frontend/app/Main.hs77
-rw-r--r--frontend/frontend.cabal31
3 files changed, 138 insertions, 0 deletions
diff --git a/frontend/LICENSE b/frontend/LICENSE
new file mode 100644
index 0000000..c90516a
--- /dev/null
+++ b/frontend/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2024, Alexander Foremny
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Alexander Foremny nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/frontend/app/Main.hs b/frontend/app/Main.hs
new file mode 100644
index 0000000..d1bb89e
--- /dev/null
+++ b/frontend/app/Main.hs
@@ -0,0 +1,77 @@
+module Main where
+
+#ifndef ghcjs_HOST_OS
+import Language.Javascript.JSaddle.Warp as JSaddle
+#endif
+
+import Data.ByteString.UTF8 qualified as B
+import Data.Maybe
+import Miso
+import Miso.String
+
+#ifndef ghcjs_HOST_OS
+import Network.HTTP.Simple
+import Data.String
+#else
+import JavaScript.Web.XMLHttpRequest
+#endif
+
+type Model = Maybe Schema
+
+type Schema = String
+
+data Action
+ = FetchSchema
+ | SetSchema Schema
+ deriving (Show, Eq)
+
+#ifndef ghcjs_HOST_OS
+runApp :: JSM () -> IO ()
+runApp f = JSaddle.debugOr 8080 (f >> syncPoint) JSaddle.jsaddleApp
+#else
+runApp :: IO () -> IO ()
+runApp app = app
+#endif
+
+main :: IO ()
+main = runApp $ startApp App {..}
+ where
+ initialAction = FetchSchema
+ model = Nothing
+ update = updateModel
+ view = viewModel
+ events = defaultEvents
+ subs = []
+ mountPoint = Nothing
+ logLevel = Off
+
+updateModel :: Action -> Model -> Effect Action Model
+updateModel action m =
+ case action of
+ FetchSchema -> m <# do SetSchema <$> fetchSchema
+ SetSchema schema -> noEff (Just schema)
+
+fetchSchema :: JSM String
+fetchSchema = fetch "http://localhost:8081/posts.schema.json"
+
+#ifndef ghcjs_HOST_OS
+fetch :: String -> JSM String
+fetch url = B.toString . getResponseBody <$> httpBS (fromString url)
+#else
+fetch :: String -> JSM String
+fetch url = maybe "" B.toString . contents <$> xhrByteString req
+ where
+ req =
+ Request
+ { reqMethod = GET,
+ reqURI = pack url,
+ reqLogin = Nothing,
+ reqHeaders = [],
+ reqWithCredentials = False,
+ reqData = NoData
+ }
+#endif
+
+viewModel :: Model -> View Action
+viewModel schema =
+ div_ [] [text (toMisoString (fromMaybe ".." schema))]
diff --git a/frontend/frontend.cabal b/frontend/frontend.cabal
new file mode 100644
index 0000000..5674bb7
--- /dev/null
+++ b/frontend/frontend.cabal
@@ -0,0 +1,31 @@
+cabal-version: 3.4
+name: frontend
+version: 0.1.0.0
+license: BSD-3-Clause
+license-file: LICENSE
+maintainer: aforemny@posteo.de
+author: Alexander Foremny
+build-type: Simple
+extra-doc-files: CHANGELOG.md
+
+executable frontend
+ main-is: Main.hs
+ hs-source-dirs: app
+ default-language: GHC2021
+ default-extensions: CPP OverloadedStrings RecordWildCards
+ ghc-options: -Wall
+ build-depends:
+ base,
+ bytestring,
+ containers,
+ miso,
+ text,
+ utf8-string
+
+ if !arch(javascript)
+ build-depends: jsaddle-warp
+
+ if arch(javascript)
+ build-depends: ghcjs-base
+ else
+ build-depends: http-conduit