Compare commits
10 commits
36394395c0
...
296a5b56e0
| Author | SHA1 | Date | |
|---|---|---|---|
| 296a5b56e0 | |||
| 92bd2d5dee | |||
| 032daf33e4 | |||
| f4abf812ad | |||
| f25dd9c993 | |||
| 615f2ff446 | |||
| 72cf946eb7 | |||
| 46b00b50e9 | |||
| 73235cf0ab | |||
| 4d710afae3 |
8 changed files with 89 additions and 86 deletions
3
.gitignore
vendored
3
.gitignore
vendored
|
|
@ -6,8 +6,9 @@
|
|||
dist
|
||||
generateSealPosts
|
||||
|
||||
# Direnv lorri stuff
|
||||
# Nix related
|
||||
.direnv
|
||||
result
|
||||
|
||||
# Too many posts, hiding for now
|
||||
posts
|
||||
1
.vscode/settings.json
vendored
1
.vscode/settings.json
vendored
|
|
@ -4,6 +4,7 @@
|
|||
"Dhall",
|
||||
"NOINLINE",
|
||||
"runghc",
|
||||
"txts",
|
||||
"uncurry",
|
||||
"unlines",
|
||||
"utct"
|
||||
|
|
|
|||
18
README.md
18
README.md
|
|
@ -8,17 +8,13 @@ It's an in-joke.
|
|||
|
||||
## What's all this code?
|
||||
|
||||
- generate/
|
||||
- generateSealPosts.hs
|
||||
- A Haskell script that checks the website/posts folder and creates a blog post for every day from 1998 until the current date. There you will find the adjective lists if you think of more words to describe seals.
|
||||
- dist/
|
||||
- Place for the Haskell build artifacts to go.
|
||||
- [config.dhall](./config.dhall)
|
||||
- Typed non-deterministic config file for modifying the generator.
|
||||
- [flake.nix](./flake.nix)
|
||||
- Entry point for all the nix ways of running and building the code.
|
||||
- [generateSealPosts.hs](./generateSealPosts.hs)
|
||||
- A Haskell script that creates a blog post for every day from the configured date until the current day.
|
||||
|
||||
## These seals need more adjectives
|
||||
|
||||
In [config.dhall](https://git.ewanick.com/bill/sealPostGenerator/src/branch/main/config.dhall) you'll find two lists of adjectives. For the repo and add your own! Editing dhall config files does not require recompilation of the Haskell executable!
|
||||
|
||||
## Recent work
|
||||
|
||||
- Should running the generate function replace existing posts, or not? Probably not.
|
||||
- But need to split out the archive build vs the incremental post creation.
|
||||
In [config.dhall](./config.dhall) you'll find two lists of adjectives. For the repo and add your own! Editing dhall config files does not require recompilation of the Haskell executable!
|
||||
|
|
|
|||
|
|
@ -1,6 +1,8 @@
|
|||
{ sealImagesPath = "./images"
|
||||
, postsOutputPath = "./posts"
|
||||
, startDate = 2022-01-01
|
||||
{ sealImagesPath = "images"
|
||||
, postsOutputPath = "posts"
|
||||
, startDate = 1959-01-15
|
||||
, seed = +2016
|
||||
, fileExtension = "md"
|
||||
, adjectives1 =
|
||||
[ "absorbing"
|
||||
, "adorable"
|
||||
|
|
|
|||
14
flake.lock
generated
14
flake.lock
generated
|
|
@ -2,16 +2,16 @@
|
|||
"nodes": {
|
||||
"nixpkgs": {
|
||||
"locked": {
|
||||
"lastModified": 1681482634,
|
||||
"narHash": "sha256-cT/nr3L8khEYZSGp8qqwxFH+/q4/547MfyOdSj6MhBk=",
|
||||
"lastModified": 1690927903,
|
||||
"narHash": "sha256-D5gCaCROnjEKDOel//8TO/pOP87pAEtT0uT8X+0Bj/U=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "fda0d99c2cbbb5c89d8855d258cb0821bd9113ad",
|
||||
"rev": "bd836ac5e5a7358dea73cb74a013ca32864ccb86",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "NixOS",
|
||||
"ref": "nixos-22.11",
|
||||
"ref": "nixos-23.05",
|
||||
"repo": "nixpkgs",
|
||||
"type": "github"
|
||||
}
|
||||
|
|
@ -42,11 +42,11 @@
|
|||
"systems": "systems"
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1681202837,
|
||||
"narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=",
|
||||
"lastModified": 1689068808,
|
||||
"narHash": "sha256-6ixXo3wt24N/melDWjq70UuHQLxGV8jZvooRanIHXw0=",
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"rev": "cfacdce06f30d2b68473a46042957675eebb3401",
|
||||
"rev": "919d646de7be200f3bf08cb76ae1f09402b6f9b4",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
|
|
|||
17
flake.nix
17
flake.nix
|
|
@ -2,7 +2,7 @@
|
|||
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";
|
||||
nixpkgs.url = "github:NixOS/nixpkgs/nixos-23.05";
|
||||
utils.url = "github:numtide/flake-utils";
|
||||
};
|
||||
|
||||
|
|
@ -18,18 +18,25 @@
|
|||
]);
|
||||
in
|
||||
{
|
||||
packages.default = pkgs.runCommand "generateSealPosts" { } ''
|
||||
echo Generating seal posts
|
||||
mkdir -p $out/bin
|
||||
${ghc'}/bin/ghc \
|
||||
-O2 \
|
||||
-static \
|
||||
-o $out/bin/generateSealPosts \
|
||||
${./generateSealPosts.hs}
|
||||
'';
|
||||
|
||||
devShells.default = pkgs.mkShell {
|
||||
name = "seal-generator-shell";
|
||||
|
||||
buildInputs = with pkgs.haskellPackages;
|
||||
[
|
||||
ghc'
|
||||
hlint
|
||||
haskell-language-server
|
||||
|
||||
(pkgs.writeShellScriptBin "build-seal-generator" ''
|
||||
${ghc'}/bin/ghc -outputdir dist -O2 -static generateSealPosts.hs
|
||||
'')
|
||||
dhall-lsp-server
|
||||
];
|
||||
};
|
||||
});
|
||||
|
|
|
|||
|
|
@ -13,8 +13,7 @@ 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.Calendar (Day, addDays, diffDays, toGregorian)
|
||||
import Data.Time.Clock (UTCTime (utctDay), getCurrentTime)
|
||||
import Dhall (FromDhall, Generic, auto, input)
|
||||
import NeatInterpolation (text)
|
||||
|
|
@ -22,7 +21,7 @@ import NeatInterpolation (text)
|
|||
import System.Directory (createDirectoryIfMissing, doesFileExist,
|
||||
listDirectory)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import System.Random (Random, randomRIO)
|
||||
import System.Random (Random (randoms), mkStdGen)
|
||||
|
||||
|
||||
{-
|
||||
|
|
@ -31,10 +30,12 @@ import System.Random (Random, randomRIO)
|
|||
data Config = Config
|
||||
{ adjectives1 :: [Text]
|
||||
, adjectives2 :: [Text]
|
||||
, fileExtension :: String
|
||||
, looks :: [Text]
|
||||
, sealImagesPath :: FilePath
|
||||
, postsOutputPath :: FilePath
|
||||
, startDate :: Day
|
||||
, seed :: Int
|
||||
} deriving (Generic, Show)
|
||||
instance FromDhall Config
|
||||
|
||||
|
|
@ -68,8 +69,13 @@ generateAllBlogPosts config = forM_ allBlogPosts' writeToFile'
|
|||
allBlogPosts :: Config -> [(FilePath, Text)]
|
||||
allBlogPosts config = map createSealText zippedDates
|
||||
where
|
||||
createSealText = uncurry $ sealText config
|
||||
zippedDates = zip [1..] (allDatesSince (startDate config))
|
||||
createSealText = uncurry3 $ sealText 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 startDate = map (`addDays` startDate) [0..daysSinceStart]
|
||||
|
|
@ -87,6 +93,59 @@ writeToFile config (fp, txt) = do
|
|||
fp' = postsOutputPath config <> "/" <> fp
|
||||
|
||||
|
||||
{-
|
||||
Returns a filePath, and a corresponding random blog post
|
||||
-}
|
||||
sealText :: Config -> Integer -> Int -> Day -> (FilePath, Text)
|
||||
sealText config n rand date = ( fileName', bp )
|
||||
where
|
||||
fileName' =
|
||||
show date <> "-"
|
||||
<> "seal-post-"
|
||||
<> show n
|
||||
<> "." <> fileExtension'
|
||||
date' = T.pack . show $ date
|
||||
title = T.pack $ "Seal Post Number " <> show n
|
||||
title' = T.replace " " "-" title
|
||||
sealImagesPath' = sealImagesPath config
|
||||
fileExtension' = fileExtension config
|
||||
|
||||
bp = blogPost' (toGregorian date)
|
||||
|
||||
blogPost' :: (Integer, Int, Int) -> Text
|
||||
blogPost' (_, 09, 26) =
|
||||
blogPost
|
||||
title
|
||||
"Birthdayingly gaze at"
|
||||
"spoiled"
|
||||
"older"
|
||||
"birthdaySeal.jpg"
|
||||
date
|
||||
sealImagesPath'
|
||||
|
||||
blogPost' (_, 04, 01) =
|
||||
blogPost
|
||||
title
|
||||
"Foolishly look at"
|
||||
"beautiful"
|
||||
"supermodel, singing"
|
||||
"_singerSeal.jpg"
|
||||
date
|
||||
sealImagesPath'
|
||||
|
||||
blogPost' (_, _, _) =
|
||||
blogPost
|
||||
title
|
||||
(randomPull rand (looks config))
|
||||
(randomPull rand (adjectives1 config))
|
||||
(randomPull rand (adjectives2 config))
|
||||
(randomPull rand (unsafeListDirContents sealImagesPath'))
|
||||
date
|
||||
sealImagesPath'
|
||||
where
|
||||
randomPull r txts = txts !! (rand `mod` l)
|
||||
where l = length txts - 1
|
||||
|
||||
{-
|
||||
Blog post format
|
||||
-}
|
||||
|
|
@ -109,84 +168,21 @@ blogPost title see adj1 adj2 seal date imagesPath =
|
|||
|
||||
$see this $adj1, $adj2 seal!
|
||||
<img
|
||||
src="$imagesPath'/$seal"
|
||||
src="/$imagesPath'/$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
|
||||
sealImagesPath' = sealImagesPath config
|
||||
|
||||
bp = blogPost' (toGregorian date)
|
||||
|
||||
blogPost' :: (Integer, Int, Int) -> Text
|
||||
blogPost' (_, 09, 26) =
|
||||
blogPost
|
||||
title
|
||||
"Birthdayingly gaze at"
|
||||
"spoiled"
|
||||
"older"
|
||||
"birthdaySeal.jpg"
|
||||
date
|
||||
sealImagesPath'
|
||||
|
||||
blogPost' (_, 04, 01) =
|
||||
blogPost
|
||||
title
|
||||
"Foolishly look at"
|
||||
"beautiful"
|
||||
"supermodel, singing"
|
||||
"singerSeal.jpg"
|
||||
date
|
||||
sealImagesPath'
|
||||
|
||||
blogPost' (_, _, _) =
|
||||
blogPost
|
||||
title
|
||||
(randomPull $ looks config)
|
||||
(randomPull $ adjectives1 config)
|
||||
(randomPull $ adjectives2 config)
|
||||
(randomPull $ unsafeListDirContents sealImagesPath')
|
||||
date
|
||||
sealImagesPath'
|
||||
|
||||
|
||||
{-
|
||||
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 = map T.pack . sort . unsafePerformIO . listDirectory
|
||||
unsafeListDirContents = map T.pack . drop 2 . sort . unsafePerformIO . listDirectory
|
||||
-- ^^^^^^
|
||||
-- drop 2 used to remove the birthday and singer photos
|
||||
-- TODO: find a better way to hardcode this
|
||||
|
||||
prettyPrint :: Show a => [a] -> IO ()
|
||||
prettyPrint = putStr . unlines . map show
|
||||
|
|
|
|||
|
Before Width: | Height: | Size: 13 KiB After Width: | Height: | Size: 13 KiB |
Loading…
Add table
Add a link
Reference in a new issue