Permalink
Browse files

slugify WikiStyleTitles as-is

  • Loading branch information...
myfreeweb committed Nov 1, 2017
1 parent 778e9eb commit 2f27a9264c4dc1f4ae9fe678a29c1d75aa997957
@@ -3,7 +3,6 @@
module Sweetroll.App where
import Sweetroll.Prelude hiding (Context)
import Servant.Server
import Network.Wai.Middleware.AcceptOverride
import Network.Wai.Middleware.Autohead
import Network.Wai.Middleware.Cors
@@ -9,6 +9,7 @@ module Sweetroll.Micropub.Endpoint (
import Sweetroll.Prelude hiding (host)
import qualified Data.Text as T
import qualified Data.Set as S
import qualified Data.Char as C
import qualified Data.HashMap.Strict as HMS
import Data.Maybe (fromJust)
import Web.JWT hiding (header, decode)
@@ -96,9 +97,12 @@ respNoContent = ServantErr { errHTTPCode = 204
decideSlug ObjProperties UTCTime String
decideSlug props now = unpack . fromMaybe fallback $ getProp "mp-slug" <|> getProp "slug"
where fallback = slugify . fromMaybe (formatTimeSlug now) $ getProp "name"
where fallback = smartSlugify . fromMaybe (formatTimeSlug now) $ getProp "name"
formatTimeSlug = pack . formatTime defaultTimeLocale "%Y-%m-%d-%H-%M-%S"
getProp k = firstStr (Object props) (key k)
-- take WikiStyleTitles into slugs as-is (without lowercasing), for KnowledgeBase posts
smartSlugify s | C.isUpper (fromMaybe 'x' $ headMay s) && all C.isLetter s = s
smartSlugify s = slugify s
decideCategory ObjProperties Text
decideCategory props | not (null $ Object props ^.. key "rating" . values) = "_reviews"
@@ -7,7 +7,7 @@ maintainer: greg@unrelenting.technology
copyright: 2014-2017 Greg V <greg@unrelenting.technology>
license: PublicDomain
github: myfreeweb/sweetroll
tested-with: GHC==8.0.1
tested-with: GHC==8.2.1
dependencies:
- base >=4.8.0.0 && <5
- cryptonite
View
@@ -2,8 +2,7 @@ packages:
- '.'
- location: '../indieweb-algorithms'
extra-dep: true
- location: '../../magicbane'
extra-dep: true
extra-deps:
- rapid-0.1.3
- magicbane-0.1.2
resolver: nightly-2017-10-31

0 comments on commit 2f27a92

Please sign in to comment.