{-# LANGUAGE DeriveAnyClass #-}

module Emanote.Route.SiteRoute.Type (
  SiteRoute (..),
  VirtualRoute (..),
  ResourceRoute (..),
  decodeVirtualRoute,
  encodeVirtualRoute,
  encodeTagIndexR,
) where

import Data.Aeson (ToJSON)
import Emanote.Pandoc.Markdown.Syntax.HashTag qualified as HT
import Emanote.Route.Ext qualified as Ext
import Emanote.Route.ModelRoute (LMLRoute, StaticFileRoute, lmlRouteCase)
import Emanote.Route.R qualified as R
import Network.URI.Slug qualified as Slug
import Relude hiding (show)
import Text.Show (show)

-- | A route to a virtual resource (not in `Model`)
data VirtualRoute
  = VirtualRoute_Index
  | VirtualRoute_TagIndex [HT.TagNode]
  | VirtualRoute_Export
  | VirtualRoute_StorkIndex
  | VirtualRoute_TaskIndex
  deriving stock (VirtualRoute -> VirtualRoute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VirtualRoute -> VirtualRoute -> Bool
$c/= :: VirtualRoute -> VirtualRoute -> Bool
== :: VirtualRoute -> VirtualRoute -> Bool
$c== :: VirtualRoute -> VirtualRoute -> Bool
Eq, Eq VirtualRoute
VirtualRoute -> VirtualRoute -> Bool
VirtualRoute -> VirtualRoute -> Ordering
VirtualRoute -> VirtualRoute -> VirtualRoute
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 :: VirtualRoute -> VirtualRoute -> VirtualRoute
$cmin :: VirtualRoute -> VirtualRoute -> VirtualRoute
max :: VirtualRoute -> VirtualRoute -> VirtualRoute
$cmax :: VirtualRoute -> VirtualRoute -> VirtualRoute
>= :: VirtualRoute -> VirtualRoute -> Bool
$c>= :: VirtualRoute -> VirtualRoute -> Bool
> :: VirtualRoute -> VirtualRoute -> Bool
$c> :: VirtualRoute -> VirtualRoute -> Bool
<= :: VirtualRoute -> VirtualRoute -> Bool
$c<= :: VirtualRoute -> VirtualRoute -> Bool
< :: VirtualRoute -> VirtualRoute -> Bool
$c< :: VirtualRoute -> VirtualRoute -> Bool
compare :: VirtualRoute -> VirtualRoute -> Ordering
$ccompare :: VirtualRoute -> VirtualRoute -> Ordering
Ord, Int -> VirtualRoute -> ShowS
[VirtualRoute] -> ShowS
VirtualRoute -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [VirtualRoute] -> ShowS
$cshowList :: [VirtualRoute] -> ShowS
show :: VirtualRoute -> FilePath
$cshow :: VirtualRoute -> FilePath
showsPrec :: Int -> VirtualRoute -> ShowS
$cshowsPrec :: Int -> VirtualRoute -> ShowS
Show, forall x. Rep VirtualRoute x -> VirtualRoute
forall x. VirtualRoute -> Rep VirtualRoute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VirtualRoute x -> VirtualRoute
$cfrom :: forall x. VirtualRoute -> Rep VirtualRoute x
Generic)
  deriving anyclass ([VirtualRoute] -> Encoding
[VirtualRoute] -> Value
VirtualRoute -> Encoding
VirtualRoute -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VirtualRoute] -> Encoding
$ctoEncodingList :: [VirtualRoute] -> Encoding
toJSONList :: [VirtualRoute] -> Value
$ctoJSONList :: [VirtualRoute] -> Value
toEncoding :: VirtualRoute -> Encoding
$ctoEncoding :: VirtualRoute -> Encoding
toJSON :: VirtualRoute -> Value
$ctoJSON :: VirtualRoute -> Value
ToJSON)

