diff options
| -rw-r--r-- | scratch/brilliant/App.hs | 10 | ||||
| -rw-r--r-- | scratch/brilliant/Keyboard.hs | 70 | ||||
| -rw-r--r-- | scratch/brilliant/Main.hs | 12 | ||||
| -rw-r--r-- | scratch/brilliant/README.md | 43 | ||||
| -rw-r--r-- | scratch/brilliant/shell.nix | 1 |
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 ])) ]; } |