Move everything around for easier comprehension
parent
4142b65a86
commit
456b6b1df3
|
|
@ -10,7 +10,6 @@
|
|||
-- enter in repl:
|
||||
-- :set -XOverloadedStrings
|
||||
|
||||
import Basement.Block (create)
|
||||
import Control.Monad (forM, forM_, replicateM, unless, when)
|
||||
import Data.List (sort)
|
||||
import Data.Text (Text)
|
||||
|
|
@ -21,30 +20,76 @@ import Data.Time.Calendar (Day, addDays, diffDays, fromGregorian,
|
|||
import Data.Time.Clock (UTCTime (utctDay), getCurrentTime)
|
||||
import Dhall (FromDhall, Generic, auto, input)
|
||||
import NeatInterpolation (text)
|
||||
-- https://hackage.haskell.org/package/neat-interpolation-0.3.2.1/docs/NeatInterpolation.html
|
||||
import System.Directory (createDirectoryIfMissing, doesFileExist,
|
||||
listDirectory)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import System.Random (Random, randomRIO)
|
||||
-- https://hackage.haskell.org/package/neat-interpolation-0.3.2.1/docs/NeatInterpolation.html
|
||||
|
||||
|
||||
{-
|
||||
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
|
||||
Config, loaded from a dhall file
|
||||
-}
|
||||
randomNum :: System.Random.Random a => a -> a -> a
|
||||
randomNum from to =
|
||||
unsafePerformIO $
|
||||
randomRIO (from, to)
|
||||
data Config = Config
|
||||
{ adjectives1 :: [Text]
|
||||
, adjectives2 :: [Text]
|
||||
, looks :: [Text]
|
||||
, sealImagesPath :: FilePath
|
||||
, postsOutputPath :: FilePath
|
||||
, startDate :: Day
|
||||
} deriving (Generic, Show)
|
||||
instance FromDhall Config
|
||||
|
||||
|
||||
{-
|
||||
Given a list, returns a random element
|
||||
Main function
|
||||
-}
|
||||
randomPull :: [a] -> a
|
||||
randomPull lst = lst !! r'
|
||||
where r' = randomNum 0 l
|
||||
l = length lst - 1
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "Starting blog post generation script"
|
||||
|
||||
config <- input auto "./config.dhall"
|
||||
let postsOutputPath' = postsOutputPath config
|
||||
putStrLn "Validated config successfully"
|
||||
|
||||
createDirectoryIfMissing True postsOutputPath'
|
||||
unsafeGenerateAllBlogs config
|
||||
putStrLn $ "Generated blog posts successfully to " <> postsOutputPath'
|
||||
|
||||
|
||||
{-
|
||||
For all the blog posts
|
||||
Write them to file
|
||||
-}
|
||||
unsafeGenerateAllBlogs :: Config -> IO ()
|
||||
unsafeGenerateAllBlogs config =
|
||||
forM_ (allBlogPosts config) (writeToFile config)
|
||||
|
||||
allBlogPosts :: Config -> [(FilePath, Text)]
|
||||
allBlogPosts config = map f zippedDates
|
||||
where
|
||||
f = uncurry $ sealText config
|
||||
zippedDates = zip [1..] (allDatesSince (startDate config))
|
||||
|
||||
allDatesSince :: Day -> [Day]
|
||||
allDatesSince startDate = map (`addDays` startDate) [0..daysSinceStart]
|
||||
where
|
||||
daysSinceStart = diffDays today startDate
|
||||
{-# NOINLINE today #-}
|
||||
today = unsafePerformIO $ utctDay <$> getCurrentTime
|
||||
|
||||
writeToFile :: Config -> (FilePath, Text) -> IO()
|
||||
writeToFile config (fp, txt) = do
|
||||
fileExists <- doesFileExist fp'
|
||||
unless fileExists (write fp' txt)
|
||||
where
|
||||
write = TIO.writeFile
|
||||
fp' = postsOutputPath config <> "/" <> fp
|
||||
|
||||
|
||||
{-
|
||||
Blog post format
|
||||
-}
|
||||
blogPost
|
||||
:: Text
|
||||
-> Text
|
||||
|
|
@ -67,7 +112,9 @@ blogPost title see adj1 adj2 seal date =
|
|||
/>
|
||||
|]
|
||||
|
||||
-- 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 n date = ( fileName', bp)
|
||||
where
|
||||
|
|
@ -79,6 +126,7 @@ sealText config n date = ( fileName', bp)
|
|||
date' = T.pack . show $ date
|
||||
title = T.pack $ "Seal Post Number " <> show n
|
||||
title' = T.replace " " "-" title
|
||||
|
||||
bp = blogPost' (toGregorian date)
|
||||
|
||||
blogPost' :: (Integer, Int, Int) -> Text
|
||||
|
|
@ -109,65 +157,28 @@ sealText config n date = ( fileName', bp)
|
|||
(randomPull $ unsafeListDirContents $ sealImagesPath config)
|
||||
date
|
||||
|
||||
-- Generating all the previous blog posts
|
||||
-- Only need to do this once
|
||||
allDatesSince :: Day -> [Day]
|
||||
allDatesSince startDate = map (`addDays` startDate) [0..daysSinceStart]
|
||||
where
|
||||
daysSinceStart = diffDays today startDate
|
||||
{-# NOINLINE today #-}
|
||||
today = unsafePerformIO $ utctDay <$> getCurrentTime
|
||||
|
||||
allBlogPosts :: Config -> [(FilePath, Text)]
|
||||
allBlogPosts config = map f zippedDates
|
||||
where
|
||||
f = uncurry $ sealText config
|
||||
zippedDates = zip [1..] (allDatesSince (startDate config))
|
||||
|
||||
writeToFile :: Config -> (FilePath, Text) -> IO()
|
||||
writeToFile config (fp, txt) = do
|
||||
fileExists <- doesFileExist fp'
|
||||
unless fileExists (write fp' txt)
|
||||
where
|
||||
write = TIO.writeFile
|
||||
fp' = postsOutputPath config <> "/" <> fp
|
||||
|
||||
-- For all the blog posts
|
||||
-- Write them to file
|
||||
unsafeGenerateAllBlogs :: Config -> IO ()
|
||||
unsafeGenerateAllBlogs config =
|
||||
forM_ (allBlogPosts config) (writeToFile config)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "Starting blog post generation script"
|
||||
|
||||
config <- input auto "./config.dhall"
|
||||
let postsOutputPath' = postsOutputPath config
|
||||
putStrLn "Validated config successfully"
|
||||
|
||||
createDirectoryIfMissing True postsOutputPath'
|
||||
unsafeGenerateAllBlogs config
|
||||
putStrLn $ "Generated blog posts successfully to " <> postsOutputPath'
|
||||
|
||||
prettyPrint :: Show a => [a] -> IO ()
|
||||
prettyPrint = putStr . unlines . map show
|
||||
|
||||
{-
|
||||
Config
|
||||
-}
|
||||
data Config = Config
|
||||
{ adjectives1 :: [Text]
|
||||
, adjectives2 :: [Text]
|
||||
, looks :: [Text]
|
||||
, sealImagesPath :: FilePath
|
||||
, postsOutputPath :: FilePath
|
||||
, startDate :: Day
|
||||
} deriving (Generic, Show)
|
||||
instance FromDhall Config
|
||||
|
||||
{-
|
||||
Utils
|
||||
-}
|
||||
{-
|
||||
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)
|
||||
|
||||
{-
|
||||
Given a list, returns a random element
|
||||
-}
|
||||
randomPull :: [a] -> a
|
||||
randomPull lst = lst !! r'
|
||||
where r' = randomNum 0 l
|
||||
l = length lst - 1
|
||||
|
||||
unsafeListDirContents :: FilePath -> [Text]
|
||||
unsafeListDirContents = map T.pack . sort . unsafePerformIO . listDirectory
|
||||
|
||||
prettyPrint :: Show a => [a] -> IO ()
|
||||
prettyPrint = putStr . unlines . map show
|
||||
|
|
|
|||
Loading…
Reference in New Issue