Re-type type using the altered keyboard

Remember: always read the instructions; that's the most important part.
This commit is contained in:
William Carroll 2020-08-06 00:18:44 +01:00
parent e14fff7d4b
commit 5f52077492
5 changed files with 129 additions and 7 deletions

View file

@ -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)

View file

@ -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']

View file

@ -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

View file

@ -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
```

View file

@ -5,6 +5,7 @@ in pkgs.mkShell {
(haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
hspec
optparse-applicative
unordered-containers
]))
];
}