Move everything around for easier comprehension
							parent
							
								
									4142b65a86
								
							
						
					
					
						commit
						456b6b1df3
					
				| 
						 | 
					@ -10,7 +10,6 @@
 | 
				
			||||||
-- enter in repl:
 | 
					-- enter in repl:
 | 
				
			||||||
--   :set -XOverloadedStrings
 | 
					--   :set -XOverloadedStrings
 | 
				
			||||||
 | 
					
 | 
				
			||||||
import           Basement.Block     (create)
 | 
					 | 
				
			||||||
import           Control.Monad      (forM, forM_, replicateM, unless, when)
 | 
					import           Control.Monad      (forM, forM_, replicateM, unless, when)
 | 
				
			||||||
import           Data.List          (sort)
 | 
					import           Data.List          (sort)
 | 
				
			||||||
import           Data.Text          (Text)
 | 
					import           Data.Text          (Text)
 | 
				
			||||||
| 
						 | 
					@ -21,30 +20,76 @@ import           Data.Time.Calendar (Day, addDays, diffDays, fromGregorian,
 | 
				
			||||||
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)
 | 
				
			||||||
 | 
					-- https://hackage.haskell.org/package/neat-interpolation-0.3.2.1/docs/NeatInterpolation.html
 | 
				
			||||||
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, randomRIO)
 | 
				
			||||||
-- https://hackage.haskell.org/package/neat-interpolation-0.3.2.1/docs/NeatInterpolation.html
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{-
 | 
					{-
 | 
				
			||||||
  Gives a random number between from and to
 | 
					  Config, loaded from a dhall file
 | 
				
			||||||
  Uses unsafeIO to get the number out of IO
 | 
					 | 
				
			||||||
  It's safe because we're only shuffling
 | 
					 | 
				
			||||||
-}
 | 
					-}
 | 
				
			||||||
randomNum :: System.Random.Random a => a -> a -> a
 | 
					data Config = Config
 | 
				
			||||||
randomNum from to =
 | 
					  { adjectives1     :: [Text]
 | 
				
			||||||
  unsafePerformIO $
 | 
					  , adjectives2     :: [Text]
 | 
				
			||||||
  randomRIO (from, to)
 | 
					  , 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
 | 
					main :: IO ()
 | 
				
			||||||
randomPull lst = lst !! r'
 | 
					main = do
 | 
				
			||||||
  where r' = randomNum 0 l
 | 
					  putStrLn "Starting blog post generation script"
 | 
				
			||||||
        l  = length lst - 1
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  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
 | 
					blogPost
 | 
				
			||||||
  :: Text
 | 
					  :: Text
 | 
				
			||||||
  -> 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 -> Integer -> Day -> (FilePath, Text)
 | 
				
			||||||
sealText config n date = ( fileName', bp)
 | 
					sealText config n date = ( fileName', bp)
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
| 
						 | 
					@ -79,6 +126,7 @@ sealText config n date = ( fileName', bp)
 | 
				
			||||||
    date'     = T.pack . show $ date
 | 
					    date'     = T.pack . show $ date
 | 
				
			||||||
    title     = T.pack $ "Seal Post Number " <> show n
 | 
					    title     = T.pack $ "Seal Post Number " <> show n
 | 
				
			||||||
    title'    = T.replace " " "-" title
 | 
					    title'    = T.replace " " "-" title
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    bp = blogPost' (toGregorian date)
 | 
					    bp = blogPost' (toGregorian date)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    blogPost' :: (Integer, Int, Int) -> Text
 | 
					    blogPost' :: (Integer, Int, Int) -> Text
 | 
				
			||||||
| 
						 | 
					@ -109,65 +157,28 @@ sealText config n date = ( fileName', bp)
 | 
				
			||||||
        (randomPull $ unsafeListDirContents $ sealImagesPath config)
 | 
					        (randomPull $ unsafeListDirContents $ sealImagesPath config)
 | 
				
			||||||
        date
 | 
					        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
 | 
					  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 :: FilePath -> [Text]
 | 
				
			||||||
unsafeListDirContents = map T.pack . sort . unsafePerformIO . listDirectory
 | 
					unsafeListDirContents = map T.pack . sort . unsafePerformIO . listDirectory
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					prettyPrint :: Show a => [a] -> IO ()
 | 
				
			||||||
 | 
					prettyPrint = putStr . unlines . map show
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue