diff --git a/.gitignore b/.gitignore index 7147a98..0f108df 100644 --- a/.gitignore +++ b/.gitignore @@ -5,4 +5,5 @@ input bin dist +lib *.sublime-workspace diff --git a/AStar.hs b/AStar.hs index 24128be..29a4e1c 100644 --- a/AStar.hs +++ b/AStar.hs @@ -2,7 +2,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} -module AStar where +module AStar (astar) where import qualified Data.PQueue.Prio.Min as PQ import qualified Data.Set as S diff --git a/AmazingMazes.hs b/AmazingMazes.hs index 3c44983..79e0feb 100644 --- a/AmazingMazes.hs +++ b/AmazingMazes.hs @@ -43,7 +43,9 @@ {-# LANGUAGE BangPatterns, TupleSections #-} -module Main where +module AmazingMazes (Cell(..), Maze(..), MazeSolution(..), + generateMaze, renderMaze, solveMaze, main) +where import qualified Data.Map as M import AStar @@ -89,7 +91,7 @@ randomShuffle list = do type Cell = (Int, Int) -- a maze with width, height and a map of cell paths -data Maze = Maze Int Int (M.Map Cell [Cell]) deriving (Show) +data Maze = Maze Int Int (M.Map Cell [Cell]) -- a solution to a maze with the start and end cells and the path map data MazeSolution = MazeSolution Cell Cell (M.Map Cell Cell) diff --git a/BarrelOfMonkeys.hs b/BarrelOfMonkeys.hs index e5b920c..46a2ee0 100644 --- a/BarrelOfMonkeys.hs +++ b/BarrelOfMonkeys.hs @@ -6,7 +6,11 @@ {-# LANGUAGE Arrows, NoMonomorphismRestriction, RecordWildCards #-} -module Main where +module BarrelOfMonkeys + (Song(..), SongLibrary, Playlist(..), getSongsFromXml, + shortestPlaylist, longestPlaylist, shortestTimePlaylist, longestTimePlaylist, + timedPlaylist, main) +where import qualified Data.Map as M import qualified Data.FingerTree.PSQueue as Q @@ -47,10 +51,9 @@ data SongLibrary = SongLibrary { songIdMap :: M.Map Int Song, fstCharMap :: M.Map Char [Song], lstCharMap :: M.Map Char [Song] - } deriving (Show) + } data Playlist = Playlist { playlistSongs :: [Song], playlistDuration :: Int } - deriving (Show) --- XML parsing --- diff --git a/Cryptograms.hs b/Cryptograms.hs index 6d9c301..6964743 100644 --- a/Cryptograms.hs +++ b/Cryptograms.hs @@ -8,7 +8,9 @@ {-# LANGUAGE BangPatterns #-} -module Main where +module Cryptograms (Mapping, Dict, readDict, translateToken, + scoreMapping, findBestMappings, showMapping, main) +where import qualified Data.Map as M import qualified Data.Set as S @@ -26,14 +28,14 @@ trace _ x = x type Mapping = M.Map Char Char -type Dict = M.Map Int (S.Set String) +newtype Dict = Dict (M.Map Int (S.Set String)) -- reads the dictionary from the given file. must contain one word per line. readDict :: FilePath -> IO Dict readDict filePath = do !dictWords <- fmap (filter (all isAlpha) . map (map toLower) . lines) $ readFile filePath - return $ + return . Dict $ foldl' (\dict w -> M.insertWith S.union (length w) (S.singleton w) dict) M.empty dictWords @@ -52,7 +54,7 @@ translateTokens mapping = -- checks if the given word is in the dictionary. inDict :: Dict -> String -> Bool -inDict dict word = +inDict (Dict dict) word = case M.lookup (length word) dict of Nothing -> False Just ws -> word `S.member` ws @@ -123,7 +125,7 @@ mergeMappings mapping1 mapping2 = -- creates mappings for a token by finding words of same form from the dictionary. createMappingsForToken :: Dict -> String -> S.Set Mapping -createMappingsForToken dict token = +createMappingsForToken (Dict dict) token = case M.lookup (length token) dict of Nothing -> S.empty Just words -> let diff --git a/DiceRoller.hs b/DiceRoller.hs index 462f6a6..297fe62 100644 --- a/DiceRoller.hs +++ b/DiceRoller.hs @@ -16,7 +16,7 @@ {-# LANGUAGE NoMonomorphismRestriction #-} -module Main (main) where +module DiceRoller (RandomState, Expr(..), eval, expr, main) where import Control.Applicative ((<$>), (<*), (*>), (<|>)) import Control.Monad (foldM, liftM2, liftM, when) diff --git a/EnglishNumerals.hs b/EnglishNumerals.hs index de604a8..c96b556 100644 --- a/EnglishNumerals.hs +++ b/EnglishNumerals.hs @@ -46,7 +46,8 @@ Copyright 2012 Abhinav Sarkar -} -module Main where +module EnglishNumerals (Basis, readBasis, toEnglishNumerals, firstOddByEnglishNumeral, main) +where import qualified Data.Sequence as Seq import Data.List (maximumBy, nub) diff --git a/GedcomParser.hs b/GedcomParser.hs index 226b7c6..d017d5b 100644 --- a/GedcomParser.hs +++ b/GedcomParser.hs @@ -3,9 +3,9 @@ -- Example GEDCOM document at -- http://cpansearch.perl.org/src/PJCJ/Gedcom-1.16/royal.ged -{-# LANGUAGE NoMonomorphismRestriction, RecordWildCards #-} +{-# LANGUAGE NoMonomorphismRestriction, RecordWildCards, FlexibleContexts #-} -module Main where +module GedcomParser (Elem(..), Doc, document, documentToXml, main) where import Text.Parsec hiding (spaces, Line) import System.IO @@ -16,7 +16,7 @@ data Line = Line { lineTag :: String, lineValue :: Maybe String, lineId :: Maybe String - } deriving (Show) + } -- an element in a GEDCOM document data Elem = Elem { @@ -26,6 +26,8 @@ data Elem = Elem { elemChildren :: [Elem] } deriving (Show) +type Doc = [Elem] + indent n = concat . replicate n $ " " trimValue value = case value of @@ -60,6 +62,7 @@ element level = do return $ Elem lineTag lineValue lineId children -- parses a document +document :: Stream s m Char => ParsecT s u m Doc document = element 0 `endBy` whitespaces -- normalizes an element by merging values of CONC and CONT @@ -96,9 +99,11 @@ elemToXml indentation Elem{..} = ++ indent indentation ++ "" -- converts a document to XML +documentToXml :: Doc -> String documentToXml doc = "\n" - ++ (unlines . map (elemToXml 1) $ doc) + ++ (unlines . map (elemToXml 1) $ doc') ++ "" + where doc' = normalizeDoc doc -- converts a GEDCOM document supplied through STDIN into XML -- and prints to STDOUT @@ -106,5 +111,5 @@ main = do text <- getContents case parse document "GEDCOM Parser" text of Right [] -> return () - Right doc -> putStrLn $ documentToXml (normalizeDoc doc) + Right doc -> putStrLn $ documentToXml doc Left e -> print e \ No newline at end of file diff --git a/KnightsTravails.hs b/KnightsTravails.hs index 565cd20..d6e383b 100644 --- a/KnightsTravails.hs +++ b/KnightsTravails.hs @@ -20,7 +20,9 @@ {-# LANGUAGE MultiParamTypeClasses, RecordWildCards #-} -module Main where +module KnightsTravails (Square, Board(..), fromNotation, toNotation, isValidNotation, + bfsSearch, astarSearch, main) +where import qualified Data.Set as S import AStar diff --git a/NumericMaze.hs b/NumericMaze.hs index 6ec859f..ae27227 100644 --- a/NumericMaze.hs +++ b/NumericMaze.hs @@ -16,7 +16,7 @@ Copyright 2012 Abhinav Sarkar -} -module Main (main) where +module NumericMaze (solve, main) where import AStar import Control.Monad (when) diff --git a/PhoneNumberWords.hs b/PhoneNumberWords.hs index 7a4a413..04e6255 100644 --- a/PhoneNumberWords.hs +++ b/PhoneNumberWords.hs @@ -15,7 +15,7 @@ {-# LANGUAGE BangPatterns #-} -module Main where +module PhoneNumberWords(Dict, readDict, phoneNumberWords, main) where import qualified Data.Set as S import qualified Data.Map as M @@ -24,7 +24,7 @@ import Data.List (foldl', sort, intercalate) import Data.Maybe (fromMaybe) import System.Environment (getArgs) -type Dict = M.Map String (S.Set String) +newtype Dict = Dict (M.Map String (S.Set String)) -- reads the dictionary from the given file. must contain one word per line. readDict :: FilePath -> IO Dict @@ -33,7 +33,7 @@ readDict filePath = do . filter ((> 2) . length) . map (map toUpper) . lines) $ readFile filePath - return $ + return . Dict $ foldl' (\dict w -> M.insertWith S.union (translate w) (S.singleton w) dict) M.empty dictWords @@ -69,7 +69,7 @@ wordsForSplit dict = map (\k -> S.toList . fromMaybe (S.singleton k) . M.lookup k $ dict) -- find all phone number words for a phone number -phoneNumberWords dict = +phoneNumberWords (Dict dict) = filter isValid . sort . concatMap (map (drop 1) . foldl (\acc ws -> [a ++ "-" ++ w | a <- acc, w <- ws]) [[]] diff --git a/SolataireCipher.hs b/SolataireCipher.hs index 83145f0..24131d9 100644 --- a/SolataireCipher.hs +++ b/SolataireCipher.hs @@ -1,4 +1,4 @@ -module Main where +module SolataireCipher (Card(..), Deck, encrypt, decrypt, main) where import qualified Options.Applicative as Op import Data.Char (toUpper, ord, chr) diff --git a/SudokuSolver.hs b/SudokuSolver.hs index 524c31e..4ee1ac5 100644 --- a/SudokuSolver.hs +++ b/SudokuSolver.hs @@ -22,7 +22,10 @@ {-# LANGUAGE BangPatterns, RecordWildCards #-} -module Main (main) where +module SudokuSolver (Cell(..), Board, emptyBoard, boardCells, cellValues, + isBoardSolved, readBoard, showBoard, prettyShowBoard, + solveSudoku, main) +where import qualified Data.Set as S import qualified Data.HashMap.Strict as M @@ -48,14 +51,14 @@ data Cell = Cell {-# UNPACK #-} !Int -- ambCells is the set of cells which have not been solved yet. data Board = Board { ixMap :: !(M.HashMap Int Cell), ambCells :: !(S.Set Cell) - } deriving (Eq, Show) + } deriving (Eq) instance Eq Cell where {-# INLINE (==) #-} (Cell i1 v1 _) == (Cell i2 v2 _) = i1 == i2 && v1 == v2 instance Show Cell where - show (Cell ix val _) = "<" ++ show ix ++ " " ++ show val ++ ">" + show cell@(Cell ix val _) = "<" ++ show ix ++ " " ++ show (cellValues cell) ++ ">" instance Ord Cell where (Cell i1 v1 vl1) `compare` (Cell i2 v2 vl2) = @@ -63,6 +66,12 @@ instance Ord Cell where then EQ else (vl1, i1) `compare`(vl2, i2) +cellValues :: Cell -> [Int] +cellValues (Cell _ val _) = filter (testBit val) [1..9] + +boardCells :: Board -> [Cell] +boardCells = map snd . sortBy (comparing fst) . M.toList . ixMap + -- Gets the index of the lowest bit set as 1. firstSol :: Word16 -> Int firstSol val = fromJust . find (testBit val) $ [1..9] @@ -158,14 +167,13 @@ showBoard :: Board -> String showBoard board = zipWith (\(Cell _ val vl) dot -> if vl == 1 then intToDigit . firstSol $ val else dot) - (map snd . sortBy (comparing fst) . M.toList . ixMap $ board) + (boardCells board) (repeat '.') -- Pretty prints a Sudoku board. -printBoard :: Board -> IO () -printBoard board = - putStrLn - . (\t -> line ++ "\n" ++ t ++ line ++ "\n") +prettyShowBoard :: Board -> String +prettyShowBoard board = + (\t -> line ++ "\n" ++ t ++ line ++ "\n") . unlines . intercalate [line] . chunksOf 3 . map ((\r -> "| " ++ r ++ " |") . intercalate " | " . map (intersperse ' ') . chunksOf 3) diff --git a/TicTacToe.hs b/TicTacToe.hs index c421f75..9a3dc1f 100644 --- a/TicTacToe.hs +++ b/TicTacToe.hs @@ -12,7 +12,10 @@ {-# LANGUAGE BangPatterns, RecordWildCards #-} -module Main where +module TicTacToe (Move(..), CellState(..), Cell(..), Board(..), Run, Result(..), + Player(..), playMatch, playMatches, RandomPlayer(..), + LearningPlayer, learnedPlayer, playHuman, main) +where import qualified Data.Map as M import Control.Monad.State (State, get, put, runState, evalState) diff --git a/rubyquiz.cabal b/rubyquiz.cabal index c8b07c0..ad2078f 100644 --- a/rubyquiz.cabal +++ b/rubyquiz.cabal @@ -1,4 +1,4 @@ -name: RubyQuiz +name: rubyquiz version: 1.0 synopsis: Solutions to RubyQuiz problems in Haskell homepage: https://github.com/abhin4v/rubyquiz @@ -13,6 +13,25 @@ source-repository head type: git location: git@github.com:abhin4v/rubyquiz.git +library + exposed-modules : AStar, TicTacToe, KnightsTravails, Cryptograms, EnglishNumerals, + GedcomParser, PhoneNumberWords, SolataireCipher, + BarrelOfMonkeys, AmazingMazes, SudokuSolver, NumericMaze, + DiceRoller + build-depends : base == 4.*, + containers == 0.4.*, + mtl == 2.1.*, + random == 1.0.*, + split == 0.2.1.*, + pqueue == 1.2.*, + parsec == 3.1.*, + optparse-applicative == 0.1.*, + hxt == 9.2.*, + fingertree-psqueue == 0.3.*, + text == 0.11.*, + unordered-containers == 0.2.1.* + default-language : Haskell2010 + executable TicTacToe build-depends : base == 4.*, containers == 0.4.*, @@ -20,6 +39,7 @@ executable TicTacToe random == 1.0.*, split == 0.2.1.* main-is : TicTacToe.hs + ghc-options : -main-is TicTacToe default-language : Haskell2010 executable KnightsTravails @@ -27,12 +47,14 @@ executable KnightsTravails containers == 0.4.*, pqueue == 1.2.* main-is : KnightsTravails.hs + ghc-options : -main-is KnightsTravails default-language : Haskell2010 executable Cryptograms build-depends : base == 4.*, containers == 0.4.* main-is : Cryptograms.hs + ghc-options : -main-is Cryptograms default-language : Haskell2010 executable EnglishNumerals @@ -40,24 +62,28 @@ executable EnglishNumerals containers == 0.4.*, split == 0.2.1.* main-is : EnglishNumerals.hs + ghc-options : -main-is EnglishNumerals default-language : Haskell2010 executable GedcomParser build-depends : base == 4.*, parsec == 3.1.* main-is : GedcomParser.hs + ghc-options : -main-is GedcomParser default-language : Haskell2010 executable PhoneNumberWords build-depends : base == 4.*, containers == 0.4.* main-is : PhoneNumberWords.hs + ghc-options : -main-is PhoneNumberWords default-language : Haskell2010 executable SolataireCipher build-depends : base == 4.*, optparse-applicative == 0.1.* main-is : SolataireCipher.hs + ghc-options : -main-is SolataireCipher default-language : Haskell2010 executable BarrelOfMonkeys @@ -69,6 +95,7 @@ executable BarrelOfMonkeys text == 0.11.*, optparse-applicative == 0.1.* main-is : BarrelOfMonkeys.hs + ghc-options : -main-is BarrelOfMonkeys default-language : Haskell2010 executable AmazingMazes @@ -78,6 +105,7 @@ executable AmazingMazes random == 1.0.*, pqueue == 1.2.* main-is : AmazingMazes.hs + ghc-options : -main-is AmazingMazes default-language : Haskell2010 executable SudokuSolver @@ -87,7 +115,7 @@ executable SudokuSolver split == 0.2.1.*, unordered-containers == 0.2.1.* main-is : SudokuSolver.hs - ghc-options : -threaded -rtsopts + ghc-options : -threaded -rtsopts -main-is SudokuSolver default-language : Haskell2010 executable NumericMaze @@ -95,6 +123,7 @@ executable NumericMaze containers == 0.4.*, pqueue == 1.2.* main-is : NumericMaze.hs + ghc-options : -main-is NumericMaze default-language : Haskell2010 executable DiceRoller @@ -103,4 +132,5 @@ executable DiceRoller random == 1.0.*, parsec == 3.1.* main-is : DiceRoller.hs + ghc-options : -main-is DiceRoller default-language : Haskell2010 \ No newline at end of file diff --git a/rubyquiz.sublime-project b/rubyquiz.sublime-project index c498cc9..48c851c 100644 --- a/rubyquiz.sublime-project +++ b/rubyquiz.sublime-project @@ -3,8 +3,8 @@ [ { "path": "/home/abhinav/projects/rubyquiz", - "folder_exclude_patterns": ["bin", "dist"], - "file_exclude_patterns": ["*.hi", "*.o"] + "folder_exclude_patterns": ["bin", "dist"], + "file_exclude_patterns": ["*.hi", "*.o"] } ] }