Init basic functionality

1 files changed, 70 insertions, 0 deletions

diff --git a/main.hs b/main.hs
new file mode 100755
index 0000000..dc1d440
--- /dev/null
+++ b/main.hs
@@ -0,0 +1,70 @@
+#!/usr/bin/env stack
+{- stack
+     --nix
+     --resolver lts-10.3
+     --install-ghc
+     script
+     --package http-types
+     --package yesod
+     --package yesod-core
+     --package text
+     --package aeson
+-}
+
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import GHC.Generics
+import Control.Monad
+import Data.Maybe (isJust)
+import Data.Text (Text, unpack)
+import Yesod
+import Network.HTTP.Types.Status (status400, status200)
+import Data.Aeson
+
+data App = App
+
+mkYesod "App" [parseRoutes|
+/query QueryR GET
+/number NumberR POST
+|]
+
+-- | Start a simple warp server on 3000
+main :: IO ()
+main = warp 3000 App
+
+-- | Initiate Yesod. The default method instances are fine for a prototype or
+-- demo app.
+instance Yesod App
+
+-- | A type to describe the shape of our core model
+data Caller = Caller
+  { name :: Text
+  , number :: Text
+  , context :: Text
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON)
+
+-- FIXME
+findByNumber = id
+
+getQueryR :: Handler RepJson
+getQueryR = do
+  qm <- lookupGetParam "number"
+  case qm of
+    Nothing -> notFound
+    Just q ->
+      sendStatusJSON status200 $ object [ "msg" .= ("FIXME" :: Text) ]
+
+
+postNumberR :: Handler RepJson
+postNumberR = do
+  (obj :: Result Value) <- parseJsonBody
+  case obj of
+    Error err -> sendStatusJSON status400 $ object [ "msg" .= ("invalid body" :: Text) ]
+    Success v -> sendStatusJSON status200 $ object [ "msg" .= ("FIXME" :: Text) ]