{-# 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)
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)
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
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