Initial commit (moving refactored code out of seal-blog proper)

.envrc

@@ -0,0 +1 @@
+use flake

.gitignore

@@ -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

.vscode/settings.json

@@ -0,0 +1,11 @@
+{
+  "cSpell.words": [
+    "Birthdayingly",
+    "Dhall",
+    "NOINLINE",
+    "runghc",
+    "uncurry",
+    "unlines",
+    "utct"
+  ]
+}

config.dhall

@@ -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"
+  ]
+}

flake.lock

@@ -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
+}

flake.nix

@@ -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
+            ];
+        };
+      });
+}

generateSealPosts.hs

@@ -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