Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add voidEncoder/HasInitialObject #1089

Open
wants to merge 2 commits into
base: develop
Choose a base branch
from
Open

Add voidEncoder/HasInitialObject #1089

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
e679f18
Add voidEncoder/HasInitialObject
alexfmpe Jun 30, 2024
31e8c9a
Merge branch 'develop' into initial-object
alexfmpe Jan 18, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 14 additions & 4 deletions lib/route/src/Obelisk/Route.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -117,6 +117,7 @@ module Obelisk.Route
, handleEncoder
, someSumEncoder
, Void1
, voidEncoder
, void1Encoder
, pathSegmentsTextEncoder
, queryParametersTextEncoder
Expand All @@ -136,6 +137,7 @@ import Control.Applicative
import Control.Category (Category (..))
import qualified Control.Categorical.Functor as Cat
import Control.Categorical.Bifunctor
import Control.Categorical.Object
import Control.Category.Associative
import Control.Category.Monoidal
import Control.Category.Braided
Expand Down Expand Up @@ -206,6 +208,7 @@ import Data.Text.Lens (IsText, packed, unpacked)
import Data.Type.Equality
import Data.Universe
import Data.Universe.Some
import Data.Void
import Network.HTTP.Types.URI
import qualified Numeric.Lens
import Obelisk.Route.TH
Expand Down Expand Up @@ -393,6 +396,10 @@ instance (Applicative check, Monad parse) => Category (Encoder check parse) wher
id = Encoder $ pure id
(.) = o

instance (Applicative check, MonadError Text parse) => HasInitialObject (Encoder check parse) where
type Initial (Encoder check parse) = Void
initiate = voidEncoder

instance Monad parse => Category (EncoderImpl parse) where
id = EncoderImpl
{ _encoderImpl_decode = pure
Expand Down Expand Up @@ -1119,12 +1126,15 @@ instance UniverseSome Void1 where
universeSome = []
instance FiniteSome Void1

void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a
void1Encoder = Encoder $ pure $ EncoderImpl
{ _encoderImpl_encode = foldSome $ \case
, _encoderImpl_decode = \_ -> throwError "void1Encoder: can't decode anything"
voidEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse Void a
voidEncoder = Encoder $ pure $ EncoderImpl
{ _encoderImpl_encode = \case
, _encoderImpl_decode = \_ -> throwError "voidEncoder: can't decode anything"
}

void1Encoder :: (Applicative check, MonadError Text parse) => Encoder check parse (Some Void1) a
void1Encoder = voidEncoder . viewEncoder (iso (foldSome (\case)) (\case))

instance GShow Void1 where
gshowsPrec _ = \case {}

Expand Down
3 changes: 2 additions & 1 deletion lib/route/test/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -257,7 +257,8 @@ exhaustive =
prop f = f $ \lbl e -> testProperty lbl $ withCheckedEncoder e $ flip all universeF . roundtripsProp
in
testGroup "Roundtrip" $ prop $ \t ->
[ t "void1Encoder" void1Encoder
[ t "voidEncoder" voidEncoder
, t "void1Encoder" void1Encoder
, t "id (Word8)" $ id @_ @Word8
, t "enumEncoder" $ enumEncoder @_ @_ @Word8 (+1)
]
Expand Down