{-# language PolyKinds, TypeOperators, DeriveGeneric, TypeSynonymInstances, FlexibleContexts, FlexibleInstances, ScopedTypeVariables #-}
module Web.Routes.Generics where

import Data.Text (Text, pack, toLower)
import GHC.Generics
import Text.ParserCombinators.Parsec.Prim
import Text.ParserCombinators.Parsec.Combinator
import Web.Routes.PathInfo (PathInfo(fromPathSegments, toPathSegments), URLParser, segment)

class GToURL f where
  gtoPathSegments :: f a -> [Text]
  gfromPathSegments :: URLParser (f a)

instance GToURL U1 where
  gtoPathSegments :: forall (a :: k). U1 a -> [Text]
gtoPathSegments U1 a
U1 = []
  gfromPathSegments :: forall (a :: k). URLParser (U1 a)
gfromPathSegments = ParsecT [Text] () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT [Text] () Identity ()
-> ParsecT [Text] () Identity (U1 a)
-> ParsecT [Text] () Identity (U1 a)
forall a b.
ParsecT [Text] () Identity a
-> ParsecT [Text] () Identity b -> ParsecT [Text] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> U1 a -> ParsecT [Text] () Identity (U1 a)
forall a. a -> ParsecT [Text] () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1

instance forall c f. (Constructor c, GToURL f) => GToURL (C1 c f) where
  gtoPathSegments :: forall (a :: k). C1 c f a -> [Text]
gtoPathSegments m :: C1 c f a
m@(M1 f a
x) = (Text -> Text
toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ C1 c f a -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName C1 c f a
m) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: f a -> [Text]
forall (a :: k). f a -> [Text]
forall {k} (f :: k -> *) (a :: k). GToURL f => f a -> [Text]
gtoPathSegments f a
x
  gfromPathSegments :: forall (a :: k). URLParser (C1 c f a)
gfromPathSegments =
    let constr :: C1 c f r
constr = C1 c f r
forall {r :: k}. C1 c f r
forall a. HasCallStack => a
undefined :: C1 c f r
    in do Text -> URLParser Text
segment (Text -> Text
toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ M1 C c f Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName M1 C c f Any
forall {r :: k}. C1 c f r
constr) URLParser Text -> URLParser Text -> URLParser Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> URLParser Text
segment (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ M1 C c f Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName M1 C c f Any
forall {r :: k}. C1 c f r
constr)
          f a -> C1 c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> C1 c f a)
-> ParsecT [Text] () Identity (f a) -> URLParser (C1 c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity (f a)
forall (a :: k). URLParser (f a)
forall {k} (f :: k -> *) (a :: k). GToURL f => URLParser (f a)
gfromPathSegments

instance (GToURL f, GToURL g) => GToURL (f :+: g) where
  gtoPathSegments :: forall (a :: k). (:+:) f g a -> [Text]
gtoPathSegments (L1 f a
x) = f a -> [Text]
forall (a :: k). f a -> [Text]
forall {k} (f :: k -> *) (a :: k). GToURL f => f a -> [Text]
gtoPathSegments f a
x
  gtoPathSegments (R1 g a
x) = g a -> [Text]
forall (a :: k). g a -> [Text]
forall {k} (f :: k -> *) (a :: k). GToURL f => f a -> [Text]
gtoPathSegments g a
x
  gfromPathSegments :: forall (a :: k). URLParser ((:+:) f g a)
gfromPathSegments = GenParser Text () ((:+:) f g a) -> GenParser Text () ((:+:) f g a)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a -> (:+:) f g a)
-> ParsecT [Text] () Identity (f a)
-> GenParser Text () ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity (f a)
forall (a :: k). URLParser (f a)
forall {k} (f :: k -> *) (a :: k). GToURL f => URLParser (f a)
gfromPathSegments) GenParser Text () ((:+:) f g a)
-> GenParser Text () ((:+:) f g a)
-> GenParser Text () ((:+:) f g a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a -> (:+:) f g a)
-> ParsecT [Text] () Identity (g a)
-> GenParser Text () ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity (g a)
forall (a :: k). URLParser (g a)
forall {k} (f :: k -> *) (a :: k). GToURL f => URLParser (f a)
gfromPathSegments)

instance (GToURL f, GToURL g) => GToURL (f :*: g) where
  gtoPathSegments :: forall (a :: k). (:*:) f g a -> [Text]
gtoPathSegments (f a
x :*: g a
y) = f a -> [Text]
forall (a :: k). f a -> [Text]
forall {k} (f :: k -> *) (a :: k). GToURL f => f a -> [Text]
gtoPathSegments f a
x [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ g a -> [Text]
forall (a :: k). g a -> [Text]
forall {k} (f :: k -> *) (a :: k). GToURL f => f a -> [Text]
gtoPathSegments g a
y
  gfromPathSegments :: forall (a :: k). URLParser ((:*:) f g a)
gfromPathSegments =
    do f a
x <- URLParser (f a)
forall (a :: k). URLParser (f a)
forall {k} (f :: k -> *) (a :: k). GToURL f => URLParser (f a)
gfromPathSegments
       g a
y <- URLParser (g a)
forall (a :: k). URLParser (g a)
forall {k} (f :: k -> *) (a :: k). GToURL f => URLParser (f a)
gfromPathSegments
       (:*:) f g a -> URLParser ((:*:) f g a)
forall a. a -> ParsecT [Text] () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a
x f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
y)

instance (GToURL f) => GToURL (D1 c f) where
  gtoPathSegments :: forall (a :: k). D1 c f a -> [Text]
gtoPathSegments m :: D1 c f a
m@(M1 f a
x) = f a -> [Text]
forall (a :: k). f a -> [Text]
forall {k} (f :: k -> *) (a :: k). GToURL f => f a -> [Text]
gtoPathSegments f a
x
  gfromPathSegments :: forall (a :: k). URLParser (D1 c f a)
gfromPathSegments = f a -> M1 D c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 D c f a)
-> ParsecT [Text] () Identity (f a)
-> ParsecT [Text] () Identity (M1 D c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity (f a)
forall (a :: k). URLParser (f a)
forall {k} (f :: k -> *) (a :: k). GToURL f => URLParser (f a)
gfromPathSegments

instance (PathInfo a) => GToURL (K1 i a) where
  gtoPathSegments :: forall (a :: k). K1 i a a -> [Text]
gtoPathSegments (K1 a
a) = a -> [Text]
forall url. PathInfo url => url -> [Text]
toPathSegments a
a
  gfromPathSegments :: forall (a :: k). URLParser (K1 i a a)
gfromPathSegments = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a)
-> ParsecT [Text] () Identity a
-> ParsecT [Text] () Identity (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity a
forall url. PathInfo url => URLParser url
fromPathSegments

instance (GToURL f) => GToURL (S1 c f) where
  gtoPathSegments :: forall (a :: k). S1 c f a -> [Text]
gtoPathSegments (M1 f a
f) = f a -> [Text]
forall (a :: k). f a -> [Text]
forall {k} (f :: k -> *) (a :: k). GToURL f => f a -> [Text]
gtoPathSegments f a
f
  gfromPathSegments :: forall (a :: k). URLParser (S1 c f a)
gfromPathSegments = f a -> M1 S c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 S c f a)
-> ParsecT [Text] () Identity (f a)
-> ParsecT [Text] () Identity (M1 S c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Text] () Identity (f a)
forall (a :: k). URLParser (f a)
forall {k} (f :: k -> *) (a :: k). GToURL f => URLParser (f a)
gfromPathSegments