{-# LANGUAGE InstanceSigs #-}

module Ema.Route.Url (
  -- * Create URL from route
  routeUrl,
  routeUrlWith,
  UrlStrategy (..),
  urlToFilePath,
) where

import Data.Aeson (FromJSON (parseJSON), Value)
import Data.Aeson.Types (Parser)
import Data.Text qualified as T
import Network.URI.Slug qualified as Slug
import Optics.Core (Prism', review)

{- | Return the relative URL of the given route

 Note: when using relative URLs it is imperative to set the `<base>` URL to your
 site's base URL or path (typically just `/`). Otherwise you must accordingly
 make these URLs absolute yourself.
-}
routeUrlWith :: HasCallStack => UrlStrategy -> Prism' FilePath r -> r -> Text
routeUrlWith :: forall r.
HasCallStack =>
UrlStrategy -> Prism' FilePath r -> r -> Text
routeUrlWith UrlStrategy
urlStrategy Prism' FilePath r
rp =
  FilePath -> Text
relUrlFromPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Prism' FilePath r
rp
  where
    relUrlFromPath :: FilePath -> Text
    relUrlFromPath :: FilePath -> Text
relUrlFromPath FilePath
fp =
      case forall a. ToString a => a -> FilePath
toString forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
T.stripSuffix (UrlStrategy -> Text
urlStrategySuffix UrlStrategy
urlStrategy) (forall a. ToText a => a -> Text
toText FilePath
fp) of
        Just FilePath
htmlFp ->
          case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (FilePath -> [Text]
filepathToUrl FilePath
htmlFp) of
            Maybe (NonEmpty Text)
Nothing ->
              Text
""
            Just (forall a. Eq a => [a] -> NonEmpty a -> [a]
removeLastIfOneOf [Text
"index", Text
"index.html"] -> [Text]
partsSansIndex) ->
              Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
partsSansIndex
        Maybe FilePath
Nothing ->
          Text -> [Text] -> Text
T.intercalate Text
"/" forall a b. (a -> b) -> a -> b
$ FilePath -> [Text]
filepathToUrl FilePath
fp
      where
        removeLastIfOneOf :: Eq a => [a] -> NonEmpty a -> [a]
        removeLastIfOneOf :: forall a. Eq a => [a] -> NonEmpty a -> [a]
removeLastIfOneOf [a]
x NonEmpty a
xs =
          if forall (f :: Type -> Type) a. IsNonEmpty f a a "last" => f a -> a
last NonEmpty a
xs forall (f :: Type -> Type) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [a]
x
            then forall (f :: Type -> Type) a.
IsNonEmpty f a [a] "init" =>
f a -> [a]
init NonEmpty a
xs
            else forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NonEmpty a
xs
        urlStrategySuffix :: UrlStrategy -> Text
urlStrategySuffix = \case
          UrlStrategy
UrlPretty -> Text
".html"
          UrlStrategy
UrlDirect -> Text
""

filepathToUrl :: FilePath -> [Text]
filepathToUrl :: FilePath -> [Text]
filepathToUrl =
  forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Slug -> Text
Slug.encodeSlug forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => FilePath -> a
fromString @Slug.Slug forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToString a => a -> FilePath
toString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText

urlToFilePath :: Text -> FilePath
urlToFilePath :: Text -> FilePath
urlToFilePath =
  forall a. ToString a => a -> FilePath
toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Slug -> Text
Slug.unSlug forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Slug
Slug.decodeSlug) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"/"

-- | Like `routeUrlWith` but uses @UrlDirect@ strategy
routeUrl :: HasCallStack => Prism' FilePath r -> r -> Text
routeUrl :: forall r. HasCallStack => Prism' FilePath r -> r -> Text
routeUrl =
  forall r.
HasCallStack =>
UrlStrategy -> Prism' FilePath r -> r -> Text
routeUrlWith UrlStrategy
UrlDirect

-- | How to produce URL paths from routes
data UrlStrategy
  = -- | Use pretty URLs. The route encoding "foo/bar.html" produces "foo/bar" as URL.
    UrlPretty
  | -- | Use filepaths as URLs. The route encoding "foo/bar.html" produces "foo/bar.html" as URL.
    UrlDirect
  deriving stock (UrlStrategy -> UrlStrategy -> Bool
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 -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UrlStrategy] -> ShowS
$cshowList :: [UrlStrategy] -> ShowS
show :: UrlStrategy -> FilePath
$cshow :: UrlStrategy -> FilePath
showsPrec :: Int -> UrlStrategy -> ShowS
$cshowsPrec :: Int -> UrlStrategy -> ShowS
Show, Eq 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
Ord, forall x. Rep UrlStrategy x -> UrlStrategy
forall x. UrlStrategy -> Rep UrlStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UrlStrategy x -> UrlStrategy
$cfrom :: forall x. UrlStrategy -> Rep UrlStrategy x
Generic)

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