fix: use Text for created_at, fix show-bug in ToJSON, add /cook-history route
Build and Deploy / build-and-deploy (push) Failing after 21s
Build and Deploy / build-and-deploy (push) Failing after 21s
This commit is contained in:
@@ -10,3 +10,4 @@ build/
|
|||||||
__pycache__
|
__pycache__
|
||||||
.worktrees/
|
.worktrees/
|
||||||
.superpowers/
|
.superpowers/
|
||||||
|
recipes/
|
||||||
|
|||||||
@@ -20,6 +20,7 @@ library
|
|||||||
Roux
|
Roux
|
||||||
Roux.Config
|
Roux.Config
|
||||||
Roux.CooklangPrint
|
Roux.CooklangPrint
|
||||||
|
Roux.CookLog
|
||||||
Roux.Html
|
Roux.Html
|
||||||
Roux.NYTimes
|
Roux.NYTimes
|
||||||
Roux.Parser
|
Roux.Parser
|
||||||
|
|||||||
+12
-11
@@ -18,7 +18,7 @@ import qualified Data.Aeson as A
|
|||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Time.Calendar (Day, fromGregorianValid)
|
import Data.Time.Calendar (Day, fromGregorianValid)
|
||||||
import Data.Time.Clock (UTCTime, getCurrentTime)
|
import Data.Time.Clock (getCurrentTime)
|
||||||
import qualified Data.Time.Format as Time
|
import qualified Data.Time.Format as Time
|
||||||
import Database.SQLite.Simple (Connection, FromRow (..), Only (..), Query)
|
import Database.SQLite.Simple (Connection, FromRow (..), Only (..), Query)
|
||||||
import qualified Database.SQLite.Simple as SQL
|
import qualified Database.SQLite.Simple as SQL
|
||||||
@@ -29,12 +29,17 @@ data CookEntry = CookEntry
|
|||||||
, ceRecipeFilename :: !Text
|
, ceRecipeFilename :: !Text
|
||||||
, ceCookedDate :: !Day
|
, ceCookedDate :: !Day
|
||||||
, ceComment :: !Text
|
, ceComment :: !Text
|
||||||
, ceCreatedAt :: !UTCTime
|
, ceCreatedAt :: !Text
|
||||||
}
|
}
|
||||||
deriving stock (Eq, Show)
|
deriving stock (Eq, Show)
|
||||||
|
|
||||||
instance FromRow CookEntry where
|
instance FromRow CookEntry where
|
||||||
fromRow = CookEntry <$> SQL.field <*> SQL.field <*> SQL.field <*> SQL.field <*> SQL.field
|
fromRow = CookEntry <$> SQL.field <*> SQL.field <*> SQL.field <*> SQL.field <*> (trimQuotes <$> SQL.field)
|
||||||
|
|
||||||
|
-- | Strip leading/trailing double-quote characters from a Text value.
|
||||||
|
-- This handles any accidental quote wrapping from the DB round-trip.
|
||||||
|
trimQuotes :: Text -> Text
|
||||||
|
trimQuotes = T.dropAround (== '"')
|
||||||
|
|
||||||
instance ToJSON CookEntry where
|
instance ToJSON CookEntry where
|
||||||
toJSON e = A.object
|
toJSON e = A.object
|
||||||
@@ -42,7 +47,7 @@ instance ToJSON CookEntry where
|
|||||||
, "recipe_filename" A..= A.toJSON (ceRecipeFilename e)
|
, "recipe_filename" A..= A.toJSON (ceRecipeFilename e)
|
||||||
, "cooked_date" A..= A.toJSON (show (ceCookedDate e))
|
, "cooked_date" A..= A.toJSON (show (ceCookedDate e))
|
||||||
, "comment" A..= A.toJSON (ceComment e)
|
, "comment" A..= A.toJSON (ceComment e)
|
||||||
, "created_at" A..= A.toJSON (show (ceCreatedAt e))
|
, "created_at" A..= A.toJSON (ceCreatedAt e)
|
||||||
]
|
]
|
||||||
|
|
||||||
instance FromJSON CookEntry where
|
instance FromJSON CookEntry where
|
||||||
@@ -52,7 +57,7 @@ instance FromJSON CookEntry where
|
|||||||
<*> o A..: "recipe_filename"
|
<*> o A..: "recipe_filename"
|
||||||
<*> (parseDate =<< o A..: "cooked_date")
|
<*> (parseDate =<< o A..: "cooked_date")
|
||||||
<*> o A..: "comment"
|
<*> o A..: "comment"
|
||||||
<*> (parseUTC =<< o A..: "created_at")
|
<*> o A..: "created_at"
|
||||||
where
|
where
|
||||||
parseDate t = case T.splitOn "-" t of
|
parseDate t = case T.splitOn "-" t of
|
||||||
[y, m, d] -> case fromGregorianValid
|
[y, m, d] -> case fromGregorianValid
|
||||||
@@ -60,11 +65,6 @@ instance FromJSON CookEntry where
|
|||||||
Just day -> pure day
|
Just day -> pure day
|
||||||
Nothing -> fail "invalid date"
|
Nothing -> fail "invalid date"
|
||||||
_ -> fail "expected YYYY-MM-DD"
|
_ -> fail "expected YYYY-MM-DD"
|
||||||
parseUTC t = case T.unpack t of
|
|
||||||
"" -> fail "empty datetime"
|
|
||||||
s -> case Time.parseTimeM True Time.defaultTimeLocale "%Y-%m-%d %H:%M:%S" s of
|
|
||||||
Just ut -> pure ut
|
|
||||||
Nothing -> fail "invalid datetime"
|
|
||||||
|
|
||||||
-- | Open or create the DB, ensuring the table exists.
|
-- | Open or create the DB, ensuring the table exists.
|
||||||
initDb :: FilePath -> IO Connection
|
initDb :: FilePath -> IO Connection
|
||||||
@@ -87,11 +87,12 @@ initDb dbPath = do
|
|||||||
insertEntry :: Connection -> Text -> Day -> Maybe Text -> IO Int
|
insertEntry :: Connection -> Text -> Day -> Maybe Text -> IO Int
|
||||||
insertEntry conn filename day mComment = do
|
insertEntry conn filename day mComment = do
|
||||||
now <- getCurrentTime
|
now <- getCurrentTime
|
||||||
|
let nowStr = T.pack $ Time.formatTime Time.defaultTimeLocale "%Y-%m-%d %H:%M:%S" now
|
||||||
SQL.withTransaction conn $ do
|
SQL.withTransaction conn $ do
|
||||||
SQL.execute
|
SQL.execute
|
||||||
conn
|
conn
|
||||||
"INSERT INTO cook_log (recipe_filename, cooked_date, comment, created_at) VALUES (?, ?, ?, ?)"
|
"INSERT INTO cook_log (recipe_filename, cooked_date, comment, created_at) VALUES (?, ?, ?, ?)"
|
||||||
(filename, show day, T.strip (fromMaybe "" mComment), show now)
|
(filename, T.pack (show day), T.strip (fromMaybe "" mComment), nowStr)
|
||||||
rows <- SQL.query conn "SELECT last_insert_rowid()" ()
|
rows <- SQL.query conn "SELECT last_insert_rowid()" ()
|
||||||
case rows of
|
case rows of
|
||||||
[Only i] -> pure i
|
[Only i] -> pure i
|
||||||
|
|||||||
+7
-1
@@ -649,10 +649,16 @@ handleRequest state db request respond = do
|
|||||||
[("Content-Type", "application/json")]
|
[("Content-Type", "application/json")]
|
||||||
body
|
body
|
||||||
-- Cook history page (all entries across recipes)
|
-- Cook history page (all entries across recipes)
|
||||||
["cook-log"] -> do
|
["cook-history"] -> do
|
||||||
entries <- CookLog.fetchAllEntries db
|
entries <- CookLog.fetchAllEntries db
|
||||||
let grouped = groupEntries entries
|
let grouped = groupEntries entries
|
||||||
respond $ htmlResponse (Html.cookHistoryPage grouped)
|
respond $ htmlResponse (Html.cookHistoryPage grouped)
|
||||||
|
-- Cook log JSON endpoint for all entries
|
||||||
|
["cook-log"] -> do
|
||||||
|
entries <- CookLog.fetchAllEntries db
|
||||||
|
respond $ Wai.responseLBS HTTP.status200
|
||||||
|
[("Content-Type", "application/json")]
|
||||||
|
(A.encode entries)
|
||||||
_ -> respond notFound
|
_ -> respond notFound
|
||||||
|
|
||||||
-- | Handle POST /cook-log/{filename}
|
-- | Handle POST /cook-log/{filename}
|
||||||
|
|||||||
Reference in New Issue
Block a user