Move scratch/brilliant into //assessments
Where it belongs...
This commit is contained in:
William Carroll
parent
0c71fc9d1d
commit
33890d8a8b
10 changed files with 0 additions and 0 deletions
|
|
@ -1,2 +0,0 @@
|
|||
:set prompt "> "
|
||||
:set -Wall
|
||||
|
|
@ -1,41 +0,0 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module App where
|
||||
--------------------------------------------------------------------------------
|
||||
import Keyboard (Keyboard(..))
|
||||
import Transforms (Transform(..))
|
||||
import Utils ((|>))
|
||||
|
||||
import qualified Data.Char as Char
|
||||
import qualified Utils
|
||||
import qualified Data.List.Split as Split
|
||||
import qualified Keyboard
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
transform :: Keyboard -> Transform -> Keyboard
|
||||
|
||||
transform (Keyboard xs) xform =
|
||||
case xform of
|
||||
HorizontalFlip ->
|
||||
xs
|
||||
|> fmap reverse
|
||||
|> Keyboard
|
||||
|
||||
VerticalFlip ->
|
||||
xs
|
||||
|> reverse
|
||||
|> Keyboard
|
||||
|
||||
Shift n ->
|
||||
xs
|
||||
|> concat
|
||||
|> Utils.rotate n
|
||||
|> Split.chunksOf 10
|
||||
|> 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,58 +0,0 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Keyboard where
|
||||
--------------------------------------------------------------------------------
|
||||
import Utils
|
||||
import Data.Coerce
|
||||
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]]
|
||||
deriving (Eq)
|
||||
|
||||
instance Show Keyboard where
|
||||
show (Keyboard xxs) =
|
||||
xxs |> fmap printRow |> List.intercalate "\n"
|
||||
where
|
||||
printRow :: [Char] -> String
|
||||
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 =
|
||||
qwerty
|
||||
|> coerce
|
||||
|> fmap (zip [0..])
|
||||
|> zip [0..]
|
||||
|> fmap (\(row, xs) -> xs |> fmap (\(col, char) -> (char, Coord row col)))
|
||||
|> mconcat
|
||||
|
||||
-- | 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']
|
||||
, ['A','S','D','F','G','H','J','K','L',';']
|
||||
, ['Z','X','C','V','B','N','M',',','.','/']
|
||||
]
|
||||
|
|
@ -1,43 +0,0 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Main where
|
||||
--------------------------------------------------------------------------------
|
||||
import Options.Applicative
|
||||
import Data.Semigroup ((<>))
|
||||
|
||||
import qualified Transforms
|
||||
import qualified Keyboard
|
||||
import qualified App
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data CommandArgs = CommandArgs
|
||||
{ transforms :: String
|
||||
, passage :: String
|
||||
} deriving (Eq, Show)
|
||||
|
||||
parseArgs :: Parser CommandArgs
|
||||
parseArgs =
|
||||
CommandArgs <$> strOption
|
||||
( 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 -> 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
|
||||
<> progDesc "Transform a QWERTY keyboard using a string of commands")
|
||||
|
|
@ -1,82 +0,0 @@
|
|||
# Transform QWERTY
|
||||
|
||||
Apply a series of transforms to a QWERTY keyboard then use the new keyboard to
|
||||
re-type a passage of text.
|
||||
|
||||
## Environment
|
||||
|
||||
You will need [Nix][nix] to build this program on your machine. The good news is
|
||||
that you won't need any Haskell-specific dependencies like `ghc`, `cabal`, or
|
||||
`stack`: just Nix.
|
||||
|
||||
Once you have Nix installed, to build the program, run the following from this
|
||||
project's top-level directory:
|
||||
|
||||
```shell
|
||||
$ nix-build
|
||||
```
|
||||
|
||||
This should output an executable named `transform-keyboard` within a `result`
|
||||
directory:
|
||||
|
||||
```shell
|
||||
$ tree result
|
||||
result
|
||||
└── transform-keyboard
|
||||
```
|
||||
|
||||
### Testing
|
||||
|
||||
To run the test suite, run the following from the project's top-level directory:
|
||||
|
||||
```shell
|
||||
$ nix-shell
|
||||
$ runhaskell Spec.hs
|
||||
```
|
||||
|
||||
[nix]: https://nixos.org/download.html
|
||||
|
||||
## Usage
|
||||
|
||||
Here are some `--help` and usage examples:
|
||||
|
||||
```shell
|
||||
$ ./result/transform-keyboard --help
|
||||
Usage: transform-keyboard (-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
|
||||
```
|
||||
|
||||
Now a working example:
|
||||
|
||||
```shell
|
||||
$ ./result/transform-keyboard --transforms=HHVS12VHVHS3 --passage='Hello,Brilliant.'
|
||||
Typing: "Hello,Brilliant."
|
||||
On this keyboard:
|
||||
[H][J][K][L][;][Q][W][E][R][T]
|
||||
[Y][U][I][O][P][1][2][3][4][5]
|
||||
[6][7][8][9][0][Z][X][C][V][B]
|
||||
[N][M][,][.][/][A][S][D][F][G]
|
||||
Result: ZIVV4D/O3VV36APF
|
||||
```
|
||||
|
||||
...and an example with an erroneous input (i.e. `!`):
|
||||
|
||||
```shell
|
||||
$ ./result/transform-keyboard --transforms=HHVS12VHVHS3 --passage='Hello,Brilliant!'
|
||||
Typing: "Hello,Brilliant!"
|
||||
On this keyboard:
|
||||
[H][J][K][L][;][Q][W][E][R][T]
|
||||
[Y][U][I][O][P][1][2][3][4][5]
|
||||
[6][7][8][9][0][Z][X][C][V][B]
|
||||
[N][M][,][.][/][A][S][D][F][G]
|
||||
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][,][.][/]
|
||||
```
|
||||
|
|
@ -1,103 +0,0 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Spec where
|
||||
--------------------------------------------------------------------------------
|
||||
import Test.Hspec
|
||||
import Test.QuickCheck
|
||||
import Keyboard (Keyboard(..))
|
||||
import Transforms (Transform(..))
|
||||
import Data.Coerce
|
||||
import Utils
|
||||
|
||||
import qualified App
|
||||
import qualified Keyboard
|
||||
import qualified Transforms
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
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 Nothing when the input is invalid" $ do
|
||||
Transforms.fromString "potato" == Nothing
|
||||
|
||||
it "return Nothing when the input is valid except for the end" $ do
|
||||
Transforms.fromString "HVS10potato" == Nothing
|
||||
|
||||
describe "App.transform" $ do
|
||||
it "flips any keyboard horizontally" $ do
|
||||
property $ \first second third fourth ->
|
||||
App.transform (Keyboard [first, second, third, fourth]) HorizontalFlip == do
|
||||
Keyboard [ reverse first
|
||||
, reverse second
|
||||
, reverse third
|
||||
, reverse fourth
|
||||
]
|
||||
|
||||
it "flips any keyboard vertically" $ do
|
||||
property $ \first second third fourth ->
|
||||
App.transform (Keyboard [first, second, third, fourth]) VerticalFlip == do
|
||||
Keyboard $ reverse [first, second, third, fourth]
|
||||
|
||||
it "shifts any keyboard" $ do
|
||||
property $ \first second third fourth n ->
|
||||
App.transform (Keyboard [first, second, third, fourth]) (Shift n)
|
||||
|> (coerce :: Keyboard -> [[Char]])
|
||||
|> concat ==
|
||||
[first, second, third, fourth]
|
||||
|> concat
|
||||
|> Utils.rotate n
|
||||
|
||||
it "flips a QWERTY keyboard horizontally" $ do
|
||||
App.transform Keyboard.qwerty HorizontalFlip == do
|
||||
Keyboard [ ['0','9','8','7','6','5','4','3','2','1']
|
||||
, ['P','O','I','U','Y','T','R','E','W','Q']
|
||||
, [';','L','K','J','H','G','F','D','S','A']
|
||||
, ['/','.',',','M','N','B','V','C','X','Z']
|
||||
]
|
||||
|
||||
it "flips a keyboard vertically" $ do
|
||||
App.transform Keyboard.qwerty VerticalFlip == do
|
||||
Keyboard [ ['Z','X','C','V','B','N','M',',','.','/']
|
||||
, ['A','S','D','F','G','H','J','K','L',';']
|
||||
, ['Q','W','E','R','T','Y','U','I','O','P']
|
||||
, ['1','2','3','4','5','6','7','8','9','0']
|
||||
]
|
||||
|
||||
it "shifts a keyboard left N times" $ do
|
||||
App.transform Keyboard.qwerty (Shift 2) == do
|
||||
Keyboard [ ['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',',','.','/','1','2']
|
||||
]
|
||||
|
||||
it "shifts right negative amounts" $ do
|
||||
App.transform Keyboard.qwerty (Shift (-3)) == do
|
||||
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']
|
||||
]
|
||||
|
||||
describe "Transforms.optimize" $ do
|
||||
it "removes superfluous horizontal transformations" $ do
|
||||
Transforms.optimize [HorizontalFlip, HorizontalFlip] == []
|
||||
|
||||
it "removes superfluous vertical transformations" $ do
|
||||
Transforms.optimize [VerticalFlip, VerticalFlip] == []
|
||||
|
|
@ -1,52 +0,0 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Transforms where
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Applicative ((<|>))
|
||||
import Text.ParserCombinators.ReadP
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data Transform = VerticalFlip
|
||||
| HorizontalFlip
|
||||
| Shift Int
|
||||
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)
|
||||
|
||||
-- | Attempt to remove redundant transformations.
|
||||
-- | Here are some rules that I'd like to support but may not have time for:
|
||||
-- | - All even-numbered flips (w/o intermittent shifts) can become zero
|
||||
-- | - All odd-numbered flips (w/o intermittent shifts) can become 1
|
||||
-- | - All shifts can be be reduce to the absolute value of shifts
|
||||
optimize :: [Transform] -> [Transform]
|
||||
optimize [] = []
|
||||
optimize [x] = [x]
|
||||
optimize (VerticalFlip:VerticalFlip:xs) = optimize xs
|
||||
optimize (HorizontalFlip:HorizontalFlip:xs) = optimize xs
|
||||
optimize xs = xs
|
||||
|
||||
fromString :: String -> Maybe [Transform]
|
||||
fromString x =
|
||||
case readP_to_S (manyTill command eof) x of
|
||||
[(res, "")] -> Just res
|
||||
_ -> Nothing
|
||||
|
|
@ -1,13 +0,0 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Utils where
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Function ((&))
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
(|>) :: a -> (a -> b) -> b
|
||||
(|>) = (&)
|
||||
|
||||
-- | Rotate `xs` as a cycle `n` times.
|
||||
rotate :: Int -> [a] -> [a]
|
||||
rotate n xs = take size . drop (n `mod` size) . cycle $ xs
|
||||
where size = length xs
|
||||
|
|
@ -1,16 +0,0 @@
|
|||
let
|
||||
briefcase = import <briefcase> {};
|
||||
in briefcase.buildHaskell.program {
|
||||
name = "transform-keyboard";
|
||||
srcs = builtins.path {
|
||||
path = ./.;
|
||||
name = "transform-keyboard-src";
|
||||
};
|
||||
deps = hpkgs: with hpkgs; [
|
||||
optparse-applicative
|
||||
unordered-containers
|
||||
split
|
||||
rio
|
||||
];
|
||||
ghcExtensions = [];
|
||||
}
|
||||
|
|
@ -1,16 +0,0 @@
|
|||
let
|
||||
pkgs = import (builtins.fetchGit {
|
||||
url = "https://github.com/NixOS/nixpkgs-channels";
|
||||
ref = "nixos-20.03";
|
||||
rev = "afa9ca61924f05aacfe495a7ad0fd84709d236cc";
|
||||
}) {};
|
||||
in pkgs.mkShell {
|
||||
buildInputs = with pkgs; [
|
||||
(haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
|
||||
hspec
|
||||
optparse-applicative
|
||||
unordered-containers
|
||||
split
|
||||
]))
|
||||
];
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue