revert 8ca4d4f58b

Provided build in Cabal, scaffolded project.

README.md

@@ -1,13 +1,3 @@
 # h2h_sorter
 
-Efficient head-to-head sorter terminal toy, with backtracking in Haskell. 
-
-Purpose-made to rank anime girl casts, but will work on any plaintext source.
-
-## Building and testing
-
-```bash 
-cabal build 
-# sort the Madoka cast 
-cabal run h2h_sorter -- meguca.txt 
-```
+Efficient head-to-head sorter with backtracking in Haskell. Purpose-made to rank anime girl casts, but will work on any plaintext source.

h2h-sorter.cabal

@@ -1,18 +0,0 @@
-cabal-version:          3.0
-name:                   h2h-sorter
-version:                0.2.0
-synopsis:               simple head-to-head sorter with backtracking.
-license:                GPL-3.0-or-later
-license-file:           LICENSE 
-author:                 hpcdisrespecter
-build-type:             Simple 
-extra-doc-files:        README.md
-executable h2h_sorter
-    main-is:            Main.hs
-    hs-source-dirs:     src
-    build-depends:      base >=4.14 && <5
-                        , array
-                        , mtl 
-                        , random
-    default-language:   Haskell2010
-    ghc-options:        -Wall -O2

meguca.txt

@@ -1,5 +0,0 @@
-pink
-black
-yellow
-red
-blue

src/Main.hs

@@ -1,178 +0,0 @@
-module Main where
-
-import Control.Monad (when, forM_)
-import Control.Monad.State (StateT, execStateT, get, put, modify, lift)
-import Data.Array.IO
-import Data.List (find, sortBy)
-import System.Environment (getArgs)
-import System.IO (hSetEcho, hSetBuffering, stdin, stdout, BufferMode(NoBuffering), hFlush)
-import System.Random (randomRIO)
-import System.Exit (exitSuccess)
-
--- Types of user choices
-data Verdict = GoLeft | GoRight deriving (Eq, Show)
-data Preference = Choice Verdict | GoBack | QuitNow deriving (Eq, Show)
-data Comparison = Comp String String Verdict deriving (Show)
-
--- The application state
-data AppState = AppState
-  { items :: [String]
-  , history :: [Comparison]
-  , original :: [String]
-  } deriving (Show)
-
--- Initialize the state
-initialState :: [String] -> AppState
-initialState xs = AppState { items = xs, history = [] , original = xs }
-
--- Tails gets trolled by the type system
-tails :: [a] -> [[a]]
-tails [] = [[]]
-tails xs@(_:xs') = xs : tails xs'
-
--- helper function for arrays 
-newArrayFrom :: [a] -> IO (IOArray Int a)
-newArrayFrom xs = newListArray (0, length xs - 1) xs 
-
--- O(n) Fisher-Yates shuffle
-shuffle :: [a] -> IO [a]
-shuffle xs = do
-  let n = length xs 
-  if n < 2
-    then return xs
-    else do 
-      arr <- newArrayFrom xs 
-      forM_ [n - 1, n - 2 .. 1] $ \i -> do 
-        j <- randomRIO (0, i) 
-        vi <- readArray arr i 
-        vj <- readArray arr j
-        writeArray arr j vi
-        writeArray arr i vj
-      getElems arr 
-
--- Read a single key, handling arrow keys
-getKey :: IO Preference
-getKey = do
-  hSetEcho stdin False
-  c <- getChar
-  hSetEcho stdin True
-  case c of
-    '\ESC' -> do
-      _c2 <- getChar 
-      c3 <- getChar
-      case c3 of
-        'D' -> putStrLn "←" >> return (Choice GoLeft)
-        'C' -> putStrLn "→" >> return (Choice GoRight)
-        _   -> getKey
-    'b' -> putStrLn "b" >> return GoBack
-    'q' -> putStrLn "q" >> return QuitNow
-    'h' -> putStrLn "←" >> return (Choice GoLeft)
-    'l' -> putStrLn "→" >> return (Choice GoRight)
-    'k' -> putStrLn "b" >> return GoBack
-    _   -> getKey
-
--- The shared comparison function that tracks history
-compareItems :: String -> String -> StateT AppState IO Verdict
-compareItems x y = do
-  lift $ putStr $ x ++ " vs. " ++ y ++ " (←/→/b/q): "
-  lift $ hFlush stdout
-  choice <- lift getKey
-  case choice of
-    Choice GoLeft -> do
-      modify (\s -> s { history = Comp x y GoLeft : history s })
-      return GoLeft
-    Choice GoRight -> do
-      modify (\s -> s { history = Comp x y GoRight : history s })
-      return GoRight
-    GoBack -> handleBack 
-    QuitNow -> lift $ exitSuccess
-
--- Handle going back
-handleBack :: StateT AppState IO Verdict
-handleBack = do
-  s <- get
-  case history s of
-    (Comp x y _ : rest) -> do
-      put $ s { history = rest }
-      compareItems x y
-    [] -> do
-      lift $ putStrLn "No more history to go back to. Restarting..."
-      put $ s { history = [] }
-      compareItems (items s !! 0) ( items s !! 1 )
-
--- Check transitive closure
-isLessThan :: [Comparison] -> String -> String -> Bool
-isLessThan hist x y 
-  | x == y = False
-  | otherwise = go [x] []
-  where
-  go [] _ = False
-  go (z:zs) visited
-    | z == y = True
-    | z `elem` visited = go zs visited
-    | otherwise = case filter (\(Comp a _ _) -> a == z) hist of
-    [] -> go zs (z:visited)
-    comps -> any (\(Comp _ b p) -> p == GoLeft && go (b:zs) (z:visited)) comps
-    || go zs (z:visited)
-
--- Compare function using history
-compareWithHistory :: [Comparison] -> String -> String -> Ordering
-compareWithHistory hist x y
-  | x == y = EQ 
-  | isLessThan hist x y = LT
-  | isLessThan hist y x = GT
-  | otherwise = case find (\(Comp a b _) -> (a == x && b == y) || (a == y && b == x)) hist of
-  Just (Comp a _ GoLeft) -> if a == x then LT else GT
-  Just (Comp a _ GoRight) -> if a == x then GT else LT
-  Nothing -> EQ
-
--- Sort by prompting user for missing comparisons
-sortPref :: [String] -> StateT AppState IO [String]
-sortPref xs = do
-  s <- get
-  let hist = history s
-      allPairs = [(x, y) | (x:ys) <- tails xs, y <- ys]
-      missingPairs = filter (\(x, y) -> not (isLessThan hist x y || isLessThan hist y x)) allPairs 
-  mapM_ (\(x, y) -> compareItems x y >> return ()) missingPairs
-  s' <- get
-  return $ sortBy (compareWithHistory (history s')) xs
-
--- Display the sorted results
-displayResult :: [String] -> IO ()
-displayResult xs = do
-  putStrLn "\nSorted Result:"
-  mapM_ (\(i, item) -> putStrLn $ show i ++ ". " ++ item) $ zip [1 :: Int ..] xs
-
--- Ask user if they want to save the results
-askToSave :: [String] -> IO ()
-askToSave xs = do
-  putStr "Would you like to save the sorted list? (y/n) "
-  hFlush stdout
-  response <- getChar
-  putStrLn ""
-  when (response == 'y' || response == 'Y') $ do
-    putStr "Enter filename to save: "
-    hFlush stdout
-    filename <- getLine
-    writeFile filename (unlines xs)
-    putStrLn $ "Sorted list saved to " ++ filename
-
--- Main function
-main :: IO ()
-main = do
-  hSetBuffering stdout NoBuffering
-  hSetBuffering stdin NoBuffering
-  args <- getArgs
-  case args of
-    [filename] -> do
-      content <- readFile filename
-      let ls = lines content
-      when (null ls) $ do
-        putStrLn "No items to sort."
-        exitSuccess
-      shuffled <- shuffle ls
-      finalState <- execStateT (sortPref shuffled >>= \sorted -> modify (\s -> s { items = sorted })) (initialState shuffled)
-      let sortedList = items finalState
-      displayResult sortedList
-      askToSave sortedList
-    _ -> putStrLn "Usage: h2h_sorter [filename]"