From fcd2f8cdebfbc96585956ac247013efcaf7c6137 Mon Sep 17 00:00:00 2001 From: Ian Henry Date: Mon, 4 Aug 2014 23:38:05 -0400 Subject: [PATCH] initial commit with an in memory database that lets you create new threads --- .gitignore | 3 ++ LICENSE | 20 ++++++++++++ Main.hs | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++ Setup.hs | 2 ++ basilica.cabal | 36 ++++++++++++++++++++ 5 files changed, 150 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 Main.hs create mode 100644 Setup.hs create mode 100644 basilica.cabal diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..327bc48 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +dist/ +cabal.sandbox.config +.cabal-sandbox/ diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..5411f1c --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2014 Ian Henry + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..e2cbf0a --- /dev/null +++ b/Main.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE RecordWildCards #-} + +module Main where + +import BasePrelude hiding (app) +import Web.Scotty +import Network.Wai (Application) +import qualified Network.Wai.Handler.Warp as Warp +import Data.Text (Text) +import qualified Data.Text.Lazy as LT +import Data.Time.Clock (UTCTime, getCurrentTime) +import Control.Concurrent.MVar +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Aeson as Aeson +import Data.Aeson ((.=)) +import Control.Monad.Trans (liftIO) +import Network.HTTP.Types + +type User = Text +type ID = Int + +data Thread = Thread { threadID :: ID + , threadTitle :: Text + , threadMessages :: [Message] + , threadCreator :: User + , threadTimeStamp :: UTCTime + } +type Forum = Map ID Thread +data Message = Message { messageID :: ID + , messageCreator :: User + , messageText :: Text + , messageTimeStamp :: UTCTime + } + +instance Aeson.ToJSON Message where + toJSON Message {..} = Aeson.object [ "id" .= messageID + , "creator" .= messageCreator + , "text" .= messageText + , "timeStamp" .= messageTimeStamp + ] + +instance Aeson.ToJSON Thread where + toJSON Thread {..} = Aeson.object [ "id" .= threadID + , "title" .= threadTitle + , "messages" .= threadMessages + , "creator" .= threadCreator + , "timeStamp" .= threadTimeStamp + ] + +app :: MVar Forum -> IO Int -> IO Application +app database nextID = scottyApp $ do + get "/threads/:id" $ do + threadID <- param "id" + entity "Thread not found" =<< Map.lookup threadID <$> db + get "/threads" $ + json =<< Map.elems <$> db + post "/threads" $ + flip rescue (\msg -> status status400 >> text msg) $ do + title <- param "title" + creator <- param "username" + timeStamp <- liftIO getCurrentTime + threadID <- liftIO nextID + let thread = Thread { threadID = threadID + , threadTimeStamp = timeStamp + , threadCreator = creator + , threadMessages = [] + , threadTitle = title + } + liftIO $ modifyMVar_ database (return . Map.insert threadID thread) + json thread + + where + db = liftIO (readMVar database) + entity msg = maybe (status status404 >> text msg) json + +--postComment :: Thread -> Thread + +twice :: a -> (a, a) +twice a = (a, a) + +main :: IO () +main = do + let port = 3000 + database <- newMVar Map.empty + idGen <- newMVar 0 + let generateID = modifyMVar idGen (return . twice . (+ 1)) + putStrLn $ "Running on port " ++ show port + Warp.run port =<< app database generateID diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/basilica.cabal b/basilica.cabal new file mode 100644 index 0000000..417d4c6 --- /dev/null +++ b/basilica.cabal @@ -0,0 +1,36 @@ +-- Initial basilica.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: basilica +version: 0.1.0.0 +-- synopsis: +-- description: +license: MIT +license-file: LICENSE +author: Ian Henry +maintainer: ianthehenry@gmail.com +-- copyright: +category: Web +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +executable basilica + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && <4.8 + , scotty + , wai + , warp + , aeson + , base-prelude + , time + , containers + , text + , mtl + , http-types + + default-extensions: OverloadedStrings, NoImplicitPrelude + -- hs-source-dirs: + default-language: Haskell2010