Re-type type using the altered keyboard

Remember: always read the instructions; that's the most important part.

5 files changed, 129 insertions, 7 deletions

diff --git a/scratch/brilliant/App.hs b/scratch/brilliant/App.hs
index dd3f2788a254..bf39de4997ad 100644
--- a/scratch/brilliant/App.hs
+++ b/scratch/brilliant/App.hs
@@ -5,10 +5,20 @@ import Keyboard (Keyboard(..))
 import Transforms (Transform(..))
 import Utils ((|>))
 
+import qualified Data.Char as Char
 import qualified Utils
+import qualified Keyboard
+import qualified Data.HashMap.Strict as HM
 --------------------------------------------------------------------------------
 
 transform :: Keyboard -> Transform -> Keyboard
 transform (Keyboard xs) HorizontalFlip = xs |> fmap reverse |> Keyboard
 transform (Keyboard xs) VerticalFlip   = xs |> reverse |> Keyboard
 transform (Keyboard xs) (Shift n)      = xs |> fmap (Utils.rotate n) |> Keyboard
+
+retypePassage :: String -> Keyboard -> Maybe String
+retypePassage passage newKeyboard =
+  passage
+  |> fmap Char.toUpper
+  |> traverse (\c -> HM.lookup c Keyboard.charToCoord)
+  >>= traverse (Keyboard.coordToChar newKeyboard)
diff --git a/scratch/brilliant/Keyboard.hs b/scratch/brilliant/Keyboard.hs
index 885acb29e4cd..ec3207079694 100644
--- a/scratch/brilliant/Keyboard.hs
+++ b/scratch/brilliant/Keyboard.hs
@@ -1,8 +1,15 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 --------------------------------------------------------------------------------
 module Keyboard where
 --------------------------------------------------------------------------------
 import Utils
+import Data.Hashable (Hashable)
+import GHC.Generics (Generic)
+
 import qualified Data.List as List
+import qualified Data.HashMap.Strict as HM
 --------------------------------------------------------------------------------
 
 newtype Keyboard = Keyboard [[Char]]
@@ -16,6 +23,69 @@ instance Show Keyboard where
       printRow xs =
         xs |> fmap (\x -> '[':x:']':"") |> List.intercalate ""
 
