-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# LANGUAGE UndecidableInstances #-}

module Utils.Route where

import Control.Lens
import ClassyPrelude.Yesod hiding (Proxy)
import Data.Kind (Type)

import qualified Data.Map as Map
import Data.Proxy


class RedirectUrl site url => HasRoute site url where
  type RouteWithParams site url :: Type
  type RouteWithParams site url = (Route site, [(Text, Text)])
  urlRoute :: url -> Route site
  urlRouteParams :: forall p. p site -> Lens url (RouteWithParams site url) [(Text, Text)] [(Text, Text)]
  default urlRouteParams :: forall p.
                            RouteWithParams site url ~ (Route site, [(Text, Text)])
                         => p site
                         -> Lens url (RouteWithParams site url) [(Text, Text)] [(Text, Text)]
  urlRouteParams _ = lens (const []) (\(urlRoute -> route') params -> (route', params))

instance HasRoute site (Route site) where
  urlRoute = id
-- | for GET-Parameters
instance (key ~ Text) => HasRoute site (Route site, Map key Text) where
  urlRoute = view _1
  urlRouteParams _ = lens (views _2 Map.toList) (\(route, _) params -> (route, params))
-- | for GET-Parameters
instance (key ~ Text) => HasRoute site (Route site, [(key, Text)]) where
  urlRoute = view _1
  urlRouteParams _ = _2
-- | for PageAnchors, implemented through Fragments
instance (HasRoute site a, PathPiece b) => HasRoute site (Fragment a b) where
  type RouteWithParams site (Fragment a b) = Fragment (RouteWithParams site a) b
  urlRoute (a :#: _) = urlRoute a
  urlRouteParams pSite = fragRoute . urlRouteParams pSite
    where
      fragRoute :: forall a1 a2 b'. Lens (Fragment a1 b') (Fragment a2 b') a1 a2
      fragRoute = lens (\(a :#: _) -> a) (\(_ :#: f) a' -> a' :#: f)

data SomeRoute site = forall url. HasRoute site url => SomeRoute url  

instance RedirectUrl site (SomeRoute site) where
  toTextUrl (SomeRoute url) = toTextUrl url
instance HasRoute site (SomeRoute site) where
  type RouteWithParams site (SomeRoute site) = SomeRoute site
  urlRoute (SomeRoute url) = urlRoute url
  urlRouteParams pSite = lens (\(SomeRoute url) -> withLens (urlRouteParams pSite) $ \g _ -> g url) (\(SomeRoute url) params -> SomeRoute (urlRoute url :: Route site, params))
instance Eq (Route site) => Eq (SomeRoute site) where
  (==) = (==) `on` (\(SomeRoute r) -> withLens (urlRouteParams $ Proxy @site) $ \g _ -> (urlRoute r :: Route site, sort $ g r))