{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Zettel site's routes
module Neuron.Zettelkasten.Route where

import qualified Data.Text as T
import Neuron.Zettelkasten.Config
import Neuron.Zettelkasten.Graph
import Neuron.Zettelkasten.ID
import Neuron.Zettelkasten.Store
import Neuron.Zettelkasten.Type
import Path
import Relude
import Rib (IsRoute (..))
import Rib.Extra.OpenGraph
import qualified Rib.Parser.MMark as MMark
import qualified Text.URI as URI

data Route store graph a where
  Route_IndexRedirect :: Route ZettelStore ZettelGraph ()
  Route_ZIndex :: Route ZettelStore ZettelGraph ()
  Route_Zettel :: ZettelID -> Route ZettelStore ZettelGraph ()

instance IsRoute (Route store graph) where
  routeFile :: Route store graph a -> m (Path Rel File)
routeFile = \case
    Route_IndexRedirect ->
      Path Rel File -> m (Path Rel File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [relfile|index.html|]
    Route_ZIndex ->
      Path Rel File -> m (Path Rel File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [relfile|z-index.html|]
    Route_Zettel (ZettelID -> Text
unZettelID -> Text
zid) ->
      FilePath -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile (FilePath -> m (Path Rel File)) -> FilePath -> m (Path Rel File)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
zid FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ".html"

-- | Return short name corresponding to the route
routeName :: Route store graph a -> Text
routeName :: Route store graph a -> Text
routeName = \case
  Route_IndexRedirect -> "Index"
  Route_ZIndex -> "Zettels"
  Route_Zettel zid :: ZettelID
zid -> ZettelID -> Text
unZettelID ZettelID
zid

-- | Return full title for a route
routeTitle :: Config -> store -> Route store graph a -> Text
routeTitle :: Config -> store -> Route store graph a -> Text
routeTitle Config {..} store :: store
store =
  Text -> Text -> Text
forall a. (Eq a, Semigroup a, IsString a) => a -> a -> a
withSuffix Text
siteTitle (Text -> Text)
-> (Route store graph a -> Text) -> Route store graph a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. store -> Route store graph a -> Text
forall store graph a. store -> Route store graph a -> Text
routeTitle' store
store
  where
    withSuffix :: a -> a -> a
withSuffix suffix :: a
suffix x :: a
x =
      if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
suffix
        then a
x
        else a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> " - " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
suffix

-- | Return the title for a route
routeTitle' :: store -> Route store graph a -> Text
routeTitle' :: store -> Route store graph a -> Text
routeTitle' store :: store
store = \case
  Route_IndexRedirect -> "Index"
  Route_ZIndex -> "Zettel Index"
  Route_Zettel ((ZettelID -> ZettelStore -> Zettel)
-> ZettelStore -> ZettelID -> Zettel
forall a b c. (a -> b -> c) -> b -> a -> c
flip ZettelID -> ZettelStore -> Zettel
lookupStore store
ZettelStore
store -> Zettel {..}) ->
    Text
zettelTitle

routeOpenGraph :: Config -> store -> Route store graph a -> OpenGraph
routeOpenGraph :: Config -> store -> Route store graph a -> OpenGraph
routeOpenGraph Config {..} store :: store
store r :: Route store graph a
r =
  OpenGraph :: Text
-> Maybe URI
-> Maybe Text
-> Maybe Text
-> Text
-> Maybe OGType
-> Maybe URI
-> OpenGraph
OpenGraph
    { _openGraph_title :: Text
_openGraph_title = store -> Route store graph a -> Text
forall store graph a. store -> Route store graph a -> Text
routeTitle' store
store Route store graph a
r,
      _openGraph_siteName :: Text
_openGraph_siteName = Text
siteTitle,
      _openGraph_description :: Maybe Text
_openGraph_description = case Route store graph a
r of
        Route_IndexRedirect -> Maybe Text
forall a. Maybe a
Nothing
        Route_ZIndex -> Text -> Maybe Text
forall a. a -> Maybe a
Just "Zettelkasten Index"
        Route_Zettel ((ZettelID -> ZettelStore -> Zettel)
-> ZettelStore -> ZettelID -> Zettel
forall a b c. (a -> b -> c) -> b -> a -> c
flip ZettelID -> ZettelStore -> Zettel
lookupStore store
ZettelStore
store -> Zettel {..}) ->
          Int -> Text -> Text
T.take 300 (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MMark -> Maybe Text
MMark.getFirstParagraphText MMark
zettelContent,
      _openGraph_author :: Maybe Text
_openGraph_author = Maybe Text
author,
      _openGraph_type :: Maybe OGType
_openGraph_type = case Route store graph a
r of
        Route_Zettel _ -> OGType -> Maybe OGType
forall a. a -> Maybe a
Just (OGType -> Maybe OGType) -> OGType -> Maybe OGType
forall a b. (a -> b) -> a -> b
$ Article -> OGType
OGType_Article (Maybe Text
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> [Text]
-> Article
Article Maybe Text
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing [Text]
forall a. Monoid a => a
mempty)
        _ -> OGType -> Maybe OGType
forall a. a -> Maybe a
Just OGType
OGType_Website,
      _openGraph_image :: Maybe URI
_openGraph_image = case Route store graph a
r of
        Route_Zettel ((ZettelID -> ZettelStore -> Zettel)
-> ZettelStore -> ZettelID -> Zettel
forall a b c. (a -> b -> c) -> b -> a -> c
flip ZettelID -> ZettelStore -> Zettel
lookupStore store
ZettelStore
store -> Zettel {..}) -> do
          URI
img <- MMark -> Maybe URI
MMark.getFirstImg MMark
zettelContent
          URI
baseUrl <- Text -> Maybe URI
forall (m :: * -> *). MonadThrow m => Text -> m URI
URI.mkURI (Text -> Maybe URI) -> Maybe Text -> Maybe URI
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
siteBaseUrl
          URI -> URI -> Maybe URI
URI.relativeTo URI
img URI
baseUrl
        _ -> Maybe URI
forall a. Maybe a
Nothing,
      _openGraph_url :: Maybe URI
_openGraph_url = Maybe URI
forall a. Maybe a
Nothing
    }