module Emanote.Route.R where

import Data.Aeson (ToJSON (toJSON))
import Data.Data (Data)
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Emanote.Route.Ext (FileType (..), HasExt (..))
import Network.URI.Slug (Slug)
import Network.URI.Slug qualified as Slug
import Relude
import System.FilePath (splitPath)
import Text.Show qualified (Show (show))

{- | Represents the relative path to some file (or its isomporphic URL
 represetation).
-}
newtype R (ext :: FileType a) = R {forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
unRoute :: NonEmpty Slug}
  deriving stock (R @a ext -> R @a ext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a (ext :: FileType a). R @a ext -> R @a ext -> Bool
/= :: R @a ext -> R @a ext -> Bool
$c/= :: forall a (ext :: FileType a). R @a ext -> R @a ext -> Bool
== :: R @a ext -> R @a ext -> Bool
$c== :: forall a (ext :: FileType a). R @a ext -> R @a ext -> Bool
Eq, R @a ext -> R @a ext -> Bool
R @a ext -> R @a ext -> Ordering
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
forall a (ext :: FileType a). Eq (R @a ext)
forall a (ext :: FileType a). R @a ext -> R @a ext -> Bool
forall a (ext :: FileType a). R @a ext -> R @a ext -> Ordering
forall a (ext :: FileType a). R @a ext -> R @a ext -> R @a ext
min :: R @a ext -> R @a ext -> R @a ext
$cmin :: forall a (ext :: FileType a). R @a ext -> R @a ext -> R @a ext
max :: R @a ext -> R @a ext -> R @a ext
$cmax :: forall a (ext :: FileType a). R @a ext -> R @a ext -> R @a ext
>= :: R @a ext -> R @a ext -> Bool
$c>= :: forall a (ext :: FileType a). R @a ext -> R @a ext -> Bool
> :: R @a ext -> R @a ext -> Bool
$c> :: forall a (ext :: FileType a). R @a ext -> R @a ext -> Bool
<= :: R @a ext -> R @a ext -> Bool
$c<= :: forall a (ext :: FileType a). R @a ext -> R @a ext -> Bool
< :: R @a ext -> R @a ext -> Bool
$c< :: forall a (ext :: FileType a). R @a ext -> R @a ext -> Bool
compare :: R @a ext -> R @a ext -> Ordering
$ccompare :: forall a (ext :: FileType a). R @a ext -> R @a ext -> Ordering
Ord, Typeable, R @a ext -> DataType
R @a ext -> Constr
forall a.
Typeable @Type a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable @(Type -> Type) t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable @(Type -> Type -> Type) t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {a} {ext :: FileType a}.
(Typeable @Type a, Typeable @(FileType a) ext) =>
Typeable @Type (R @a ext)
forall a (ext :: FileType a).
(Typeable @Type a, Typeable @(FileType a) ext) =>
R @a ext -> DataType
forall a (ext :: FileType a).
(Typeable @Type a, Typeable @(FileType a) ext) =>
R @a ext -> Constr
forall a (ext :: FileType a).
(Typeable @Type a, Typeable @(FileType a) ext) =>
(forall b. Data b => b -> b) -> R @a ext -> R @a ext
forall a (ext :: FileType a) u.
(Typeable @Type a, Typeable @(FileType a) ext) =>
Int -> (forall d. Data d => d -> u) -> R @a ext -> u
forall a (ext :: FileType a) u.
(Typeable @Type a, Typeable @(FileType a) ext) =>
(forall d. Data d => d -> u) -> R @a ext -> [u]
forall a (ext :: FileType a) r r'.
(Typeable @Type a, Typeable @(FileType a) ext) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> R @a ext -> r
forall a (ext :: FileType a) r r'.
(Typeable @Type a, Typeable @(FileType a) ext) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> R @a ext -> r
forall a (ext :: FileType a) (m :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext, Monad m) =>
(forall d. Data d => d -> m d) -> R @a ext -> m (R @a ext)
forall a (ext :: FileType a) (m :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext, MonadPlus m) =>
(forall d. Data d => d -> m d) -> R @a ext -> m (R @a ext)
forall a (ext :: FileType a) (c :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (R @a ext)
forall a (ext :: FileType a) (c :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> R @a ext -> c (R @a ext)
forall a (ext :: FileType a) (t :: Type -> Type)
       (c :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext,
 Typeable @(Type -> Type) t) =>
(forall d. Data d => c (t d)) -> Maybe (c (R @a ext))
forall a (ext :: FileType a) (t :: Type -> Type -> Type)
       (c :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext,
 Typeable @(Type -> Type -> Type) t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (R @a ext))
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (R @a ext)
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> R @a ext -> c (R @a ext)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> R @a ext -> m (R @a ext)
$cgmapMo :: forall a (ext :: FileType a) (m :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext, MonadPlus m) =>
(forall d. Data d => d -> m d) -> R @a ext -> m (R @a ext)
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> R @a ext -> m (R @a ext)
$cgmapMp :: forall a (ext :: FileType a) (m :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext, MonadPlus m) =>
(forall d. Data d => d -> m d) -> R @a ext -> m (R @a ext)
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> R @a ext -> m (R @a ext)
$cgmapM :: forall a (ext :: FileType a) (m :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext, Monad m) =>
(forall d. Data d => d -> m d) -> R @a ext -> m (R @a ext)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> R @a ext -> u
$cgmapQi :: forall a (ext :: FileType a) u.
(Typeable @Type a, Typeable @(FileType a) ext) =>
Int -> (forall d. Data d => d -> u) -> R @a ext -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> R @a ext -> [u]
$cgmapQ :: forall a (ext :: FileType a) u.
(Typeable @Type a, Typeable @(FileType a) ext) =>
(forall d. Data d => d -> u) -> R @a ext -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> R @a ext -> r
$cgmapQr :: forall a (ext :: FileType a) r r'.
(Typeable @Type a, Typeable @(FileType a) ext) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> R @a ext -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> R @a ext -> r
$cgmapQl :: forall a (ext :: FileType a) r r'.
(Typeable @Type a, Typeable @(FileType a) ext) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> R @a ext -> r
gmapT :: (forall b. Data b => b -> b) -> R @a ext -> R @a ext
$cgmapT :: forall a (ext :: FileType a).
(Typeable @Type a, Typeable @(FileType a) ext) =>
(forall b. Data b => b -> b) -> R @a ext -> R @a ext
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (R @a ext))
$cdataCast2 :: forall a (ext :: FileType a) (t :: Type -> Type -> Type)
       (c :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext,
 Typeable @(Type -> Type -> Type) t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (R @a ext))
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c (R @a ext))
$cdataCast1 :: forall a (ext :: FileType a) (t :: Type -> Type)
       (c :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext,
 Typeable @(Type -> Type) t) =>
(forall d. Data d => c (t d)) -> Maybe (c (R @a ext))
dataTypeOf :: R @a ext -> DataType
$cdataTypeOf :: forall a (ext :: FileType a).
(Typeable @Type a, Typeable @(FileType a) ext) =>
R @a ext -> DataType
toConstr :: R @a ext -> Constr
$ctoConstr :: forall a (ext :: FileType a).
(Typeable @Type a, Typeable @(FileType a) ext) =>
R @a ext -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (R @a ext)
$cgunfold :: forall a (ext :: FileType a) (c :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (R @a ext)
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> R @a ext -> c (R @a ext)
$cgfoldl :: forall a (ext :: FileType a) (c :: Type -> Type).
(Typeable @Type a, Typeable @(FileType a) ext) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> R @a ext -> c (R @a ext)
Data)

instance HasExt ext => ToJSON (R ext) where
  toJSON :: R @a ext -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
encodeRoute

instance HasExt ext => Show (R ext) where
  show :: R @a ext -> FilePath
show R @a ext
r =
    forall a. ToString a => a -> FilePath
toString forall a b. (a -> b) -> a -> b
$
      FilePath
"R[/" forall a. Semigroup a => a -> a -> a
<> forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
encodeRoute R @a ext
r forall a. Semigroup a => a -> a -> a
<> FilePath
"]"

-- | Convert foo/bar.<ext> to a @R@
mkRouteFromFilePath :: forall a (ext :: FileType a). HasExt ext => FilePath -> Maybe (R ext)
mkRouteFromFilePath :: forall a (ext :: FileType a).
HasExt @a ext =>
FilePath -> Maybe (R @a ext)
mkRouteFromFilePath FilePath
fp = do
  FilePath
base <- forall a (ext :: FileType a).
HasExt @a ext =>
FilePath -> Maybe FilePath
withoutKnownExt @_ @ext FilePath
fp
  let slugs :: [Slug]
slugs = forall a. IsString a => FilePath -> a
fromString 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
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath]
splitPath FilePath
base
  forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R [Slug]