+data Coord = Coord
+  { row :: Int
+  , col :: Int
+  } deriving (Eq, Show, Generic)
+
+instance Hashable Coord
+
+-- | List of characters to their QWERTY coordinatees.
+coords :: [(Char, Coord)]
+coords = [ ('0', Coord { row = 0, col = 0 })
+         , ('1', Coord { row = 0, col = 1 })
+         , ('2', Coord { row = 0, col = 2 })
+         , ('3', Coord { row = 0, col = 3 })
+         , ('4', Coord { row = 0, col = 4 })
+         , ('5', Coord { row = 0, col = 5 })
+         , ('6', Coord { row = 0, col = 6 })
+         , ('7', Coord { row = 0, col = 7 })
+         , ('8', Coord { row = 0, col = 8 })
+         , ('9', Coord { row = 0, col = 9 })
+         -- second row
+         , ('Q', Coord { row = 1, col = 0 })
+         , ('W', Coord { row = 1, col = 1 })
+         , ('E', Coord { row = 1, col = 2 })
+         , ('R', Coord { row = 1, col = 3 })
+         , ('T', Coord { row = 1, col = 4 })
+         , ('Y', Coord { row = 1, col = 5 })
+         , ('U', Coord { row = 1, col = 6 })
+         , ('I', Coord { row = 1, col = 7 })
+         , ('O', Coord { row = 1, col = 8 })
+         , ('P', Coord { row = 1, col = 9 })
+         -- third row
+         , ('A', Coord { row = 2, col = 0 })
+         , ('S', Coord { row = 2, col = 1 })
+         , ('D', Coord { row = 2, col = 2 })
+         , ('F', Coord { row = 2, col = 3 })
+         , ('G', Coord { row = 2, col = 4 })
+         , ('H', Coord { row = 2, col = 5 })
+         , ('J', Coord { row = 2, col = 6 })
+         , ('K', Coord { row = 2, col = 7 })
+         , ('L', Coord { row = 2, col = 8 })
+         , (';', Coord { row = 2, col = 9 })
+         -- fourth row
+         , ('Z', Coord { row = 3, col = 0 })
+         , ('X', Coord { row = 3, col = 1 })
+         , ('C', Coord { row = 3, col = 2 })
+         , ('V', Coord { row = 3, col = 3 })
+         , ('B', Coord { row = 3, col = 4 })
+         , ('N', Coord { row = 3, col = 5 })
+         , ('M', Coord { row = 3, col = 6 })
+         , (',', Coord { row = 3, col = 7 })
+         , ('.', Coord { row = 3, col = 8 })
+         , ('/', Coord { row = 3, col = 9 })
+         ]
+
+-- | Mapping of characters to their coordinates on a QWERTY keyboard with the
+-- top-left corner as 0,0.
+charToCoord :: HM.HashMap Char Coord
+charToCoord = HM.fromList coords
+
+coordToChar :: Keyboard -> Coord -> Maybe Char
+coordToChar (Keyboard xxs) Coord{..} =
+  Just $ xxs !! row !! col
+
 qwerty :: Keyboard
 qwerty = Keyboard [ ['1','2','3','4','5','6','7','8','9','0']
                   , ['Q','W','E','R','T','Y','U','I','O','P']
diff --git a/scratch/brilliant/Main.hs b/scratch/brilliant/Main.hs
index 4cc6ac1101c2..e94c73bea287 100644
--- a/scratch/brilliant/Main.hs
+++ b/scratch/brilliant/Main.hs
@@ -12,6 +12,7 @@ import qualified App
 
 data CommandArgs = CommandArgs
   { transforms :: String
+  , passage :: String
   } deriving (Eq, Show)
 
 parseArgs :: Parser CommandArgs
@@ -20,13 +21,22 @@ parseArgs =
                   ( long "transforms"
                  <> short 't'
                  <> help "String of transforms where (e.g. \"HHVS12VHVHS3\")" )
+              <*> strOption
+                  ( long "passage"
+                 <> short 'p'
+                 <> help "Input text to re-type" )
 
 main :: IO ()
 main = do
   CommandArgs{..} <- execParser opts
   case Transforms.fromString transforms of
     Nothing -> putStrLn "You must provide valid input (e.g. \"HHVS12VHVHS3\")"
-    Just xs -> print $ foldl App.transform Keyboard.qwerty xs
+    Just xs -> do
+      let keyboard = foldl App.transform Keyboard.qwerty (Transforms.optimize xs)
+      putStrLn $ "Typing: \"" ++ passage ++ "\"\nOn this keyboard:\n" ++ show keyboard
+      case App.retypePassage passage keyboard of
+        Nothing -> putStrLn $ "Looks like at least one of the characters in your input passage doesn't fit on our QWERTY keyboard: \n" ++ show Keyboard.qwerty
+        Just result -> putStrLn $ "Result: " ++ result
   where
     opts = info (parseArgs <**> helper)
       ( fullDesc
diff --git a/scratch/brilliant/README.md b/scratch/brilliant/README.md
index 89042564e28f..ef97a63f8659 100644
--- a/scratch/brilliant/README.md
+++ b/scratch/brilliant/README.md
@@ -1,31 +1,62 @@
 # Transform QWERTY
 
-Apply a series of transforms to a QWERTY keyboard.
+Apply a series of transforms to a QWERTY keyboard then use the new keyboard to
+re-type a passage of text.
 
 ## Usage
 
-To run the program, enter the following:
+Here are some `--help` and usage examples:
 
 ```shell
 $ runhaskell Main.hs --help
-Usage: Main.hs (-t|--transforms ARG)
+Usage: Main.hs (-t|--transforms ARG) (-p|--passage ARG)
   Transform a QWERTY keyboard using a string of commands
 
 Available options:
   -t,--transforms ARG      String of transforms where (e.g. "HHVS12VHVHS3")
+  -p,--passage ARG         Input text to re-type
   -h,--help                Show this help text
 ```
 
-For example:
+Now a working example:
 
 ```shell
-$ runhaskell Main.hs --transforms=HHVS12VHVHS3
+$ runhaskell Main.hs --transforms=HHVS12VHVHS3 --passage='Hello,Brilliant.'
+Typing: "Hello,Brilliant."
+On this keyboard:
 [N][M][,][.][/][Z][X][C][V][B]
 [H][J][K][L][;][A][S][D][F][G]
 [Y][U][I][O][P][Q][W][E][R][T]
 [6][7][8][9][0][1][2][3][4][5]
+Result: QKRRF30LDRRDY1;4
+```
+
+...and an example with an erroneous input (i.e. `!`):
+
+```shell
+$ runhaskell Main.hs --transforms=HHVS12VHVHS3 --passage='Hello,Brilliant!'
+Typing: "Hello,Brilliant!"
+On this keyboard:
+[N][M][,][.][/][Z][X][C][V][B]
+[H][J][K][L][;][A][S][D][F][G]
+[Y][U][I][O][P][Q][W][E][R][T]
+[6][7][8][9][0][1][2][3][4][5]
+Looks like at least one of the characters in your input passage doesn't fit on our QWERTY keyboard:
+[1][2][3][4][5][6][7][8][9][0]
+[Q][W][E][R][T][Y][U][I][O][P]
+[A][S][D][F][G][H][J][K][L][;]
+[Z][X][C][V][B][N][M][,][.][/]
 ```
 
 ## Environment
 
-You'll need `runhaskell`, so call `nix-shell` from this project's root directory.
+You'll need `runhaskell` and a few other Haskell libraries, so call `nix-shell`
+from this project's root directory.
+
+## Testing
+
+To run the test suite:
+
+```shell
+$ runhaskell Spec.hs
+```
diff --git a/scratch/brilliant/shell.nix b/scratch/brilliant/shell.nix
index 06fcc7979d2e..be1ecf3ca77f 100644
--- a/scratch/brilliant/shell.nix
+++ b/scratch/brilliant/shell.nix
@@ -5,6 +5,7 @@ in pkgs.mkShell {
     (haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
       hspec
       optparse-applicative
+      unordered-containers
     ]))
   ];
 }