paul/yore
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Move Accept HTML in Yore.Servant

Browse Source
This commit is contained in:
Paul Brinkmeier 2025-09-22 19:04:51 +02:00
parent f2a136d27c
commit 0bf734730b
3 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
app/Main.hs
View File

@ -19,12 +19,10 @@ import Data.Proxy (Proxy (..))
import Data.Text (Text) import Data.Text (Text)
import Data.Time (Day, LocalTime (..), TimeOfDay (..), ZonedTime (..), addDays, toGregorian) import Data.Time (Day, LocalTime (..), TimeOfDay (..), ZonedTime (..), addDays, toGregorian)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Network.HTTP.Media ((//), (/:))
import Network.HTTP.Types (Status (..)) import Network.HTTP.Types (Status (..))
import Network.Wai (Request (..)) import Network.Wai (Request (..))
import Servant import Servant
( Accept (..) ( Capture
, Capture
, Get , Get
, Handler , Handler
, MimeRender (..) , MimeRender (..)
@ -59,7 +57,7 @@ import Yore.Download (downloadInto)
import Yore.Error (Error (..)) import Yore.Error (Error (..))
import Yore.Schedule (schedule) import Yore.Schedule (schedule)
import Yore.Scrape (Issue (..), getIssuesByDay) import Yore.Scrape (Issue (..), getIssuesByDay)
import Yore.Servant (GetSendfile, Sendfile (..)) import Yore.Servant (GetSendfile, HTML, Sendfile (..))
import Yore.Time (addYears, getCurrentDay, getSecondsUntilMidnight) import Yore.Time (addYears, getCurrentDay, getSecondsUntilMidnight)
import qualified Envy import qualified Envy
@ -232,11 +230,6 @@ instance MimeRender HTML RootModel where
-- Utils -- Utils
data HTML
instance Accept HTML where
contentType _ = "text" // "html" /: ("charset", "utf-8")
get100YearsAgo :: IO (Either Error Day) get100YearsAgo :: IO (Either Error Day)
get100YearsAgo = runExceptT $ getTodayWithOffset (-100) 0 get100YearsAgo = runExceptT $ getTodayWithOffset (-100) 0

11
src/Yore/Servant.hs
View File

@ -1,11 +1,13 @@
{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Yore.Servant (GetSendfile, Sendfile (..)) where module Yore.Servant (GetSendfile, Sendfile (..), HTML) where
import Network.HTTP.Media ((//), (/:))
import Network.HTTP.Types (ResponseHeaders, status200) import Network.HTTP.Types (ResponseHeaders, status200)
import Network.Wai (responseFile) import Network.Wai (responseFile)
import Servant (HasServer (..)) import Servant (Accept (..), HasServer (..))
import Servant.Server.Internal.Delayed (runAction) import Servant.Server.Internal.Delayed (runAction)
import Servant.Server.Internal.RouteResult (RouteResult (..)) import Servant.Server.Internal.RouteResult (RouteResult (..))
import Servant.Server.Internal.Router (Router' (..)) import Servant.Server.Internal.Router (Router' (..))
@ -29,3 +31,8 @@ instance HasServer GetSendfile context where
route _ _ action = RawRouter $ \env request respond -> route _ _ action = RawRouter $ \env request respond ->
runAction action env request respond $ \sendfile -> runAction action env request respond $ \sendfile ->
Route $ responseFile status200 sendfile.headers sendfile.path Nothing Route $ responseFile status200 sendfile.headers sendfile.path Nothing
data HTML
instance Accept HTML where
contentType _ = "text" // "html" /: ("charset", "utf-8")

2
yore.cabal
View File

@ -50,6 +50,7 @@ library
, directory , directory
, filepath , filepath
, html-parse , html-parse
, http-media
, http-types , http-types
, lens , lens
, modern-uri , modern-uri
@ -81,7 +82,6 @@ executable yore
, bytestring , bytestring
, filepath , filepath
, opium , opium
, http-media
, http-types , http-types
, servant-server , servant-server
, text , text