-
Notifications
You must be signed in to change notification settings - Fork 25
/
NewPost.hs
executable file
·61 lines (47 loc) · 1.91 KB
/
NewPost.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
#! usr/bin/env runhaskell
module Main where
import Data.Char (toLower)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Time.Calendar (Day)
import Data.Time.Clock (getCurrentTime, utctDay)
import System.Environment (getArgs)
import System.IO (IOMode (..), hPutStrLn, withFile)
-- | This is a very basic program that accepts a single argument (post title)
-- and creates a new post file with the appropriate name and header
-- information.
main :: IO ()
main = do
[rawTitle] <- getArgs
date <- today
let fileName = newPostFileName date rawTitle
withFile fileName WriteMode $ \handle ->
hPutStrLn handle $ header date rawTitle
-- | today returns the current day.
-- `show day` has format YYYY-MM-DD which is perfect for a Jekyll blog post!
today :: IO Day
today = utctDay <$> getCurrentTime
-- | newPostFileName takes the Day and a title for the post and returns a
-- string suitable for a filename.
newPostFileName :: Day -> String -> String
newPostFileName time title = concat ["_posts/", show time, "-", slugify title, ".markdown"]
-- | Slugify downcases a string and replaces space characters with underscores.
slugify :: String -> String
slugify = escape escapeChars . fmap toLower
where
escapeChars = [(' ', "_"), ('!', ""), (':', "")]
-- | header takes a Day and a Title and returns a header for the post.
header :: Day -> String -> String
header day title =
unlines
[ "---"
, "title: \"" <> title <> "\""
, "date: " <> show day
, "layout: post"
, "categories: programming"
, "---"
]
-- | `escape` takes a list of pairs of chars and strings, and replaces the
-- instances of the chars with their accompanying strings.
escape :: [(Char, String)] -> String -> String
escape crs = foldMap (fromMaybe <$> pure <*> (`lookup` crs))