Skip to content
Browse files

Simplify Argument instances for Color and WindowColor

  • Loading branch information...
1 parent a6109af commit 5743611ef0ecbe677db1eaf040bcf7baa6e94f42 @sol sol committed
Showing with 49 additions and 31 deletions.
  1. +1 −0 ncursesw/src/Misc.chs
  2. +25 −25 src/Command/Core.hs
  3. +23 −6 test/Command/CoreSpec.hs
View
1 ncursesw/src/Misc.chs
@@ -107,6 +107,7 @@ mvwchgat win y x n attrs color = mvwchgat_ win y x n attrs color nullPtr
-- color(3NCURSES)
------------------------------------------------------------------------
newtype Color = Color CShort
+ deriving (Eq, Show)
fromColor :: Color -> CShort
fromColor (Color a) = a
View
50 src/Command/Core.hs
@@ -121,31 +121,31 @@ instance Argument Double where
instance Argument String where
argumentSpec = (mkParser Just, ArgumentSpec "string" [])
+-- | Create an ArgumentSpec from an association list.
+mkSpec :: Argument a => String -> [(String, a)] -> (Parser a, ArgumentSpec)
+mkSpec name values = (mkParser ((`lookup` values) . map toLower), ArgumentSpec name (map fst values))
+
instance Argument WindowColor where
- argumentSpec = (mkParser parse, ArgumentSpec "item" ["main", "ruler", "tab", "input", "playstatus", "songstatus", "error", "suggestions"])
- where
- parse input = case map toLower input of
- "main" -> Just MainColor
- "ruler" -> Just RulerColor
- "tab" -> Just TabColor
- "input" -> Just InputColor
- "playstatus" -> Just PlayStatusColor
- "songstatus" -> Just SongStatusColor
- "error" -> Just ErrorColor
- "suggestions" -> Just SuggestionsColor
- _ -> Nothing
+ argumentSpec = mkSpec "item" [
+ ("main", MainColor)
+ , ("ruler", RulerColor)
+ , ("tab", TabColor)
+ , ("input", InputColor)
+ , ("playstatus", PlayStatusColor)
+ , ("songstatus", SongStatusColor)
+ , ("error", ErrorColor)
+ , ("suggestions", SuggestionsColor)
+ ]
instance Argument Color where
- argumentSpec = (mkParser parse, ArgumentSpec "color" ["default", "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white"])
- where
- parse input = case map toLower input of
- "default" -> Just defaultColor
- "black" -> Just black
- "red" -> Just red
- "green" -> Just green
- "yellow" -> Just yellow
- "blue" -> Just blue
- "magenta" -> Just magenta
- "cyan" -> Just cyan
- "white" -> Just white
- _ -> Nothing
+ argumentSpec = mkSpec "color" [
+ ("default", defaultColor)
+ , ("black", black)
+ , ("red", red)
+ , ("green", green)
+ , ("yellow", yellow)
+ , ("blue", blue)
+ , ("magenta", magenta)
+ , ("cyan", cyan)
+ , ("white", white)
+ ]
View
29 test/Command/CoreSpec.hs
@@ -1,17 +1,14 @@
-{-# LANGUAGE StandaloneDeriving #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
module Command.CoreSpec (main, spec) where
import Test.Hspec.ShouldBe
+import Control.Monad (forM_)
+import Data.Char
import Control.Applicative
-import UI.Curses (Color(..), magenta)
+import WindowLayout
import Command.Core
import Command.Parser (runParser)
-deriving instance Eq Color
-deriving instance Show Color
-
main :: IO ()
main = hspecX spec
@@ -74,3 +71,23 @@ spec = do
it "given an action, it returns a list of required arguments" $ do
let f x y z = (x, y, z) :: (Double, String, Color)
(map argumentSpecName . actionArguments f) (undefined :: (Double, String, Color)) `shouldBe` ["double", "string", "color"]
+
+ describe "argument parser for Color" $ do
+ let colors = [
+ ("default", defaultColor)
+ , ("black", black)
+ , ("red", red)
+ , ("green", green)
+ , ("yellow", yellow)
+ , ("blue", blue)
+ , ("magenta", magenta)
+ , ("cyan", cyan)
+ , ("white", white)
+ ]
+ it "parses arbitrary colors" $ do
+ forM_ colors $ \(input, color) ->
+ runParser argumentParser input `shouldBe` Right (color, "")
+
+ it "ignores case" $ do
+ forM_ colors $ \(input, color) ->
+ runParser argumentParser (map toUpper input) `shouldBe` Right (color, "")

0 comments on commit 5743611

Please sign in to comment.
Something went wrong with that request. Please try again.