{- | A route to a resource in `Model`

 This is *mostly isomorphic* to `ModelRoute`, except for containing the
 absolute path to the static file.
-}
data ResourceRoute
  = ResourceRoute_StaticFile StaticFileRoute FilePath
  | ResourceRoute_LML LMLRoute
  deriving stock (ResourceRoute -> ResourceRoute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResourceRoute -> ResourceRoute -> Bool
$c/= :: ResourceRoute -> ResourceRoute -> Bool
== :: ResourceRoute -> ResourceRoute -> Bool
$c== :: ResourceRoute -> ResourceRoute -> Bool
Eq, Int -> ResourceRoute -> ShowS
[ResourceRoute] -> ShowS
ResourceRoute -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ResourceRoute] -> ShowS
$cshowList :: [ResourceRoute] -> ShowS
show :: ResourceRoute -> FilePath
$cshow :: ResourceRoute -> FilePath
showsPrec :: Int -> ResourceRoute -> ShowS
$cshowsPrec :: Int -> ResourceRoute -> ShowS
Show, Eq ResourceRoute
ResourceRoute -> ResourceRoute -> Bool
ResourceRoute -> ResourceRoute -> Ordering
ResourceRoute -> ResourceRoute -> ResourceRoute
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 :: ResourceRoute -> ResourceRoute -> ResourceRoute
$cmin :: ResourceRoute -> ResourceRoute -> ResourceRoute
max :: ResourceRoute -> ResourceRoute -> ResourceRoute
$cmax :: ResourceRoute -> ResourceRoute -> ResourceRoute
>= :: ResourceRoute -> ResourceRoute -> Bool
$c>= :: ResourceRoute -> ResourceRoute -> Bool
> :: ResourceRoute -> ResourceRoute -> Bool
$c> :: ResourceRoute -> ResourceRoute -> Bool
<= :: ResourceRoute -> ResourceRoute -> Bool
$c<= :: ResourceRoute -> ResourceRoute -> Bool
< :: ResourceRoute -> ResourceRoute -> Bool
$c< :: ResourceRoute -> ResourceRoute -> Bool
compare :: ResourceRoute -> ResourceRoute -> Ordering
$ccompare :: ResourceRoute -> ResourceRoute -> Ordering
Ord, forall x. Rep ResourceRoute x -> ResourceRoute
forall x. ResourceRoute -> Rep ResourceRoute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResourceRoute x -> ResourceRoute
$cfrom :: forall x. ResourceRoute -> Rep ResourceRoute x
Generic)
  deriving anyclass ([ResourceRoute] -> Encoding
[ResourceRoute] -> Value
ResourceRoute -> Encoding
ResourceRoute -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ResourceRoute] -> Encoding
$ctoEncodingList :: [ResourceRoute] -> Encoding
toJSONList :: [ResourceRoute] -> Value
$ctoJSONList :: [ResourceRoute] -> Value
toEncoding :: ResourceRoute -> Encoding
$ctoEncoding :: ResourceRoute -> Encoding
toJSON :: ResourceRoute -> Value
$ctoJSON :: ResourceRoute -> Value
ToJSON)