slugs

mkRouteFromSlugs :: NonEmpty Slug -> R ext
mkRouteFromSlugs :: forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
mkRouteFromSlugs =
  forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R

-- | If the route is a single-slug URL, return the only slug.
routeSlug :: R ext -> Maybe Slug
routeSlug :: forall {a} (ext :: FileType a). R @a ext -> Maybe Slug
routeSlug R @a ext
r = do
  Slug
x :| [] <- forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
unRoute R @a ext
r
  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Slug
x

-- | Like `routeSlug` but skips the given prefixes, returning the (only) pending slug.
routeSlugWithPrefix :: NonEmpty Slug -> R ext -> Maybe Slug
routeSlugWithPrefix :: forall {a} (ext :: FileType a).
NonEmpty Slug -> R @a ext -> Maybe Slug
routeSlugWithPrefix NonEmpty Slug
prefix R @a ext
r = do
  Slug
lastSlug :| (forall a. [a] -> Maybe (NonEmpty a)
nonEmpty -> Just NonEmpty Slug
prevSlugs) <- forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> NonEmpty a
NE.reverse forall a b. (a -> b) -> a -> b
$ forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
unRoute R @a ext
r
  forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty Slug
prevSlugs forall a. Eq a => a -> a -> Bool
== NonEmpty Slug
prefix
  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Slug
