fix: send URL-encoded form data instead of multipart, show errors inline, default empty date to today

src/Roux/Server.hs

@@ -26,7 +26,6 @@ import qualified Data.Map.Strict as Map
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
-import Data.Time.Clock (diffUTCTime, getCurrentTime)
 
 import qualified Network.HTTP.Types as HTTP
 import qualified Network.Wai as Wai
@@ -48,6 +47,7 @@ import qualified Data.ByteString as BS
 import Data.Maybe (fromMaybe, mapMaybe)
 import qualified Data.Text.Encoding as TE
 import Data.Time.Calendar (Day, fromGregorianValid)
+import Data.Time.Clock (diffUTCTime, getCurrentTime, utctDay)
 import qualified Data.Time.Format as Time
 import qualified Database.SQLite.Simple as SQL
 import Roux.Config (AnthropicConfig (..), RouxConfig (..))
@@ -672,22 +672,29 @@ handleCookLogPost db filename request respond = do
     let params = parseFormBody body
         dateStr = fromMaybe "" (lookup "cooked-date" params)
         comment = lookup "comment" params
+    let doInsert d = do
+            _ <- CookLog.insertEntry db filename d comment
+            respond $
+                Wai.responseLBS
+                    HTTP.status200
+                    [("Content-Type", "application/json")]
+                    (LB.fromStrict (encodeUtf8 "{\"ok\":true}"))
     case parseDate dateStr of
-        Just day -> do
-            _ <- CookLog.insertEntry db filename day comment
-            let resp =
-                    Wai.responseLBS
-                        HTTP.status200
-                        [("Content-Type", "application/json")]
-                        (LB.fromStrict (encodeUtf8 "{\"ok\":true}"))
-            respond resp
+        Just d -> doInsert d
         Nothing ->
-            let resp =
-                    Wai.responseLBS
-                        HTTP.status400
-                        [("Content-Type", "application/json")]
-                        (LB.fromStrict (encodeUtf8 "{\"error\":\"Invalid date format\"}"))
-             in respond resp
+            if T.null dateStr
+                then getCurrentDay >>= doInsert
+                else
+                    let resp =
+                            Wai.responseLBS
+                                HTTP.status400
+                                [("Content-Type", "application/json")]
+                                (LB.fromStrict (encodeUtf8 "{\"error\":\"Invalid date format\"}"))
+                     in respond resp
+
+-- | Get today's date.
+getCurrentDay :: IO Day
+getCurrentDay = utctDay <$> getCurrentTime
 
 -- | Parse a YYYY-MM-DD date string.
 parseDate :: Text -> Maybe Day