data SiteRoute
  = SiteRoute_VirtualRoute VirtualRoute
  | SiteRoute_ResourceRoute ResourceRoute
  | SiteRoute_MissingR FilePath
  | SiteRoute_AmbiguousR FilePath (NonEmpty LMLRoute)
  deriving stock (SiteRoute -> SiteRoute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SiteRoute -> SiteRoute -> Bool
$c/= :: SiteRoute -> SiteRoute -> Bool
== :: SiteRoute -> SiteRoute -> Bool
$c== :: SiteRoute -> SiteRoute -> Bool
Eq, Eq SiteRoute
SiteRoute -> SiteRoute -> Bool
SiteRoute -> SiteRoute -> Ordering
SiteRoute -> SiteRoute -> SiteRoute
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 :: SiteRoute -> SiteRoute -> SiteRoute
$cmin :: SiteRoute -> SiteRoute -> SiteRoute
max :: SiteRoute -> SiteRoute -> SiteRoute
$cmax :: SiteRoute -> SiteRoute -> SiteRoute
>= :: SiteRoute -> SiteRoute -> Bool
$c>= :: SiteRoute -> SiteRoute -> Bool
> :: SiteRoute -> SiteRoute -> Bool
$c> :: SiteRoute -> SiteRoute -> Bool
<= :: SiteRoute -> SiteRoute -> Bool
$c<= :: SiteRoute -> SiteRoute -> Bool
< :: SiteRoute -> SiteRoute -> Bool
$c< :: SiteRoute -> SiteRoute -> Bool
compare :: SiteRoute -> SiteRoute -> Ordering
$ccompare :: SiteRoute -> SiteRoute -> Ordering
Ord, forall x. Rep SiteRoute x -> SiteRoute
forall x. SiteRoute -> Rep SiteRoute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SiteRoute x -> SiteRoute
$cfrom :: forall x. SiteRoute -> Rep SiteRoute x
Generic)

instance Show SiteRoute where
  show :: SiteRoute -> FilePath
show = \case
    SiteRoute_MissingR FilePath
urlPath ->
      FilePath
"404: " forall a. Semigroup a => a -> a -> a
<> FilePath
urlPath
    SiteRoute_AmbiguousR FilePath
urlPath NonEmpty LMLRoute
_notes ->
      FilePath
"Amb: " forall a. Semigroup a => a -> a -> a
<> FilePath
urlPath
    SiteRoute_ResourceRoute ResourceRoute
rr ->
      case ResourceRoute
rr of
        ResourceRoute_StaticFile StaticFileRoute
r FilePath
_fp ->
          forall a. Show a => a -> FilePath
show StaticFileRoute
r
        ResourceRoute_LML LMLRoute
r ->
          forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ LMLRoute
-> Either
     (R @SourceExt ('LMLType 'Md)) (R @SourceExt ('LMLType 'Org))
lmlRouteCase LMLRoute
r
    SiteRoute_VirtualRoute VirtualRoute
x ->
      forall a. Show a => a -> FilePath
show VirtualRoute
x

decodeVirtualRoute :: FilePath -> Maybe VirtualRoute
decodeVirtualRoute :: FilePath -> Maybe VirtualRoute
decodeVirtualRoute FilePath
fp =
  (VirtualRoute
VirtualRoute_Index forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ FilePath -> Maybe ()
decodeIndexR FilePath
fp)
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ([TagNode] -> VirtualRoute
VirtualRoute_TagIndex forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Maybe [TagNode]
decodeTagIndexR FilePath
fp)
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (VirtualRoute
VirtualRoute_Export forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ FilePath -> Maybe ()
decodeExportR FilePath
fp)
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (VirtualRoute
VirtualRoute_StorkIndex forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ FilePath -> Maybe ()
decodeStorkIndexR FilePath
fp)
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (VirtualRoute
VirtualRoute_TaskIndex forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ FilePath -> Maybe ()
decodeTaskIndexR FilePath
fp)

decodeIndexR :: FilePath -> Maybe ()
decodeIndexR :: FilePath -> Maybe ()
decodeIndexR FilePath
fp = do
  Slug
"-" :| [Slug
"all"] <- 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
R.unRoute forall a b. (a -> b) -> a -> b
$ FilePath -> R @() 'Html
R.decodeHtmlRoute FilePath
fp
  forall (f :: Type -> Type). Applicative f => f ()
pass

decodeExportR :: FilePath -> Maybe ()
decodeExportR :: FilePath -> Maybe ()
decodeExportR FilePath
fp = do
  Slug
"-" :| [Slug
"export.json"] <- forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
R.unRoute forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Maybe StaticFileRoute
R.decodeAnyRoute FilePath
fp
  forall (f :: Type -> Type). Applicative f => f ()
