diff options
Diffstat (limited to 'frontend')
-rw-r--r-- | frontend/LICENSE | 30 | ||||
-rw-r--r-- | frontend/app/Main.hs | 77 | ||||
-rw-r--r-- | frontend/frontend.cabal | 31 |
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 |