wordle-accurate word generation

app/Main.hs

@@ -2,14 +2,22 @@ module Main where
 
 import System.Console.ANSI
 import System.IO
-import Language.Words
 import Data.List
 import System.Random
 import Data.Char
+import qualified Data.Text as T
+import Data.Text (Text)
+import qualified Data.Text.Lazy    as LT
+import qualified Data.Text.Lazy.IO as LT
+import System.Environment
+import Data.Time
 
 maxAttempts :: Integer
 maxAttempts = 6
 
+startDate :: UTCTime
+startDate = UTCTime (fromGregorian 2021 6 19) 0
+
 err :: String -> IO ()
 err s = do
   setSGR [SetColor Foreground Dull Red]
@@ -43,7 +51,7 @@ doGuess givenWord actualWord i = do
     setSGR [SetColor Background Dull Green]
     setSGR [SetColor Foreground Vivid Black]
   --else if gwc `elem` actualWord && (length $ filter (\(x, y) -> x == y) $ zip givenWord actualWord) >= 1 then do
-  else if gwc `elem` actualWord && (findPossibleMatches gwc actualWord) /= (findGreenMatches gwc givenWord actualWord) then do
+  else if gwc `elem` actualWord && findPossibleMatches gwc actualWord /= findGreenMatches gwc givenWord actualWord then do
     setSGR [SetColor Background Dull Yellow]
     setSGR [SetColor Foreground Vivid Black]
   else if rwc == '_' then
@@ -54,13 +62,13 @@ doGuess givenWord actualWord i = do
   putStr [gwc]
   setSGR [Reset]
 
-  if i == (length givenWord) - 1 then do
+  if i == length givenWord - 1 then do
     return ()
   else
     doGuess givenWord actualWord (i + 1)
 
-getWord :: String -> Integer -> IO ()
-getWord targetWord attempt = do
+getWord :: String -> Integer -> [String] -> IO ()
+getWord targetWord attempt allWords = do
   if attempt > maxAttempts then do
     putStrLn $ "you failed! the word was " ++ targetWord
   else do
@@ -71,9 +79,9 @@ getWord targetWord attempt = do
     case length word of
       5 -> do
         let lowercase = map toLower word
-        if ('\'' `elem` lowercase) || (lowercase `notElem` allStringWords) then do
+        if ('\'' `elem` lowercase) || (lowercase `notElem` allWords) then do
           err "invalid word"
-          getWord targetWord attempt
+          getWord targetWord attempt allWords
         else do
           cursorUpLine 1
           doGuess lowercase targetWord 0
@@ -84,26 +92,37 @@ getWord targetWord attempt = do
             cursorDownLine 1
             putStr "\n"
             cursorUpLine 1
-            getWord targetWord (attempt + 1)
+            getWord targetWord (attempt + 1) allWords
       0 -> do
         cursorUpLine 1
         clearLine
-        getWord targetWord attempt
+        getWord targetWord attempt allWords
       _ -> do
         err "invalid word length! must be 5 chars long"
-        getWord targetWord attempt
+        getWord targetWord attempt allWords
 
 getRandomElem :: StdGen -> [a] -> a
-getRandomElem g list = list !! (fst $ randomR (0, length list - 1) g)
+getRandomElem g list = list !! fst (randomR (0, length list - 1) g)
+
+withWordsFile f k = do
+  h <- openFile f ReadMode
+  k h
+
+wordsIO :: String -> IO [Text]
+wordsIO f = withWordsFile f $
+  fmap (dropWhile T.null . map (T.concat . LT.toChunks) . LT.lines)
+  . LT.hGetContents
 
 main :: IO ()
 main = do
+  args <- getArgs
+
   setSGR [SetConsoleIntensity BoldIntensity]
   putStrLn "\n          - wordlehs -          "
   setSGR [Reset]
   putStrLn "guess a 5-letter word by making guesses"
 
-  putStr " - " 
+  putStr " - "
   setSGR [SetColor Background Vivid Black]
   putStr "gray"
   setSGR [Reset]
@@ -137,12 +156,20 @@ main = do
   doGuess "vague" "___j_" 0
   putStrLn "\nthe letter U is not in the word in any spot\n"
 
-  putStrLn "now you give it a try!:\n"
-
   cursorDownLine 1
   putStr "\n"
   cursorUpLine 1
   g <- getStdGen
 
-  let randWord = (map toLower $ getRandomElem g $ filter (\x -> length x == 5 && '\'' `notElem` x) allStringWords)
-  getWord randWord 1
+  randomWords <- wordsIO "randomwords"
+  validWords <- wordsIO "validwords"
+
+  if "--daily" `elem` args then do
+    c <- getCurrentTime
+    let day = round (diffUTCTime c startDate / nominalDay)
+    putStrLn $ "wordle " ++ show day ++ "\n"
+    getWord (T.unpack $ randomWords !! day) 1 (map T.unpack validWords)
+  else do
+    putStrLn "now you give it a try!\n"
+    let randWord = map toLower $ getRandomElem g $ filter (\x -> length x == 5 && '\'' `notElem` x) (map T.unpack randomWords)
+    getWord randWord 1 (map T.unpack validWords)

readme.md

@@ -2,4 +2,6 @@
 a [Wordle](https://www.powerlanguage.co.uk/wordle/) clone in Haskell, made with help by [skye](https://git.oat.zone/skye)
 
 ## build
-`cabal build` then find executables in `build/`, might need a `cabal update` first (or just `cabal run`)
+`cabal build` then find executables in `build/`, might need a `cabal update` first (or just `cabal run`)
+
+use `cabal run -- wordle-hs --daily` for wordle-accurate daily stuff

wordle-hs.cabal

@@ -27,6 +27,6 @@ executable wordle-hs
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
-    build-depends:    base ^>=4.14.1.0, words, ansi-terminal, random
+    build-depends:    base ^>=4.14.1.0, ansi-terminal, random, text, time
     hs-source-dirs:   app
     default-language: Haskell2010