initial commit with an in memory database that lets you create new th…

…reads

.gitignore

@@ -0,0 +1,3 @@
+dist/
+cabal.sandbox.config
+.cabal-sandbox/

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.

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

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

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:          [email protected]
+-- 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