diff options
author | Ben Sima <ben@bsima.me> | 2018-01-23 10:16:29 -0800 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2018-01-23 10:16:29 -0800 |
commit | 3560aad683d32b2719d9abd0e52dbe536d8a416b (patch) | |
tree | 3178fe0d5521ee4953d531c0d8b52d6543e9e0fb /main.hs | |
parent | 0061b00e7f1f8cf614f96b8f8bf19700697fa4b9 (diff) |
Add/fix some docs
Diffstat (limited to 'main.hs')
-rwxr-xr-x | main.hs | 13 |
1 files changed, 11 insertions, 2 deletions
@@ -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 () |