lastSlug

-- | The base name of the route without its parent path.
routeBaseName :: R ext -> Text
routeBaseName :: forall {a} (ext :: FileType a). R @a ext -> Text
routeBaseName =
  Slug -> Text
Slug.unSlug forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> NonEmpty a
NE.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
unRoute

routeParent :: R ext -> Maybe (R 'Folder)
routeParent :: forall {a} (ext :: FileType a). R @a ext -> Maybe (R @() 'Folder)
routeParent =
  forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Type -> Type) a.
IsNonEmpty f a [a] "init" =>
f a -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
unRoute

-- | For use in breadcrumbs
routeInits :: R ext -> NonEmpty (R ext)
routeInits :: forall {a} (ext :: FileType a). R @a ext -> NonEmpty (R @a ext)
routeInits = \case
  (R (Slug
"index" :| [])) ->
    forall x. One x => OneItem x -> x
one forall {a} (ext :: FileType a). R @a ext
indexRoute
  (R (Slug
slug :| [Slug]
rest')) ->
    forall {a} (ext :: FileType a). R @a ext
indexRoute forall a. a -> [a] -> NonEmpty a
:| case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Slug]
rest' of
      Maybe (NonEmpty Slug)
Nothing ->
        forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R (forall x. One x => OneItem x -> x
one Slug
slug)
      Just NonEmpty Slug
rest ->
        forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R (forall x. One x => OneItem x -> x
one Slug
slug) forall a. a -> [a] -> [a]
: forall {a} (ext :: FileType a).
NonEmpty Slug -> NonEmpty Slug -> [R @a ext]
go (forall x. One x => OneItem x -> x
one Slug
slug) NonEmpty Slug
rest
  where
    go :: NonEmpty Slug -> NonEmpty Slug -> [R ext]
    go :: forall {a} (ext :: FileType a).
NonEmpty Slug -> NonEmpty Slug -> [R @a ext]
go NonEmpty Slug
x (Slug
y :| [Slug]
ys') =
      let this :: R @a ext
this = forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R (NonEmpty Slug
x forall a. Semigroup a => a -> a -> a
<> forall x. One x => OneItem x -> x
one Slug
y)
       in case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Slug]
ys' of
            Maybe (NonEmpty Slug)
Nothing ->
              forall x. One x => OneItem x -> x
one R @a ext
this
            Just NonEmpty Slug
ys ->
              R @a ext
this forall a. a -> [a] -> [a]
: forall {a} (ext :: FileType a).
NonEmpty Slug -> NonEmpty Slug -> [R @a ext]
go (forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
unRoute R @a ext
this) NonEmpty Slug
ys

indexRoute :: R ext
indexRoute :: forall {a} (ext :: FileType a). R @a ext
indexRoute = forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R forall a b. (a -> b) -> a -> b
$ Slug
"index" forall a. a -> [a] -> NonEmpty a
:| []

-- | Convert a route to filepath
encodeRoute :: forall a (ft :: FileType a). HasExt ft => R ft -> FilePath
encodeRoute :: forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
encodeRoute (R NonEmpty Slug
slugs) =
  let parts :: NonEmpty Text
parts = Slug -> Text
Slug.unSlug forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Slug
slugs
   in forall a (ext :: FileType a). HasExt @a ext => ShowS
withExt @a @ft forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> FilePath
toString forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"/" (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NonEmpty Text
parts)

-- | Parse our route from html file path
decodeHtmlRoute :: FilePath -> R 'Html
decodeHtmlRoute :: FilePath -> R @() 'Html
decodeHtmlRoute FilePath
fp = do
  let base :: Text
base = forall a. a -> Maybe a -> a
fromMaybe (forall a. ToText a => a -> Text
toText FilePath
fp) forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix Text
".html" (forall a. ToText a => a -> Text
toText FilePath
fp)
  forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R forall a b. (a -> b) -> a -> b
$ case Text -> Text -> Maybe (NonEmpty Text)
splitOnNE Text
"/" Text
base of
    Maybe (NonEmpty Text)
Nothing ->
      forall x. One x => OneItem x -> x
one Slug
"index"
    Just NonEmpty Text
parts ->
      forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Slug
Slug.decodeSlug NonEmpty Text
parts
  where
    -- Like `T.splitOn` but returns a NonEmpty list with sensible semantics
    splitOnNE :: Text -> Text -> Maybe (NonEmpty Text)
splitOnNE Text
k Text
s =
      case Text -> Text -> [Text]
T.splitOn Text
k Text
s of
        [] -> forall a. Maybe a
Nothing
        [Text
""] -> forall a. Maybe a
Nothing
        Text
x : [Text]
xs -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
x forall a. a -> [a] -> NonEmpty a
:| [Text]
xs

decodeAnyRoute :: FilePath -> Maybe (R 'AnyExt)
decodeAnyRoute :: FilePath -> Maybe (R @SourceExt 'AnyExt)
decodeAnyRoute =
  forall a (ext :: FileType a).
HasExt @a ext =>
FilePath -> Maybe (R @a ext)
mkRouteFromFilePath @_ @('AnyExt)