@@ -28,6 +28,7 @@ module Obelisk.Route
2828 , pathComponentEncoder
2929 , enumEncoder
3030 , enum1Encoder
31+ , checkEnum1EncoderFunc
3132 , endValidEncoder
3233 , pathOnlyValidEncoder
3334 , singletonListValidEncoder
@@ -65,6 +66,8 @@ import Control.Applicative
6566import Control.Category (Category (..))
6667import qualified Control.Categorical.Functor as Cat
6768import Control.Categorical.Bifunctor
69+import Control.Category.Associative
70+import Control.Category.Monoidal
6871import Control.Lens (Identity (..), Prism', makePrisms, itraverse, imap, prism, (^.), re, matching, (^?))
6972import Control.Monad.Except
7073import Data.Dependent.Sum (DSum (..))
@@ -171,13 +174,57 @@ instance (Applicative check, Monad parse) => QFunctor (,) (Encoder check parse)
171174instance (Applicative check, Monad parse) => Bifunctor (,) (Encoder check parse) (Encoder check parse) (Encoder check parse) where
172175 bimap f g = Encoder $ liftA2 bimap (checkEncoder f) (checkEncoder g)
173176
177+instance (Traversable f, Monad parse) => Cat.Functor f (ValidEncoder parse) (ValidEncoder parse) where
178+ fmap ve = ValidEncoder
179+ { _validEncoder_encode = fmap $ _validEncoder_encode ve
180+ , _validEncoder_decode = traverse $ _validEncoder_decode ve
181+ }
182+
174183instance (Traversable f, Monad check, Monad parse) => Cat.Functor f (Encoder check parse) (Encoder check parse) where
175184 fmap e = Encoder $ do
176185 ve <- checkEncoder e
177− pure $ ValidEncoder
178− { _validEncoder_encode = fmap $ _validEncoder_encode ve
179− , _validEncoder_decode = traverse $ _validEncoder_decode ve
180− }
186+ pure $ Cat.fmap ve
187+
188+instance Monad parse => Associative (ValidEncoder parse) (,) where
189+ associate = ValidEncoder
190+ { _validEncoder_encode = associate
191+ , _validEncoder_decode = pure . disassociate
192+ }
193+ disassociate = ValidEncoder
194+ { _validEncoder_encode = disassociate
195+ , _validEncoder_decode = pure . associate
196+ }
197+
198+instance Monad parse => Monoidal (ValidEncoder parse) (,) where
199+ type Id (ValidEncoder parse) (,) = ()
200+ idl = ValidEncoder
201+ { _validEncoder_encode = idl
202+ , _validEncoder_decode = pure . coidl
203+ }
204+ idr = ValidEncoder
205+ { _validEncoder_encode = idr
206+ , _validEncoder_decode = pure . coidr
207+ }
208+ coidl = ValidEncoder
209+ { _validEncoder_encode = coidl
210+ , _validEncoder_decode = pure . idl
211+ }
212+ coidr = ValidEncoder
213+ { _validEncoder_encode = coidr
214+ , _validEncoder_decode = pure . idr
215+ }
216+
217+instance (Applicative check, Monad parse) => Associative (Encoder check parse) (,) where
218+ associate = Encoder $ pure associate
219+ disassociate = Encoder $ pure disassociate
220+
221+instance (Applicative check, Monad parse) => Monoidal (Encoder check parse) (,) where
222+ type Id (Encoder check parse) (,) = ()
223+ idl = Encoder $ pure idl
224+ idr = Encoder $ pure idr
225+ coidl = Encoder $ pure coidl
226+ coidr = Encoder $ pure coidr
227+
181228
182229--------------------------------------------------------------------------------
183230-- Specific instances of encoders
@@ -475,7 +522,7 @@ obeliskComponentEncoder = Encoder $ pure $ ValidEncoder
475522
476523newtype ValidEncoderFunc parse p r = ValidEncoderFunc { runValidEncoderFunc :: forall a. p a -> ValidEncoder parse a r }
477524
478−checkSomeUniverseEncoder
525+checkEnum1EncoderFunc
479526 :: forall check parse p r.
480527 ( Universe (Some p)
481528 , GCompare p
@@ -483,9 +530,9 @@ checkSomeUniverseEncoder
483530 )
484531 => (forall a. p a -> Encoder check parse a r)
485532 -> check (ValidEncoderFunc parse p r)
486−checkSomeUniverseEncoder f = do
533+checkEnum1EncoderFunc f = do
487534 validEncoders :: DMap p (Flip (ValidEncoder parse) r) <- DMap.fromList <$> traverse (\(Some.This p) -> (p :=>) . Flip <$> checkEncoder (f p)) universe
488− pure $ ValidEncoderFunc $ \p -> unFlip $ DMap.findWithDefault (error "checkSomeUniverseEncoder: ValidEncoder not found (should be impossible)") p validEncoders
535+ pure $ ValidEncoderFunc $ \p -> unFlip $ DMap.findWithDefault (error "checkEnum1EncoderFunc: ValidEncoder not found (should be impossible)") p validEncoders
489536
490537obeliskRouteEncoder
491538 :: forall check parse appRoute.
@@ -512,8 +559,8 @@ checkObeliskRouteRestEncoder
512559 => (forall a. appRoute a -> Encoder check parse a PageName)
513560 -> check (ValidEncoderFunc parse (ObeliskRoute appRoute) PageName)
514561checkObeliskRouteRestEncoder appRouteEncoder = do
515− appRouteValidEncoder <- checkSomeUniverseEncoder appRouteEncoder
516− resourceRouteValidEncoder <- checkSomeUniverseEncoder resourceRouteEncoder
562+ appRouteValidEncoder <- checkEnum1EncoderFunc appRouteEncoder
563+ resourceRouteValidEncoder <- checkEnum1EncoderFunc resourceRouteEncoder
517564 return $ ValidEncoderFunc $ \case
518565 ObeliskRoute_App appRoute -> runValidEncoderFunc appRouteValidEncoder appRoute
519566 ObeliskRoute_Resource resRoute -> runValidEncoderFunc resourceRouteValidEncoder resRoute