{-# 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 :: UrlStrategy -> Prism' FilePath r -> r -> Text
routeUrlWith UrlStrategy
urlStrategy Prism' FilePath r
rp =
  FilePath -> Text
relUrlFromPath (FilePath -> Text) -> (r -> FilePath) -> r -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' FilePath r -> r -> FilePath
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 Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath) -> Maybe Text -> Maybe FilePath
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) (FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
fp) of
        Just FilePath
htmlFp ->
          case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (FilePath -> [Text]
filepathToUrl FilePath
htmlFp) of
            Maybe (NonEmpty Text)
Nothing ->
              Text
""
            Just ([Text] -> NonEmpty Text -> [Text]
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
"/" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> [Text]
filepathToUrl FilePath
fp
      where
        removeLastIfOneOf :: Eq a => [a] -> NonEmpty a -> [a]
        removeLastIfOneOf :: [a] -> NonEmpty a -> [a]
removeLastIfOneOf [a]
x NonEmpty a
xs =
          if NonEmpty a -> a
forall (f :: Type -> Type) a. IsNonEmpty f a a "last" => f a -> a
last NonEmpty a
xs a -> [a] -> Bool
forall (f :: Type -> Type) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [a]
x
            then NonEmpty a -> [a]
forall (f :: Type -> Type) a.
IsNonEmpty f a [a] "init" =>
f a -> [a]
init NonEmpty a
xs
            else NonEmpty a -> [a]
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 =
  (Text -> Text) -> [Text] -> [Text]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Slug -> Text
Slug.encodeSlug (Slug -> Text) -> (Text -> Slug) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsString Slug => FilePath -> Slug
forall a. IsString a => FilePath -> a
fromString @Slug.Slug (FilePath -> Slug) -> (Text -> FilePath) -> Text -> Slug
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString) ([Text] -> [Text]) -> (FilePath -> [Text]) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"/" (Text -> [Text]) -> (FilePath -> Text) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a. ToText a => a -> Text
toText

urlToFilePath :: Text -> FilePath
urlToFilePath :: Text -> FilePath
urlToFilePath =
  Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Slug -> Text
Slug.unSlug (Slug -> Text) -> (Text -> Slug) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Slug
Slug.decodeSlug) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
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 :: Prism' FilePath r -> r -> Text
routeUrl =
  UrlStrategy -> Prism' FilePath r -> r -> Text
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
(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 -> FilePath
(Int -> UrlStrategy -> ShowS)
-> (UrlStrategy -> FilePath)
-> ([UrlStrategy] -> ShowS)
-> Show UrlStrategy
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
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, (forall x. UrlStrategy -> Rep UrlStrategy x)
-> (forall x. Rep UrlStrategy x -> UrlStrategy)
-> Generic UrlStrategy
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 Parser UrlStrategy -> Parser UrlStrategy -> Parser UrlStrategy
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 <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        Bool -> Parser ()
forall (f :: Type -> Type). 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 :: Type -> Type) a. Applicative f => a -> f a
pure UrlStrategy
c