pass

decodeStorkIndexR :: FilePath -> Maybe ()
decodeStorkIndexR :: FilePath -> Maybe ()
decodeStorkIndexR FilePath
fp = do
  Slug
"-" :| [Slug
"stork.st"] <- forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
R.unRoute forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Maybe StaticFileRoute
R.decodeAnyRoute FilePath
fp
  forall (f :: Type -> Type). Applicative f => f ()
pass

decodeTagIndexR :: FilePath -> Maybe [HT.TagNode]
decodeTagIndexR :: FilePath -> Maybe [TagNode]
decodeTagIndexR FilePath
fp = do
  Slug
"-" :| Slug
"tags" : [Slug]
tagPath <- 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
R.unRoute forall a b. (a -> b) -> a -> b
$ FilePath -> R @() 'Html
R.decodeHtmlRoute FilePath
fp
  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> TagNode
HT.TagNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slug -> Text
Slug.unSlug) [Slug]
tagPath

decodeTaskIndexR :: FilePath -> Maybe ()
decodeTaskIndexR :: FilePath -> Maybe ()
decodeTaskIndexR FilePath
fp = do
  Slug
"-" :| [Slug
"tasks"] <- 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
R.unRoute forall a b. (a -> b) -> a -> b
$ FilePath -> R @() 'Html
R.decodeHtmlRoute FilePath
fp
  forall (f :: Type -> Type). Applicative f => f ()
pass

-- NOTE: The sentinel route slugs in this function should match with those of
-- the decoders above.
encodeVirtualRoute :: VirtualRoute -> FilePath
encodeVirtualRoute :: VirtualRoute -> FilePath
encodeVirtualRoute = \case
  VirtualRoute_TagIndex [TagNode]
tagNodes ->
    forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute forall a b. (a -> b) -> a -> b
$ [TagNode] -> R @() 'Html
encodeTagIndexR [TagNode]
tagNodes
  VirtualRoute
VirtualRoute_Index ->
    forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute forall a b. (a -> b) -> a -> b
$ forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R.R @() @('Ext.Html) forall a b. (a -> b) -> a -> b
$ Slug
"-" forall a. a -> [a] -> NonEmpty a
:| [Slug
"all"]
  VirtualRoute
VirtualRoute_Export ->
    forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute forall a b. (a -> b) -> a -> b
$ forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R.R @Ext.SourceExt @('Ext.AnyExt) forall a b. (a -> b) -> a -> b
$ Slug
"-" forall a. a -> [a] -> NonEmpty a
:| [Slug
"export.json"]
  VirtualRoute
VirtualRoute_StorkIndex ->
    forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute forall a b. (a -> b) -> a -> b
$ forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R.R @Ext.SourceExt @('Ext.AnyExt) forall a b. (a -> b) -> a -> b
$ Slug
"-" forall a. a -> [a] -> NonEmpty a
:| [Slug
"stork.st"]
  VirtualRoute
VirtualRoute_TaskIndex ->
    forall a (ft :: FileType a). HasExt @a ft => R @a ft -> FilePath
R.encodeRoute forall a b. (a -> b) -> a -> b
$ forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R.R @() @('Ext.Html) forall a b. (a -> b) -> a -> b
$ Slug
"-" forall a. a -> [a] -> NonEmpty a
:| [Slug
"tasks"]

encodeTagIndexR :: [HT.TagNode] -> R.R 'Ext.Html
encodeTagIndexR :: [TagNode] -> R @() 'Html
encodeTagIndexR [TagNode]
tagNodes =
  forall a (ext :: FileType a). NonEmpty Slug -> R @a ext
R.R forall a b. (a -> b) -> a -> b
$ Slug
"-" forall a. a -> [a] -> NonEmpty a
:| Slug
"tags" forall a. a -> [a] -> [a]
: forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (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
. TagNode -> Text
HT.unTagNode) [TagNode]
tagNodes