diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..8392d15 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use flake \ No newline at end of file diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f2a83d1 --- /dev/null +++ b/.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 \ No newline at end of file diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..727200a --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,11 @@ +{ + "cSpell.words": [ + "Birthdayingly", + "Dhall", + "NOINLINE", + "runghc", + "uncurry", + "unlines", + "utct" + ] +} \ No newline at end of file diff --git a/config.dhall b/config.dhall new file mode 100644 index 0000000..4753bbe --- /dev/null +++ b/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" + ] +} diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..4e6b285 --- /dev/null +++ b/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 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..f7fedf1 --- /dev/null +++ b/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 + ]; + }; + }); +} diff --git a/generateSealPosts.hs b/generateSealPosts.hs new file mode 100755 index 0000000..12a70c9 --- /dev/null +++ b/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! + A picture of a $adj1, $adj2 seal! <3 + |] + +-- 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