From 33890d8a8b0366f078f359a9e7ad63da24634b9a Mon Sep 17 00:00:00 2001 From: William Carroll Date: Tue, 18 Aug 2020 12:13:00 +0100 Subject: Move scratch/brilliant into //assessments Where it belongs... --- scratch/brilliant/.ghci | 2 - scratch/brilliant/App.hs | 41 ---------------- scratch/brilliant/Keyboard.hs | 58 ---------------------- scratch/brilliant/Main.hs | 43 ----------------- scratch/brilliant/README.md | 82 -------------------------------- scratch/brilliant/Spec.hs | 103 ---------------------------------------- scratch/brilliant/Transforms.hs | 52 -------------------- scratch/brilliant/Utils.hs | 13 ----- scratch/brilliant/default.nix | 16 ------- scratch/brilliant/shell.nix | 16 ------- 10 files changed, 426 deletions(-) delete mode 100644 scratch/brilliant/.ghci delete mode 100644 scratch/brilliant/App.hs delete mode 100644 scratch/brilliant/Keyboard.hs delete mode 100644 scratch/brilliant/Main.hs delete mode 100644 scratch/brilliant/README.md delete mode 100644 scratch/brilliant/Spec.hs delete mode 100644 scratch/brilliant/Transforms.hs delete mode 100644 scratch/brilliant/Utils.hs delete mode 100644 scratch/brilliant/default.nix delete mode 100644 scratch/brilliant/shell.nix (limited to 'scratch') diff --git a/scratch/brilliant/.ghci b/scratch/brilliant/.ghci deleted file mode 100644 index efc88e630c..0000000000 --- a/scratch/brilliant/.ghci +++ /dev/null @@ -1,2 +0,0 @@ -:set prompt "> " -:set -Wall diff --git a/scratch/brilliant/App.hs b/scratch/brilliant/App.hs deleted file mode 100644 index 0272988f37..0000000000 --- a/scratch/brilliant/App.hs +++ /dev/null @@ -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) diff --git a/scratch/brilliant/Keyboard.hs b/scratch/brilliant/Keyboard.hs deleted file mode 100644 index 13b5de0145..0000000000 --- a/scratch/brilliant/Keyboard.hs +++ /dev/null @@ -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',',','.','/'] - ] diff --git a/scratch/brilliant/Main.hs b/scratch/brilliant/Main.hs deleted file mode 100644 index e94c73bea2..0000000000 --- a/scratch/brilliant/Main.hs +++ /dev/null @@ -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") diff --git a/scratch/brilliant/README.md b/scratch/brilliant/README.md deleted file mode 100644 index 60d7de4e25..0000000000 --- a/scratch/brilliant/README.md +++ /dev/null @@ -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][,][.][/] -``` diff --git a/scratch/brilliant/Spec.hs b/scratch/brilliant/Spec.hs deleted file mode 100644 index e99e025641..0000000000 --- a/scratch/brilliant/Spec.hs +++ /dev/null @@ -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] == [] diff --git a/scratch/brilliant/Transforms.hs b/scratch/brilliant/Transforms.hs deleted file mode 100644 index d8df8f8372..0000000000 --- a/scratch/brilliant/Transforms.hs +++ /dev/null @@ -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 diff --git a/scratch/brilliant/Utils.hs b/scratch/brilliant/Utils.hs deleted file mode 100644 index c69d00333b..0000000000 --- a/scratch/brilliant/Utils.hs +++ /dev/null @@ -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 diff --git a/scratch/brilliant/default.nix b/scratch/brilliant/default.nix deleted file mode 100644 index 886ba87e1c..0000000000 --- a/scratch/brilliant/default.nix +++ /dev/null @@ -1,16 +0,0 @@ -let - briefcase = import {}; -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 = []; -} diff --git a/scratch/brilliant/shell.nix b/scratch/brilliant/shell.nix deleted file mode 100644 index d0a6c7e5e6..0000000000 --- a/scratch/brilliant/shell.nix +++ /dev/null @@ -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 - ])) - ]; -} -- cgit 1.4.1