Support parsing the list of transforms

Using Haskell's Text.ParserCombinators.ReadP library for the first time, and I
enjoyed it thoroughly! It's nice avoiding a third-party library like MegaParsec.

2 files changed, 65 insertions, 7 deletions

diff --git a/scratch/brilliant/Spec.hs b/scratch/brilliant/Spec.hs
index f348dd0669a1..f49a3d3d96a4 100644
--- a/scratch/brilliant/Spec.hs
+++ b/scratch/brilliant/Spec.hs
@@ -4,16 +4,34 @@ module Spec where
 import Test.Hspec
 import Test.QuickCheck
 import Control.Exception (evaluate)
+import Transforms (Transform(..))
+
+import qualified Keyboard
+import qualified Transforms
 --------------------------------------------------------------------------------
 
 main :: IO ()
 main = hspec $ do
-  describe "Prelude.head" $ do
-    it "returns the first element of a list" $ do
-      head [23 ..] `shouldBe` (23 :: Integer)
+  describe "Keyboard.print" $ do
+    it "pretty-prints the keyboard" $ do
+      show Keyboard.qwerty == "[1][2][3][4][5][6][7][8][9][0]\n[Q][W][E][R][T][Y][U][I][O][P]\n[A][S][D][F][G][H][J][K][L][;]\n[Z][X][C][V][B][N][M][,][.][/]"
+
+  describe "Transforms.fromString" $ do
+    it "successfully parses a string of commands" $ do
+      Transforms.fromString "HHVS-12VHVHS3" ==
+        Just [ HorizontalFlip
+             , HorizontalFlip
+             , VerticalFlip
+             , Shift (-12)
+             , VerticalFlip
+             , HorizontalFlip
+             , VerticalFlip
+             , HorizontalFlip
+             , Shift 3
+             ]
 
-    it "returns the first element of an arbitrary list" $
-      property $ \x xs -> head (x:xs) == (x :: Integer)
+    it "returns Nothing when the input is invalid" $ do
+      Transforms.fromString "potato" == Nothing
 
-    it "throws an exception if used with an empty list" $ do
-      evaluate (head []) `shouldThrow` anyException
+    it "return Nothing when the input is valid except for the end" $ do
+      Transforms.fromString "HVS10potato" == Nothing
diff --git a/scratch/brilliant/Transforms.hs b/scratch/brilliant/Transforms.hs
new file mode 100644
index 000000000000..e707defda796
--- /dev/null
+++ b/scratch/brilliant/Transforms.hs
@@ -0,0 +1,40 @@
+--------------------------------------------------------------------------------
+module Transforms where
+--------------------------------------------------------------------------------
+import Control.Applicative ((<|>))
+import Text.ParserCombinators.ReadP
+--------------------------------------------------------------------------------
+
+data Transform = VerticalFlip
+               | HorizontalFlip
+               | Shift Integer
+               deriving (Eq, Show)
+
+digit :: ReadP Char
+digit =
+  satisfy (\c -> c >= '0' && c <= '9')
+
+command :: ReadP Transform
+command = vertical
+      <|> horizontal
+      <|> shift
+  where
+    vertical =
+      char 'V' >> pure VerticalFlip
+
+    horizontal =
+      char 'H' >> pure HorizontalFlip
+
+    shift = do
+      _ <- char 'S'
+      negative <- option Nothing $ fmap Just (satisfy (== '-'))
+      n <- read <$> many1 digit
+      case negative of
+        Nothing -> pure $ Shift n
+        Just _  -> pure $ Shift (-1 * n)
+
+fromString :: String -> Maybe [Transform]
+fromString x =
+  case readP_to_S (manyTill command eof) x of
+   [(res, "")] -> Just res
+   _           -> Nothing