Re-type type using the altered keyboard
Remember: always read the instructions; that's the most important part.
This commit is contained in:
parent
e14fff7d4b
commit
5f52077492
5 changed files with 129 additions and 7 deletions
|
@ -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)
|
||||
|
|
|
@ -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']
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
```
|
||||
|
|
|
@ -5,6 +5,7 @@ in pkgs.mkShell {
|
|||
(haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
|
||||
hspec
|
||||
optparse-applicative
|
||||
unordered-containers
|
||||
]))
|
||||
];
|
||||
}
|
||||
|
|
Loading…
Reference in a new issue