forked from MostAwesomeDude/lollerskates
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Main.hs
84 lines (70 loc) · 2.76 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
{-# LANGUAGE DeriveDataTypeable #-}
module Main where
import Control.Monad
import Data.Char
import Data.Maybe
import qualified Data.Map as Map
import System.Console.CmdArgs
import FD
import Items
import Loller
data Flag = Unique
deriving (Eq, Show)
data ModeParameters = BuildMode { bmUnique :: Bool
, bmAttribute :: String
, bmParameters :: [String] }
| ItemMode { imAttribute :: String }
deriving (Data, Show, Typeable)
arguments :: Mode (CmdArgs ModeParameters)
arguments = cmdArgsMode $
modes [ BuildMode { bmUnique = False &= name "unique"
&= help "Force wildcard items to be unique"
, bmAttribute = def &= argPos 0 &= typ "ATTRIBUTE"
, bmParameters = def &= args &= typ "ITEMS" }
&= name "build"
, ItemMode { imAttribute = def &= argPos 0 &= typ "ATTRIBUTE" }
&= name "item" ]
&= summary "Lollerskates"
maybeRead :: Read a => String -> Maybe a
maybeRead = fmap fst . listToMaybe . reads
-- | Given a padding and a list, pad (or truncate!) the list to a certain
-- length.
pad :: Int -> a -> [a] -> [a]
pad len padding l = take len $ l ++ replicate len padding
lookupAttribute :: Monad m => String -> m Comparator
lookupAttribute attr = case Map.lookup (map toLower attr) attributeFilters of
Just f -> return f
Nothing -> fail $ "Couldn't match attribute " ++ attr
lookupItem :: Monad m => String -> m [Item]
lookupItem "*" = return [Empty ..]
lookupItem name = case maybeRead name of
Just item -> return [item]
Nothing -> fail $ "Couldn't match item name " ++ name
parseArguments :: Monad m => [String] -> m (Comparator, [[Item]])
parseArguments args = do
when (null args) $ fail "No arguments given!"
attribute <- lookupAttribute $ head args
items <- mapM lookupItem $ pad 6 "*" (tail args)
return (attribute, items)
buildForFlags :: [Flag] -> [[Item]] -> [Build]
buildForFlags flags items = runFD $ do
build <- builds items
when (Unique `elem` flags) $ withVariety build
labelling build
main :: IO ()
main = do
args <- cmdArgsRun arguments
doMode args
doMode :: ModeParameters -> IO ()
doMode (BuildMode isUnique attr params) = do
attribute <- lookupAttribute attr
sets <- mapM lookupItem $ pad 6 "*" params
let flags = if isUnique then [Unique] else []
let build = buildForFlags flags sets
when (null build) $ fail
$ "No builds match the given constraints: " ++ show params
print $ maxBuild attribute build
doMode (ItemMode attr) = do
attribute <- lookupAttribute attr
print $ bestItem attribute [Empty ..]
doMode _ = fail $ "Unknown mode. You probably shouldn't be able to reach this."