Add a new JSON interface

src/Application.hs

@@ -44,12 +44,25 @@ app runner = do
           respond $ redirectTo (BS.pack url)
         Nothing  -> respond notFound
 
-    post "/short" $ do
-      form <- fmap fst parseForm
+    post "/" $ do
+      form <- fst <$> parseForm
       case lookup "url" form of
+        Nothing   -> respond badRequest
         Just url' -> do
           let url = BS.unpack url'
           name <- liftIO (insert table url)
           logStr (printf "Registered %s -> %s " url name)
           render done $ object ["link" .= (bindUrl ++ name)]
-        Nothing  -> respond badRequest
+
+    post "/api" $ do
+      form <- fst <$> parseForm
+      case lookup "url" form of
+        Nothing   -> respond badRequest
+        Just url' -> do
+          let url = BS.unpack url'
+          name <- liftIO (insert table url)
+          logStr (printf "Registered %s -> %s " url name)
+          let json = object [ "link"     .= (bindUrl ++ name)
+                            , "name"     .= name
+                            , "original" .= url ]
+          respond $ okHtml (encode json)    

views/index.html

@@ -1,4 +1,4 @@
-<form action="/short" method="POST">
+<form method="POST">
     your url: <input type="text" name="url">
     <input type="submit" value="go">
 </form>