{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}

module Ema.Route
  ( routeUrl,
    routeUrlWith,
    UrlStrategy (..),
  )
where

import Data.Aeson (FromJSON (parseJSON), Value)
import Data.Aeson.Types (Parser)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Ema.Class (Ema (encodeRoute))
import Ema.Route.Slug (unicodeNormalize)
import qualified Network.URI.Encode as UE

data UrlStrategy
  = UrlPretty
  | UrlDirect
  deriving (UrlStrategy -> UrlStrategy -> Bool
(UrlStrategy -> UrlStrategy -> Bool)
-> (UrlStrategy -> UrlStrategy -> Bool) -> Eq UrlStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UrlStrategy -> UrlStrategy -> Bool
$c/= :: UrlStrategy -> UrlStrategy -> Bool
== :: UrlStrategy -> UrlStrategy -> Bool
$c== :: UrlStrategy -> UrlStrategy -> Bool
Eq, Int -> UrlStrategy -> ShowS
[UrlStrategy] -> ShowS
UrlStrategy -> String
(Int -> UrlStrategy -> ShowS)
-> (UrlStrategy -> String)
-> ([UrlStrategy] -> ShowS)
-> Show UrlStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UrlStrategy] -> ShowS
$cshowList :: [UrlStrategy] -> ShowS
show :: UrlStrategy -> String
$cshow :: UrlStrategy -> String
showsPrec :: Int -> UrlStrategy -> ShowS
$cshowsPrec :: Int -> UrlStrategy -> ShowS
Show, Eq UrlStrategy
Eq UrlStrategy
-> (UrlStrategy -> UrlStrategy -> Ordering)
-> (UrlStrategy -> UrlStrategy -> Bool)
-> (UrlStrategy -> UrlStrategy -> Bool)
-> (UrlStrategy -> UrlStrategy -> Bool)
-> (UrlStrategy -> UrlStrategy -> Bool)
-> (UrlStrategy -> UrlStrategy -> UrlStrategy)
-> (UrlStrategy -> UrlStrategy -> UrlStrategy)
-> Ord UrlStrategy
UrlStrategy -> UrlStrategy -> Bool
UrlStrategy -> UrlStrategy -> Ordering
UrlStrategy -> UrlStrategy -> UrlStrategy
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UrlStrategy -> UrlStrategy -> UrlStrategy
$cmin :: UrlStrategy -> UrlStrategy -> UrlStrategy
max :: UrlStrategy -> UrlStrategy -> UrlStrategy
$cmax :: UrlStrategy -> UrlStrategy -> UrlStrategy
>= :: UrlStrategy -> UrlStrategy -> Bool
$c>= :: UrlStrategy -> UrlStrategy -> Bool
> :: UrlStrategy -> UrlStrategy -> Bool
$c> :: UrlStrategy -> UrlStrategy -> Bool
<= :: UrlStrategy -> UrlStrategy -> Bool
$c<= :: UrlStrategy -> UrlStrategy -> Bool
< :: UrlStrategy -> UrlStrategy -> Bool
$c< :: UrlStrategy -> UrlStrategy -> Bool
compare :: UrlStrategy -> UrlStrategy -> Ordering
$ccompare :: UrlStrategy -> UrlStrategy -> Ordering
$cp1Ord :: Eq UrlStrategy
Ord)

instance FromJSON UrlStrategy where
  parseJSON :: Value -> Parser UrlStrategy
parseJSON Value
val =
    UrlStrategy -> Text -> Value -> Parser UrlStrategy
f UrlStrategy
UrlPretty Text
"pretty" Value
val Parser UrlStrategy -> Parser UrlStrategy -> Parser UrlStrategy
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> UrlStrategy -> Text -> Value -> Parser UrlStrategy
f UrlStrategy
UrlDirect Text
"direct" Value
val
    where
      f :: UrlStrategy -> Text -> Value -> Parser UrlStrategy
      f :: UrlStrategy -> Text -> Value -> Parser UrlStrategy
f UrlStrategy
c Text
s Value
v = do
        Text
x <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s
        UrlStrategy -> Parser UrlStrategy
forall (f :: * -> *) a. Applicative f => a -> f a
pure UrlStrategy
c

-- | Return the relative URL of the given route
--
-- As the returned URL is relative, you will have to either make it absolute (by
-- prepending with `/`) or set the `<base>` URL in your HTML head element.
routeUrlWith :: forall r model. Ema model r => UrlStrategy -> model -> r -> Text
routeUrlWith :: UrlStrategy -> model -> r -> Text
routeUrlWith UrlStrategy
urlStrategy model
model =
  String -> Text
relUrlFromPath (String -> Text) -> (r -> String) -> r -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. model -> r -> String
forall model route. Ema model route => model -> route -> String
encodeRoute model
model
  where
    relUrlFromPath :: FilePath -> Text
    relUrlFromPath :: String -> Text
relUrlFromPath String
fp =
      case Text -> Text -> Maybe Text
T.stripSuffix (UrlStrategy -> Text
urlStrategySuffix UrlStrategy
urlStrategy) (String -> Text
forall a. ToText a => a -> Text
toText String
fp) of
        Just Text
htmlFp ->
          case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (Text -> Text
UE.encodeText (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
unicodeNormalize (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
T.splitOn Text
"/" Text
htmlFp) of
            Maybe (NonEmpty Text)
Nothing ->
              Text
""
            Just (Text -> NonEmpty Text -> [Text]
forall a. Eq a => a -> NonEmpty a -> [a]
removeLastIf Text
"index" -> [Text]
partsSansIndex) ->
              Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
partsSansIndex
        Maybe Text
Nothing ->
          Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
UE.encodeText (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
unicodeNormalize (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
T.splitOn Text
"/" (String -> Text
forall a. ToText a => a -> Text
toText String
fp)
      where
        removeLastIf :: Eq a => a -> NonEmpty a -> [a]
        removeLastIf :: a -> NonEmpty a -> [a]
removeLastIf a
x NonEmpty a
xs =
          if NonEmpty a -> a
forall a. NonEmpty a -> a
NE.last NonEmpty a
xs a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
            then NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.init NonEmpty a
xs
            else NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty a
xs
        urlStrategySuffix :: UrlStrategy -> Text
urlStrategySuffix = \case
          UrlStrategy
UrlPretty -> Text
".html"
          UrlStrategy
UrlDirect -> Text
""

routeUrl :: forall r model. Ema model r => model -> r -> Text
routeUrl :: model -> r -> Text
routeUrl =
  UrlStrategy -> model -> r -> Text
forall r model. Ema model r => UrlStrategy -> model -> r -> Text
routeUrlWith UrlStrategy
UrlPretty