wordle-accurate word generation
This commit is contained in:
parent
bed0a5946d
commit
0e8a24d465
59
app/Main.hs
59
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)
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue