{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeApplications #-}

module Ema.Class where

-- | Enrich a model to work with Ema
class Ema model route | route -> model where
  -- | Get the filepath on disk corresponding to this route.
  encodeRoute :: model -> route -> FilePath

  -- | Decode a filepath on disk into a route.
  decodeRoute :: model -> FilePath -> Maybe route

  -- | All routes in the site
  --
  -- The `gen` command will generate only these routes. On live server, this
  -- function is never used.
  allRoutes :: model -> [route]
  default allRoutes :: (Bounded route, Enum route) => model -> [route]
  allRoutes model
_ = [route
forall a. Bounded a => a
minBound .. route
forall a. Bounded a => a
maxBound]

-- | The unit model is useful when using Ema in pure fashion (see
-- @Ema.runEmaPure@) with a single route (index.html) only.
instance Ema () () where
  encodeRoute :: () -> () -> FilePath
encodeRoute () () = []
  decodeRoute :: () -> FilePath -> Maybe ()
decodeRoute () = \case
    [] -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
    FilePath
_ -> Maybe ()
forall a. Maybe a
Nothing
  allRoutes :: () -> [()]
allRoutes () = OneItem [()] -> [()]
forall x. One x => OneItem x -> x
one ()