fix: Codec for article slugs

src/Api/Endpoint.purs

@@ -19,10 +19,10 @@ import Conduit.Data.Username (Username)
 import Data.Generic.Rep (class Generic)
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Maybe (Maybe(..))
+import Data.Slug (Slug)
 import Routing.Duplex (RouteDuplex', int, optional, prefix, root, segment, string)
 import Routing.Duplex.Generic (noArgs, sum)
 import Routing.Duplex.Generic.Syntax ((/), (?))
-import Slug (Slug)
 
 -- | First, let's define a few types necessary for our larger `Endpoint` type.
 

src/Capability/Resource/Article.purs

@@ -17,8 +17,8 @@ import Conduit.Api.Endpoint (ArticleParams, Pagination)
 import Conduit.Data.Article (Article, ArticleWithMetadata)
 import Conduit.Data.PaginatedArray (PaginatedArray)
 import Data.Maybe (Maybe)
+import Data.Slug (Slug)
 import Halogen (HalogenM, lift)
-import Slug (Slug)
 
 -- | This capability represents the ability to manage articles in our system. Each function
 -- | represents a simple process to read, write, update, delete, favorite, or take some other action

src/Capability/Resource/Comment.purs

@@ -15,8 +15,8 @@ import Prelude
 
 import Conduit.Data.Comment (Comment, CommentId, CommentWithMetadata)
 import Data.Maybe (Maybe)
+import Data.Slug (Slug)
 import Halogen (HalogenM, lift)
-import Slug (Slug)
 
 -- | This capability represents the ability to manage comments in our system. Currently we only
 -- | need to get all comments, create a comment, or delete a comment, all of which must be

src/Component/Part/FavoriteButton.purs

@@ -20,10 +20,10 @@ import Conduit.Data.Article (ArticleWithMetadata)
 import Data.Foldable (for_)
 import Data.Lens (Traversal', preview, set)
 import Data.Maybe (Maybe)
+import Data.Slug (Slug)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
-import Slug (Slug)
 
 -- A simple way to control button sizes
 

src/Data/Article.purs

@@ -24,8 +24,8 @@ import Data.Codec.Argonaut.Migration as CAM
 import Data.Codec.Argonaut.Record as CAR
 import Data.Maybe (Maybe)
 import Data.PreciseDateTime (PreciseDateTime)
-import Slug (Slug)
-import Slug as Slug
+import Data.Slug (Slug)
+import Data.Slug as Slug
 import Type.Row (type (+))
 
 -- | First, we'll describe the core fields that are always present when we have an `Article`. In

src/Data/Route.purs

@@ -17,11 +17,11 @@ import Conduit.Data.Username (Username)
 import Conduit.Data.Username as Username
 import Data.Either (note)
 import Data.Generic.Rep (class Generic)
+import Data.Slug (Slug)
+import Data.Slug as Slug
 import Routing.Duplex (RouteDuplex', as, root, segment)
 import Routing.Duplex.Generic (noArgs, sum)
 import Routing.Duplex.Generic.Syntax ((/))
-import Slug (Slug)
-import Slug as Slug
 
 -- | We'll represent routes in our application with a simple sum type. As the application grows,
 -- | you might want to swap this out with an extensible sum type with `Variant` and have several

src/Data/Slug.purs

@@ -0,0 +1,120 @@
+module Data.Slug
+  ( Slug
+  , generate
+  , parse
+  , toString
+  , truncate
+  ) where
+
+import Prelude
+
+import Data.Argonaut.Decode (class DecodeJson, JsonDecodeError(..), decodeJson)
+import Data.Argonaut.Encode (class EncodeJson, encodeJson)
+import Data.Array as Array
+import Data.CodePoint.Unicode (isLatin1)
+import Data.Either (note)
+import Data.Maybe (Maybe(..))
+import Data.String as String
+import Data.String.CodePoints (codePointFromChar, fromCodePointArray, toCodePointArray)
+import Data.String.Pattern (Pattern(..), Replacement(..))
+
+-- | A `Slug` represents a string value which is guaranteed to have the
+-- | following qualities:
+-- |
+-- | - it is not empty
+-- | - it consists of groups of characters separated by `-` dashes,
+-- |   where the slug cannot begin or end with a dash, and there can
+-- |   never be two dashes in a row.
+-- |
+-- | Example: `Slug "this-is-an-article-slug"`
+newtype Slug = Slug String
+
+derive newtype instance Eq Slug
+derive newtype instance Ord Slug
+derive newtype instance Semigroup Slug
+
+instance Show Slug where
+  show (Slug str) = "(Slug " <> str <> ")"
+
+instance EncodeJson Slug where
+  encodeJson (Slug s) = encodeJson s
+
+instance DecodeJson Slug where
+  decodeJson = note (TypeMismatch "Slug") <<< parse <=< decodeJson
+
+-- | Create a `Slug` from a string. This will transform the input string
+-- | to be a valid slug (if it is possible to do so) by separating words
+-- | with `-` dashes, ensuring the string does not begin or end with a
+-- | dash, and ensuring there are never two dashes in a row.
+-- |
+-- | Slugs are usually created for article titles and other resources
+-- | which need a human-readable resource name in a URL.
+-- |
+-- | ```purescript
+-- | > Slug.generate "My article title!"
+-- | > Just (Slug "My-article-title")
+-- |
+-- | > Slug.generate "¬¬¬{}¬¬¬"
+-- | > Nothing
+-- | ```
+generate :: String -> Maybe Slug
+generate s = do
+  let arr = words $ onlyLatin1 $ stripApostrophes s
+  if Array.null arr then
+    Nothing
+  else
+    Just $ Slug $ String.joinWith "-" arr
+  where
+  -- Strip apostrophes to avoid unnecessary word breaks
+  stripApostrophes = String.replaceAll (Pattern "'") (Replacement "")
+
+  -- Replace non-Latin 1 characters with spaces to be stripped later.
+  onlyLatin1 =
+    fromCodePointArray
+      <<< map (\x -> if isLatin1 x then x else codePointFromChar ' ')
+      <<< toCodePointArray
+
+  -- Split on whitespace
+  words = Array.filter (not String.null) <<< String.split (Pattern " ")
+
+-- | Parse a valid slug (as a string) into a `Slug`. This will fail if the
+-- | string is not a valid slug and does not provide the same behavior as
+-- | `generate`.
+-- |
+-- | ```purescript
+-- | > Slug.parse "my-article-title"
+-- | > Just (Slug "my-article-title")
+-- |
+-- | > Slug.parse "My article"
+-- | > Nothing
+-- | ```
+parse :: String -> Maybe Slug
+parse str = generate str >>= check
+  where
+  check slug@(Slug s)
+    | s == str = Just slug
+    | otherwise = Nothing
+
+-- | Unwrap a `Slug` into the string contained within, without performing
+-- | any transformations.
+-- |
+-- | ```purescript
+-- | > Slug.toString (mySlug :: Slug)
+-- | > "my-slug-i-generated"
+-- | ```
+toString :: Slug -> String
+toString (Slug s) = s
+
+-- | Ensure a `Slug` is no longer than a given number of characters. If the last
+-- | character is a dash, it will also be removed. Providing a non-positive
+-- | number as the length will return `Nothing`.
+-- |
+-- | ```purescript
+-- | > Slug.create "My article title is long!" >>= Slug.truncate 3
+-- | > Just (Slug "My")
+-- | ```
+truncate :: Int -> Slug -> Maybe Slug
+truncate n (Slug s)
+  | n < 1 = Nothing
+  | n >= String.length s = Just (Slug s)
+  | otherwise = generate $ String.take n s

src/Page/Editor.purs

@@ -23,6 +23,7 @@ import Data.Either (either)
 import Data.Foldable (for_)
 import Data.Maybe (Maybe(..))
 import Data.Set as Set
+import Data.Slug (Slug)
 import Effect.Aff.Class (class MonadAff)
 import Formless as F
 import Halogen as H
@@ -34,7 +35,6 @@ import Halogen.Store.Monad (class MonadStore)
 import Halogen.Store.Select (selectEq)
 import Network.RemoteData (RemoteData(..), fromMaybe, toMaybe)
 import Safe.Coerce (coerce)
-import Slug (Slug)
 import Type.Proxy (Proxy(..))
 
 type Input = Maybe Slug

src/Page/ViewArticle.purs

@@ -30,6 +30,7 @@ import Data.Lens (Traversal', preview)
 import Data.Lens.Record (prop)
 import Data.Maybe (Maybe(..))
 import Data.Maybe as Maybe
+import Data.Slug (Slug)
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen.HTML as HH
@@ -39,7 +40,6 @@ import Halogen.Store.Connect (Connected, connect)
 import Halogen.Store.Monad (class MonadStore)
 import Halogen.Store.Select (selectEq)
 import Network.RemoteData (RemoteData(..), _Success, fromMaybe)
-import Slug (Slug)
 import Type.Proxy (Proxy(..))
 import Web.Event.Event (Event)
 import Web.Event.Event as Event