{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Articles.Slugs
  ( extractIDFromSlug
  , mkNoIDSlug
  , mkSlug
  ) where

import Conduit.Features.Articles.Errors (ArticleError (..))
import Conduit.Features.Articles.Types (ArticleID(..), NoIDSlug(..), Slug(..))
import Data.Char (isAlphaNum, isSpace)
import Data.Text qualified as T

-- | Creates a Slug where a slug is "<articleID>-<slugifiedTitle>". Depends on a formerly built 'NoIDSlug'.
mkSlug :: ArticleID -> NoIDSlug -> Slug
mkSlug :: ArticleID -> NoIDSlug -> Slug
mkSlug ArticleID
articleID NoIDSlug
slug = Text -> Slug
Slug (Text -> Slug) -> Text -> Slug
forall a b. (a -> b) -> a -> b
$ Int64 -> Text
forall b a. (Show a, IsString b) => a -> b
show ArticleID
articleID.unID Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NoIDSlug
slug.unSlug

-- | Creates a NoIDSlug where the ID-less slug is the alphanumeric words of the title with the spaces becoming dashes.
--   Note that it's ID-less and only suitable as an intermediate representation.
mkNoIDSlug :: Text -> NoIDSlug
mkNoIDSlug :: Text -> NoIDSlug
mkNoIDSlug = Text -> NoIDSlug
NoIDSlug (Text -> NoIDSlug) -> (Text -> Text) -> Text -> NoIDSlug
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isValidSlugChar (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
space2dash

space2dash :: Char -> Char
space2dash :: Char -> Char
space2dash Char
c
  | Char -> Bool
isSpace Char
c = Char
'-'
  | Bool
otherwise = Char
c

isValidSlugChar :: Char -> Bool
isValidSlugChar :: Char -> Bool
isValidSlugChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

-- | Attempts to extract the ID from a Slug, where the slug is "<articleID>-<slugifiedTitle>".
-- 
--   The reason it's an opaque-er newtype rather than a proper invarient is just because
--   'Slug's are allowed to be created without proper validation, with it rather being deferred
--   to this function instead.
extractIDFromSlug :: Slug -> Either ArticleError ArticleID
extractIDFromSlug :: Slug -> Either ArticleError ArticleID
extractIDFromSlug Slug
slug = Slug
slug.unSlug
   Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
&  HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"-"
   [Text] -> ([Text] -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
&  (NonEmpty Text -> Text) -> [Text] -> Maybe Text
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty Text -> Text
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head
  Maybe Text -> (Text -> String) -> Maybe String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> String
forall a. ToString a => a -> String
toString
  Maybe String -> (String -> Maybe ArticleID) -> Maybe ArticleID
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe ArticleID
forall a. Read a => String -> Maybe a
readMaybe
   Maybe ArticleID
-> (Maybe ArticleID -> Either ArticleError ArticleID)
-> Either ArticleError ArticleID
forall a b. a -> (a -> b) -> b
&  ArticleError -> Maybe ArticleID -> Either ArticleError ArticleID
forall l r. l -> Maybe r -> Either l r
maybeToRight ArticleError
InvalidSlugEx