summaryrefslogtreecommitdiff
path: root/main.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2018-01-23 10:16:29 -0800
committerBen Sima <ben@bsima.me>2018-01-23 10:16:29 -0800
commit3560aad683d32b2719d9abd0e52dbe536d8a416b (patch)
tree3178fe0d5521ee4953d531c0d8b52d6543e9e0fb /main.hs
parent0061b00e7f1f8cf614f96b8f8bf19700697fa4b9 (diff)
Add/fix some docs
Diffstat (limited to 'main.hs')
-rwxr-xr-xmain.hs13
1 files changed, 11 insertions, 2 deletions
diff --git a/main.hs b/main.hs
index e4a0b49..e383359 100755
--- a/main.hs
+++ b/main.hs
@@ -74,7 +74,7 @@ data Caller = Caller
$(deriveSafeCopy 0 'base ''Caller)
--- | Create indexes for each field we want to query
+-- | Create reified types for each field we want to query
newtype Name = Name Text deriving (Eq, Ord, Data, Typeable)
newtype PhoneNumber = PhoneNumber Text deriving (Eq, Ord, Data, Typeable)
@@ -84,6 +84,8 @@ $(deriveSafeCopy 0 'base ''Name)
$(deriveSafeCopy 0 'base ''PhoneNumber)
$(deriveSafeCopy 0 'base ''Context)
+-- | Create the composite index
+
instance Indexable Caller where
empty = ixSet [ ixFun $ (:[]) . callerId
, ixFun $ \c -> [ Name $ name c ]
@@ -109,6 +111,10 @@ initDatabase =
, callers = empty
}
+---------------------------------------------------------------------------------
+-- | CRUD operations on the state
+
+
-- | Insert the caller into database.
addCaller :: Text -> Text -> Text -> Update Database Caller
addCaller name number context = do
@@ -122,6 +128,7 @@ addCaller name number context = do
}
return caller
+-- | Return a list of the callers
viewCallers :: Int -> Query Database [Caller]
viewCallers limit = do
Database{..} <- ask
@@ -139,13 +146,16 @@ callerById cid =
do Database{..} <- ask
return $ getOne $ callers @= cid
+-- | Lookup caller by PhoneNumber
callerByNumber :: PhoneNumber -> Query Database [Caller]
callerByNumber num =
do Database{..} <- ask
return $ IxSet.toList $ callers @= num
+
$(makeAcidic ''Database ['addCaller, 'updateCaller, 'callerById, 'callerByNumber, 'viewCallers])
+
-----------------------------------------------------------------------
-- | Here be the HTTP stuff
@@ -211,7 +221,6 @@ postNumberR = do
caller <- liftIO $ update db $ AddCaller _name _number _context
sendStatusJSON status200 $ caller
-mapIndexed f l = zipWith f l [0..]
-- | Start a simple warp server on 3000
main :: IO ()