1
0
Fork 0

Compare commits

...

2 Commits

Author SHA1 Message Date
Bill Ewanick f25dd9c993 Change up how randomness works
Introduce a seed fed into `randoms (mkStdGen (seed config)`
Some light formatting
2023-08-08 17:26:50 -04:00
Bill Ewanick 615f2ff446 Rename Seal for drop 2 to work
Don't want to use birthday/april fools photos randomly
2023-08-08 17:18:22 -04:00
4 changed files with 55 additions and 59 deletions

View File

@ -4,6 +4,7 @@
"Dhall", "Dhall",
"NOINLINE", "NOINLINE",
"runghc", "runghc",
"txts",
"uncurry", "uncurry",
"unlines", "unlines",
"utct" "utct"

View File

@ -1,6 +1,7 @@
{ sealImagesPath = "./images" { sealImagesPath = "images"
, postsOutputPath = "./posts" , postsOutputPath = "posts"
, startDate = 2022-01-01 , startDate = 2022-01-01
, seed = +137
, adjectives1 = , adjectives1 =
[ "absorbing" [ "absorbing"
, "adorable" , "adorable"

View File

@ -13,8 +13,7 @@ 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, fromGregorian, import Data.Time.Calendar (Day, addDays, diffDays, toGregorian)
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)
@ -22,7 +21,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, randomRIO) import System.Random (Random (randoms), mkStdGen)
{- {-
@ -35,6 +34,7 @@ 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,8 +68,13 @@ 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 = uncurry $ sealText config createSealText = uncurry3 $ sealText config
zippedDates = zip [1..] (allDatesSince (startDate config)) zippedDates = zip3 [1..] randomNumbers (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]
@ -87,39 +92,11 @@ 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 -> Day -> (FilePath, Text) sealText :: Config -> Integer -> Int -> Day -> (FilePath, Text)
sealText config n date = ( fileName', bp ) sealText config n rand date = ( fileName', bp )
where where
fileName' = fileName' =
show date <> "-" show date <> "-"
@ -157,36 +134,53 @@ sealText config n date = ( fileName', bp )
blogPost' (_, _, _) = blogPost' (_, _, _) =
blogPost blogPost
title title
(randomPull $ looks config) (randomPull rand (looks config))
(randomPull $ adjectives1 config) (randomPull rand (adjectives1 config))
(randomPull $ adjectives2 config) (randomPull rand (adjectives2 config))
(randomPull $ unsafeListDirContents sealImagesPath') (randomPull rand (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 . sort . unsafePerformIO . listDirectory unsafeListDirContents = map T.pack . drop 2 . 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

View File

Before

Width:  |  Height:  |  Size: 13 KiB

After

Width:  |  Height:  |  Size: 13 KiB