Initial commit (moving refactored code out of seal-blog proper)
parent
10bce52555
commit
d9b6aed2b9
|
|
@ -0,0 +1,13 @@
|
||||||
|
# Haskell stuff
|
||||||
|
*.dyn_hi
|
||||||
|
*.dyn_o
|
||||||
|
*.hi
|
||||||
|
*.o
|
||||||
|
dist
|
||||||
|
generateSealPosts
|
||||||
|
|
||||||
|
# Direnv lorri stuff
|
||||||
|
.direnv
|
||||||
|
|
||||||
|
# Too many posts, hiding for now
|
||||||
|
posts
|
||||||
|
|
@ -0,0 +1,11 @@
|
||||||
|
{
|
||||||
|
"cSpell.words": [
|
||||||
|
"Birthdayingly",
|
||||||
|
"Dhall",
|
||||||
|
"NOINLINE",
|
||||||
|
"runghc",
|
||||||
|
"uncurry",
|
||||||
|
"unlines",
|
||||||
|
"utct"
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
@ -0,0 +1,101 @@
|
||||||
|
{ sealImagesPath = "./images"
|
||||||
|
, postsOutputPath = "./posts"
|
||||||
|
, startDate = 2022-01-01
|
||||||
|
, adjectives1 =
|
||||||
|
[ "absorbing"
|
||||||
|
, "adorable"
|
||||||
|
, "alluring"
|
||||||
|
, "ambrosial"
|
||||||
|
, "amiable"
|
||||||
|
, "appealing"
|
||||||
|
, "attractive"
|
||||||
|
, "beautiful"
|
||||||
|
, "bewitching"
|
||||||
|
, "captivating"
|
||||||
|
, "charismatic"
|
||||||
|
, "charming"
|
||||||
|
, "choice"
|
||||||
|
, "cute"
|
||||||
|
, "dainty"
|
||||||
|
, "darling"
|
||||||
|
, "dear"
|
||||||
|
, "delectable"
|
||||||
|
, "delicate"
|
||||||
|
, "delicious"
|
||||||
|
, "delightful"
|
||||||
|
, "desirable"
|
||||||
|
, "dishy"
|
||||||
|
, "dreamy"
|
||||||
|
, "electrifying"
|
||||||
|
, "elegant"
|
||||||
|
, "enamoring"
|
||||||
|
, "engaging"
|
||||||
|
, "engrossing"
|
||||||
|
, "enthralling"
|
||||||
|
, "entrancing"
|
||||||
|
, "eye-catching"
|
||||||
|
, "fascinating"
|
||||||
|
, "fetching"
|
||||||
|
, "glamorous"
|
||||||
|
, "graceful"
|
||||||
|
, "heavenly"
|
||||||
|
, "infatuating"
|
||||||
|
, "inviting"
|
||||||
|
, "irresistible"
|
||||||
|
, "likable"
|
||||||
|
, "lovable"
|
||||||
|
, "lovely"
|
||||||
|
, "magnetizing"
|
||||||
|
, "nice"
|
||||||
|
, "pleasant"
|
||||||
|
, "precious"
|
||||||
|
, "pretty"
|
||||||
|
, "provocative"
|
||||||
|
, "rapturous"
|
||||||
|
, "ravishing"
|
||||||
|
, "seducing"
|
||||||
|
, "seductive"
|
||||||
|
, "suave"
|
||||||
|
, "sweet"
|
||||||
|
, "tantalizing"
|
||||||
|
, "tempting"
|
||||||
|
, "titillating"
|
||||||
|
, "winning"
|
||||||
|
, "winsome"
|
||||||
|
]
|
||||||
|
, adjectives2 =
|
||||||
|
[ "ample"
|
||||||
|
, "bearish"
|
||||||
|
, "big"
|
||||||
|
, "butterball"
|
||||||
|
, "buxom"
|
||||||
|
, "chunky"
|
||||||
|
, "fatty"
|
||||||
|
, "flabby"
|
||||||
|
, "fleshy"
|
||||||
|
, "full-figured"
|
||||||
|
, "hefty"
|
||||||
|
, "husky"
|
||||||
|
, "pleasingly plump"
|
||||||
|
, "plump"
|
||||||
|
, "plumpish"
|
||||||
|
, "podgy"
|
||||||
|
, "portly"
|
||||||
|
, "pudgy"
|
||||||
|
, "roly-poly"
|
||||||
|
, "rotund"
|
||||||
|
, "round"
|
||||||
|
, "stout"
|
||||||
|
, "tubby"
|
||||||
|
, "zaftig"
|
||||||
|
]
|
||||||
|
, looks =
|
||||||
|
[ "Look at"
|
||||||
|
, "Gaze upon"
|
||||||
|
, "Check out"
|
||||||
|
, "Witness!"
|
||||||
|
, "Look upon and tremble at"
|
||||||
|
, "Lookie here at"
|
||||||
|
, "Whoa! See"
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
@ -0,0 +1,61 @@
|
||||||
|
{
|
||||||
|
"nodes": {
|
||||||
|
"nixpkgs": {
|
||||||
|
"locked": {
|
||||||
|
"lastModified": 1681482634,
|
||||||
|
"narHash": "sha256-cT/nr3L8khEYZSGp8qqwxFH+/q4/547MfyOdSj6MhBk=",
|
||||||
|
"owner": "NixOS",
|
||||||
|
"repo": "nixpkgs",
|
||||||
|
"rev": "fda0d99c2cbbb5c89d8855d258cb0821bd9113ad",
|
||||||
|
"type": "github"
|
||||||
|
},
|
||||||
|
"original": {
|
||||||
|
"owner": "NixOS",
|
||||||
|
"ref": "nixos-22.11",
|
||||||
|
"repo": "nixpkgs",
|
||||||
|
"type": "github"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"root": {
|
||||||
|
"inputs": {
|
||||||
|
"nixpkgs": "nixpkgs",
|
||||||
|
"utils": "utils"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"systems": {
|
||||||
|
"locked": {
|
||||||
|
"lastModified": 1681028828,
|
||||||
|
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
|
||||||
|
"owner": "nix-systems",
|
||||||
|
"repo": "default",
|
||||||
|
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
|
||||||
|
"type": "github"
|
||||||
|
},
|
||||||
|
"original": {
|
||||||
|
"owner": "nix-systems",
|
||||||
|
"repo": "default",
|
||||||
|
"type": "github"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"utils": {
|
||||||
|
"inputs": {
|
||||||
|
"systems": "systems"
|
||||||
|
},
|
||||||
|
"locked": {
|
||||||
|
"lastModified": 1681202837,
|
||||||
|
"narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=",
|
||||||
|
"owner": "numtide",
|
||||||
|
"repo": "flake-utils",
|
||||||
|
"rev": "cfacdce06f30d2b68473a46042957675eebb3401",
|
||||||
|
"type": "github"
|
||||||
|
},
|
||||||
|
"original": {
|
||||||
|
"owner": "numtide",
|
||||||
|
"repo": "flake-utils",
|
||||||
|
"type": "github"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"root": "root",
|
||||||
|
"version": 7
|
||||||
|
}
|
||||||
|
|
@ -0,0 +1,30 @@
|
||||||
|
{
|
||||||
|
description = "A Nix flake for a blog-post generating script, written in Haskell, with a seal bent.";
|
||||||
|
|
||||||
|
inputs = {
|
||||||
|
nixpkgs.url = "github:NixOS/nixpkgs/nixos-22.11";
|
||||||
|
utils.url = "github:numtide/flake-utils";
|
||||||
|
};
|
||||||
|
|
||||||
|
outputs = { self, nixpkgs, utils }:
|
||||||
|
utils.lib.eachDefaultSystem (system:
|
||||||
|
let
|
||||||
|
pkgs = nixpkgs.legacyPackages.${system};
|
||||||
|
|
||||||
|
ghc' = pkgs.haskellPackages.ghcWithHoogle (self: with self; [
|
||||||
|
dhall
|
||||||
|
neat-interpolation
|
||||||
|
random
|
||||||
|
]);
|
||||||
|
in
|
||||||
|
{
|
||||||
|
devShells.default = pkgs.mkShell {
|
||||||
|
buildInputs = with pkgs.haskellPackages;
|
||||||
|
[
|
||||||
|
ghc'
|
||||||
|
hlint
|
||||||
|
haskell-language-server
|
||||||
|
];
|
||||||
|
};
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
@ -0,0 +1,174 @@
|
||||||
|
#! /usr/bin/env nix-shell
|
||||||
|
#! nix-shell -p "haskellPackages.ghcWithPackages (ps: with ps; [dhall neat-interpolation random])"
|
||||||
|
#! nix-shell -i runghc
|
||||||
|
{-
|
||||||
|
Must be run in folder containing the source code
|
||||||
|
-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
-- 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)
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.IO as TIO
|
||||||
|
import Data.Time.Calendar (Day, addDays, diffDays, fromGregorian,
|
||||||
|
toGregorian)
|
||||||
|
import Data.Time.Clock (UTCTime (utctDay), getCurrentTime)
|
||||||
|
import Dhall (FromDhall, Generic, auto, input)
|
||||||
|
import NeatInterpolation (text)
|
||||||
|
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
|
||||||
|
-}
|
||||||
|
randomNum :: System.Random.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
|
||||||
|
|
||||||
|
blogPost
|
||||||
|
:: Text
|
||||||
|
-> Text
|
||||||
|
-> Text
|
||||||
|
-> Text
|
||||||
|
-> Text
|
||||||
|
-> Day
|
||||||
|
-> Text
|
||||||
|
blogPost title see adj1 adj2 seal date =
|
||||||
|
[text|
|
||||||
|
---
|
||||||
|
title: $title
|
||||||
|
---
|
||||||
|
|
||||||
|
$see this $adj1, $adj2 seal!
|
||||||
|
<img
|
||||||
|
src="/images/$seal"
|
||||||
|
alt="A picture of a $adj1, $adj2 seal! <3"
|
||||||
|
width="400"
|
||||||
|
/>
|
||||||
|
|]
|
||||||
|
|
||||||
|
-- Returns a filePath, and a corresponding random blog post
|
||||||
|
sealText :: Config -> Integer -> Day -> (FilePath, Text)
|
||||||
|
sealText config n date = ( fileName', bp)
|
||||||
|
where
|
||||||
|
fileName' =
|
||||||
|
show date <> "-"
|
||||||
|
<> "seal-post-"
|
||||||
|
<> show n
|
||||||
|
<> ".markdown"
|
||||||
|
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
|
||||||
|
blogPost' (_, 09, 26) =
|
||||||
|
blogPost
|
||||||
|
title
|
||||||
|
"Birthdayingly gaze at"
|
||||||
|
"spoiled"
|
||||||
|
"older"
|
||||||
|
"birthdaySeal.jpg"
|
||||||
|
date
|
||||||
|
|
||||||
|
blogPost' (_, 04, 01) =
|
||||||
|
blogPost
|
||||||
|
title
|
||||||
|
"Foolishly look at"
|
||||||
|
"beautiful"
|
||||||
|
"supermodel, singing"
|
||||||
|
"singerSeal.jpg"
|
||||||
|
date
|
||||||
|
|
||||||
|
blogPost' (_, _, _) =
|
||||||
|
blogPost
|
||||||
|
title
|
||||||
|
(randomPull $ looks config)
|
||||||
|
(randomPull $ adjectives1 config)
|
||||||
|
(randomPull $ adjectives2 config)
|
||||||
|
(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)
|
||||||
|
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
|
||||||
|
-}
|
||||||
|
unsafeListDirContents :: FilePath -> [Text]
|
||||||
|
unsafeListDirContents = map T.pack . sort . unsafePerformIO . listDirectory
|
||||||
Loading…
Reference in New Issue