diff --git a/generateSealPosts.hs b/generateSealPosts.hs index 4755eec..ed7e989 100755 --- a/generateSealPosts.hs +++ b/generateSealPosts.hs @@ -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