module PuffyTools.Slug (
Slug,
mkSlugMaybe,
mkSlugEither,
mkRandomSlug,
mkSlugIO,
slugAcceptChars,
unSlug,
) where
import Control.Applicative
import Control.Monad
import Data.Aeson
import Data.Monoid ((<>))
import Data.Random
import Data.Text (Text)
import qualified Data.Text as T
newtype Slug = MkSlug { unSlug :: Text }
deriving (Eq, Show)
mkSlugMaybe :: Text -> Maybe Slug
mkSlugMaybe s = case mkSlugEither s of
Left _ -> Nothing
Right q -> Just q
mkSlugEither :: Text -> Either String Slug
mkSlugEither s
| T.length s < 1 = Left "The slug must be at least 4 chars long."
| ftb /= s = Left $ "The slug may only contain these characters: " <> slugAcceptChars
| otherwise = Right $ MkSlug s
where
ftb :: Text
ftb = T.filter (\c -> c `elem` slugAcceptChars) s
mkSlugIO :: Text -> IO Slug
mkSlugIO t = case mkSlugEither t of
Left msg -> fail msg
Right slg -> return slg
mkRandomSlug :: IO Slug
mkRandomSlug = T.pack <$> (replicateM 32 ioc) >>= \s -> case mkSlugEither s of
Left err -> fail err
Right slg -> return slg
where
ioc :: IO Char
ioc = runRVar rvc StdRandom
rvc :: RVar Char
rvc = randomElement slugAcceptChars
slugAcceptChars :: String
slugAcceptChars = ['A' .. 'Z'] <> ['a' .. 'z'] <> ['0' .. '9'] <> "-_"
instance FromJSON Slug where
parseJSON (String s) = case mkSlugEither s of
Left err -> fail err
Right slg -> return slg
parseJSON _ = fail "Slug must be of type String."
instance ToJSON Slug where
toJSON (MkSlug s) = toJSON s