Change up how randomness works
Introduce a seed fed into `randoms (mkStdGen (seed config)` Some light formattingmain
parent
615f2ff446
commit
f25dd9c993
|
@ -4,6 +4,7 @@
|
||||||
"Dhall",
|
"Dhall",
|
||||||
"NOINLINE",
|
"NOINLINE",
|
||||||
"runghc",
|
"runghc",
|
||||||
|
"txts",
|
||||||
"uncurry",
|
"uncurry",
|
||||||
"unlines",
|
"unlines",
|
||||||
"utct"
|
"utct"
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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,34 +134,48 @@ 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 . drop 2 . sort . unsafePerformIO . listDirectory
|
unsafeListDirContents = map T.pack . drop 2 . sort . unsafePerformIO . listDirectory
|
||||||
-- ^^^^^^
|
-- ^^^^^^
|
||||||
|
|
Loading…
Reference in New Issue