Commit a27ca08b authored by Nicolas Lenz's avatar Nicolas Lenz

Overview and Container CSV

parent 0cc80a62
/container/#Int ContainerR GET PUT
/container ContainersR GET
/containers.csv ContainersCsvR GET
/location/#Text LocationR GET PUT
/location LocationsR GET
......@@ -11,3 +12,5 @@
/user UsersR GET POST
/control ControlR GET
/ RootR GET
......@@ -43,3 +43,10 @@ getContainersR = do
let sorted = sortAllocations $ entityVal <$> allocations
liftIO $ putStrLn $ pack $ show $ sorted
returnJson $ map (\a -> object [("container", toJSON $ fst a), ("allocations", toJSON $ snd a)]) sorted
getContainersCsvR :: Handler TypedContent
getContainersCsvR = do
allocsE <- runDB $ selectList [] []
let allocs = entityVal <$> (allocsE :: [Entity Allocation])
let csv = "Container,Amount,Location\n" <> concatMap (\a -> tshow (allocationContainer a) <> "," <> tshow (allocationAmount a) <> "," <> tshow (allocationLocation a)) allocs
return $ TypedContent "text/csv" (toContent csv)
......@@ -23,8 +23,6 @@ getLogR = do
results <- runDB $ selectList [] []
returnJson (entityVal <$> (results :: [Entity Log]))
getUsersR :: Handler Value
getUsersR = do
users <- runDB $ selectList [] []
......@@ -82,3 +80,18 @@ getControlR = do
<input type="hidden" name="request" value="delete">
<input type="submit" value="Delete">
|]
getRootR :: Handler Html
getRootR = do
allocsE <- runDB $ selectList [] []
let allocs = entityVal <$> (allocsE :: [Entity Allocation])
defaultLayout [whamlet|
<h1>WMS Home
<a href="/control">User Control
|
<a href="/containers.csv">Container List CSV
<h2>Container Overview
<ul>
$forall alloc <- allocs
<li>#{allocationContainer alloc}: #{allocationAmount alloc} in #{allocationLocation alloc}
|]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment