Skip to content

Instantly share code, notes, and snippets.

@louissalin
Last active August 29, 2015 14:06
Show Gist options
  • Save louissalin/aa56339615ed2bafccdd to your computer and use it in GitHub Desktop.
Save louissalin/aa56339615ed2bafccdd to your computer and use it in GitHub Desktop.
main = do
config <- readDbConfig
let runAction = withConnection config
S.scotty 3000 $ do
S.get "/" $ do
res <- liftIO . runAction $ getOpportunity
S.json $ Opportunities res
S.post "/opportunities/" $ do
requestBody <- S.body
res <- liftIO . runAction $ createOpportunity (decode requestBody :: Maybe OpportunityContract)
S.json $ case res of
Nothing -> Opportunities []
Just x -> Opportunities [x]
type SOAction a = Connection -> IO a
getOpportunity :: SOAction [M.Opportunity]
getOpportunity conn = CE.run conn program
where program = CE.getOpportunity 1
createOpportunity :: Maybe OpportunityContract -> SOAction (Maybe M.Opportunity)
createOpportunity (Just (OpportunityContract c)) conn =
let accOpportunity = M.create (Just (title c)) (Just (description c)) (maxAttendees c)
in case (accOpportunity ^? _Success) of
Nothing -> return Nothing
(Just c) -> do
CE.run conn program
where program = CE.createOpportunity c
createOpportunity Nothing conn = return Nothing
withConnection :: DbConfig -> SOAction a -> IO a
withConnection config f = do
conn <- connectPostgreSQL $ getConnectionString config
f conn
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment