Compare commits
No commits in common. "f25dd9c99382fd4e945e4d0d034254fc552d9aca" and "72cf946eb7ad1fb8151df3af3eb2c5a94a14af54" have entirely different histories.
f25dd9c993
...
72cf946eb7
|
@ -4,7 +4,6 @@
|
||||||
"Dhall",
|
"Dhall",
|
||||||
"NOINLINE",
|
"NOINLINE",
|
||||||
"runghc",
|
"runghc",
|
||||||
"txts",
|
|
||||||
"uncurry",
|
"uncurry",
|
||||||
"unlines",
|
"unlines",
|
||||||
"utct"
|
"utct"
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
{ sealImagesPath = "images"
|
{ sealImagesPath = "./images"
|
||||||
, postsOutputPath = "posts"
|
, postsOutputPath = "./posts"
|
||||||
, startDate = 2022-01-01
|
, startDate = 2022-01-01
|
||||||
, seed = +137
|
|
||||||
, adjectives1 =
|
, adjectives1 =
|
||||||
[ "absorbing"
|
[ "absorbing"
|
||||||
, "adorable"
|
, "adorable"
|
||||||
|
|
|
@ -13,7 +13,8 @@ import Data.List (sort)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as TIO
|
import qualified Data.Text.IO as TIO
|
||||||
import Data.Time.Calendar (Day, addDays, diffDays, toGregorian)
|
import Data.Time.Calendar (Day, addDays, diffDays, fromGregorian,
|
||||||
|
toGregorian)
|
||||||
import Data.Time.Clock (UTCTime (utctDay), getCurrentTime)
|
import Data.Time.Clock (UTCTime (utctDay), getCurrentTime)
|
||||||
import Dhall (FromDhall, Generic, auto, input)
|
import Dhall (FromDhall, Generic, auto, input)
|
||||||
import NeatInterpolation (text)
|
import NeatInterpolation (text)
|
||||||
|
@ -21,7 +22,7 @@ import NeatInterpolation (text)
|
||||||
import System.Directory (createDirectoryIfMissing, doesFileExist,
|
import System.Directory (createDirectoryIfMissing, doesFileExist,
|
||||||
listDirectory)
|
listDirectory)
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
import System.Random (Random (randoms), mkStdGen)
|
import System.Random (Random, randomRIO)
|
||||||
|
|
||||||
|
|
||||||
{-
|
{-
|
||||||
|
@ -34,7 +35,6 @@ data Config = Config
|
||||||
, sealImagesPath :: FilePath
|
, sealImagesPath :: FilePath
|
||||||
, postsOutputPath :: FilePath
|
, postsOutputPath :: FilePath
|
||||||
, startDate :: Day
|
, startDate :: Day
|
||||||
, seed :: Int
|
|
||||||
} deriving (Generic, Show)
|
} deriving (Generic, Show)
|
||||||
instance FromDhall Config
|
instance FromDhall Config
|
||||||
|
|
||||||
|
@ -68,13 +68,8 @@ generateAllBlogPosts config = forM_ allBlogPosts' writeToFile'
|
||||||
allBlogPosts :: Config -> [(FilePath, Text)]
|
allBlogPosts :: Config -> [(FilePath, Text)]
|
||||||
allBlogPosts config = map createSealText zippedDates
|
allBlogPosts config = map createSealText zippedDates
|
||||||
where
|
where
|
||||||
createSealText = uncurry3 $ sealText config
|
createSealText = uncurry $ sealText config
|
||||||
zippedDates = zip3 [1..] randomNumbers (allDatesSince (startDate config))
|
zippedDates = zip [1..] (allDatesSince (startDate config))
|
||||||
randomNumbers = randoms (mkStdGen (seed config))
|
|
||||||
|
|
||||||
-- | Converts a curried function to a function on a triple.
|
|
||||||
uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)
|
|
||||||
uncurry3 f (a,b,c) = f a b c
|
|
||||||
|
|
||||||
allDatesSince :: Day -> [Day]
|
allDatesSince :: Day -> [Day]
|
||||||
allDatesSince startDate = map (`addDays` startDate) [0..daysSinceStart]
|
allDatesSince startDate = map (`addDays` startDate) [0..daysSinceStart]
|
||||||
|
@ -92,11 +87,39 @@ writeToFile config (fp, txt) = do
|
||||||
fp' = postsOutputPath config <> "/" <> fp
|
fp' = postsOutputPath config <> "/" <> fp
|
||||||
|
|
||||||
|
|
||||||
|
{-
|
||||||
|
Blog post format
|
||||||
|
-}
|
||||||
|
blogPost
|
||||||
|
:: Text
|
||||||
|
-> Text
|
||||||
|
-> Text
|
||||||
|
-> Text
|
||||||
|
-> Text
|
||||||
|
-> Day
|
||||||
|
-> FilePath
|
||||||
|
-> Text
|
||||||
|
blogPost title see adj1 adj2 seal date imagesPath =
|
||||||
|
let imagesPath' = T.pack imagesPath
|
||||||
|
in
|
||||||
|
[text|
|
||||||
|
---
|
||||||
|
title: $title
|
||||||
|
---
|
||||||
|
|
||||||
|
$see this $adj1, $adj2 seal!
|
||||||
|
<img
|
||||||
|
src="/$imagesPath'/$seal"
|
||||||
|
alt="A picture of a $adj1, $adj2 seal! <3"
|
||||||
|
width="400"
|
||||||
|
/>
|
||||||
|
|]
|
||||||
|
|
||||||
{-
|
{-
|
||||||
Returns a filePath, and a corresponding random blog post
|
Returns a filePath, and a corresponding random blog post
|
||||||
-}
|
-}
|
||||||
sealText :: Config -> Integer -> Int -> Day -> (FilePath, Text)
|
sealText :: Config -> Integer -> Day -> (FilePath, Text)
|
||||||
sealText config n rand date = ( fileName', bp )
|
sealText config n date = ( fileName', bp )
|
||||||
where
|
where
|
||||||
fileName' =
|
fileName' =
|
||||||
show date <> "-"
|
show date <> "-"
|
||||||
|
@ -134,53 +157,36 @@ sealText config n rand date = ( fileName', bp )
|
||||||
blogPost' (_, _, _) =
|
blogPost' (_, _, _) =
|
||||||
blogPost
|
blogPost
|
||||||
title
|
title
|
||||||
(randomPull rand (looks config))
|
(randomPull $ looks config)
|
||||||
(randomPull rand (adjectives1 config))
|
(randomPull $ adjectives1 config)
|
||||||
(randomPull rand (adjectives2 config))
|
(randomPull $ adjectives2 config)
|
||||||
(randomPull rand (unsafeListDirContents sealImagesPath'))
|
(randomPull $ unsafeListDirContents sealImagesPath')
|
||||||
date
|
date
|
||||||
sealImagesPath'
|
sealImagesPath'
|
||||||
where
|
|
||||||
randomPull r txts = txts !! (rand `mod` l)
|
|
||||||
where l = length txts - 1
|
|
||||||
|
|
||||||
{-
|
|
||||||
Blog post format
|
|
||||||
-}
|
|
||||||
blogPost
|
|
||||||
:: Text
|
|
||||||
-> Text
|
|
||||||
-> Text
|
|
||||||
-> Text
|
|
||||||
-> Text
|
|
||||||
-> Day
|
|
||||||
-> FilePath
|
|
||||||
-> Text
|
|
||||||
blogPost title see adj1 adj2 seal date imagesPath =
|
|
||||||
let imagesPath' = T.pack imagesPath
|
|
||||||
in
|
|
||||||
[text|
|
|
||||||
---
|
|
||||||
title: $title
|
|
||||||
---
|
|
||||||
|
|
||||||
$see this $adj1, $adj2 seal!
|
|
||||||
<img
|
|
||||||
src="/$imagesPath'/$seal"
|
|
||||||
alt="A picture of a $adj1, $adj2 seal! <3"
|
|
||||||
width="400"
|
|
||||||
/>
|
|
||||||
|]
|
|
||||||
|
|
||||||
|
|
||||||
{-
|
{-
|
||||||
Utils
|
Utils
|
||||||
-}
|
-}
|
||||||
|
{-
|
||||||
|
Given a list, returns a random element
|
||||||
|
-}
|
||||||
|
randomPull :: [a] -> a
|
||||||
|
randomPull lst = lst !! r'
|
||||||
|
where
|
||||||
|
r' = randomNum 0 l
|
||||||
|
l = length lst - 1
|
||||||
|
|
||||||
|
{-
|
||||||
|
Gives a random number between from and to
|
||||||
|
Uses unsafeIO to get the number out of IO
|
||||||
|
It's safe because we're only shuffling
|
||||||
|
-}
|
||||||
|
randomNum :: Random a => a -> a -> a
|
||||||
|
randomNum from to = unsafePerformIO $ randomRIO (from, to)
|
||||||
|
|
||||||
unsafeListDirContents :: FilePath -> [Text]
|
unsafeListDirContents :: FilePath -> [Text]
|
||||||
unsafeListDirContents = map T.pack . drop 2 . sort . unsafePerformIO . listDirectory
|
unsafeListDirContents = map T.pack . sort . unsafePerformIO . listDirectory
|
||||||
-- ^^^^^^
|
|
||||||
-- drop 2 used to remove the birthday and singer photos
|
|
||||||
-- TODO: find a better way to hardcode this
|
|
||||||
|
|
||||||
prettyPrint :: Show a => [a] -> IO ()
|
prettyPrint :: Show a => [a] -> IO ()
|
||||||
prettyPrint = putStr . unlines . map show
|
prettyPrint = putStr . unlines . map show
|
||||||
|
|
Before Width: | Height: | Size: 13 KiB After Width: | Height: | Size: 13 KiB |
Loading…
Reference in New Issue