From 766bc25be87ad66d9c850373e42c7d323f8d58db Mon Sep 17 00:00:00 2001
From: dan <me@danrh.co.uk>
Date: Sat, 17 Apr 2021 08:41:13 +0200
Subject: Create RestService, with state and an eval endpoint

---
 src/RestService.hs | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 59 insertions(+)
 create mode 100644 src/RestService.hs

(limited to 'src/RestService.hs')

diff --git a/src/RestService.hs b/src/RestService.hs
new file mode 100644
index 0000000..2921687
--- /dev/null
+++ b/src/RestService.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+module RestService (start) where
+
+import Network.HTTP.Types.URI
+import Network.Wai
+import Network.Wai.Handler.Warp
+import Data.Aeson (FromJSON, ToJSON)
+import Web.Scotty as S
+import Data.Maybe (fromMaybe)
+import GHC.Generics
+
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Concurrent.STM.TArray
+
+import qualified BizExpr as E
+import qualified Data.Text.Lazy as L
+import qualified Data.Text as T
+import qualified Data.Map as M
+import qualified Network.HTTP.Types.Status as Status
+
+staticFilePaths :: [FilePath]
+staticFilePaths = map ("./static/" ++) ["materialize.min.css", "materialize.min.js", "service.js"]
+
+staticFiles :: ScottyM ()
+staticFiles = do
+  --    get "/static/:file" $ file
+  mapM_ addFile staticFilePaths
+  where
+    addFile path = get (capture $ tail path) $ file path
+
+data ExprReq = ExprReq {expression :: L.Text, result :: Maybe L.Text}
+    deriving (Show, Generic)
+instance FromJSON ExprReq
+
+numInc :: State -> IO Int
+numInc s = atomically (readTVar s >>= writeTVar s . (+1) >> readTVar s)
+
+routes :: State -> ScottyM ()
+routes state = do
+  staticFiles
+  get "/num" $
+    S.json =<< liftAndCatchIO (numInc state)
+  get "/:expr" $
+    S.text =<< S.param "expr"
+  post "/eval" $
+    S.text . L.pack . fromMaybe "failure" . E.eval . L.unpack . expression =<< S.jsonData
+
+type State = TVar Int
+
+start :: IO ()
+start = scottyOpts opts . routes =<< newTVarIO 3
+
+opts :: Options
+opts = Options 1 settings
+  where
+    settings = setPort 3000 defaultSettings
-- 
cgit v1.2.3