Support App.transform

Apply the transform to a Keyboard. Onwards to the final demonstration!
This commit is contained in:
William Carroll 2020-08-05 23:20:18 +01:00
parent 61a2fb108d
commit 244503bba9
5 changed files with 57 additions and 1 deletions

14
scratch/brilliant/App.hs Normal file
View file

@ -0,0 +1,14 @@
--------------------------------------------------------------------------------
module App where
--------------------------------------------------------------------------------
import Keyboard (Keyboard(..))
import Transforms (Transform(..))
import Utils ((|>))
import qualified Utils
--------------------------------------------------------------------------------
transform :: Transform -> Keyboard -> Keyboard
transform HorizontalFlip (Keyboard xs) = xs |> fmap reverse |> Keyboard
transform VerticalFlip (Keyboard xs) = xs |> reverse |> Keyboard
transform (Shift n) (Keyboard xs) = xs |> fmap (Utils.rotate n) |> Keyboard

View file

@ -6,6 +6,7 @@ import qualified Data.List as List
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
newtype Keyboard = Keyboard [[Char]] newtype Keyboard = Keyboard [[Char]]
deriving (Eq)
instance Show Keyboard where instance Show Keyboard where
show (Keyboard xxs) = show (Keyboard xxs) =

View file

@ -4,10 +4,13 @@ module Spec where
import Test.Hspec import Test.Hspec
import Test.QuickCheck import Test.QuickCheck
import Control.Exception (evaluate) import Control.Exception (evaluate)
import Keyboard (Keyboard(..))
import Transforms (Transform(..)) import Transforms (Transform(..))
import qualified App
import qualified Keyboard import qualified Keyboard
import qualified Transforms import qualified Transforms
import qualified Utils
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
main :: IO () main :: IO ()
@ -35,3 +38,36 @@ main = hspec $ do
it "return Nothing when the input is valid except for the end" $ do it "return Nothing when the input is valid except for the end" $ do
Transforms.fromString "HVS10potato" == Nothing Transforms.fromString "HVS10potato" == Nothing
describe "App.transform" $ do
it "flips a keyboard horizontally" $ do
App.transform HorizontalFlip Keyboard.qwerty == do
Keyboard [ reverse ['1','2','3','4','5','6','7','8','9','0']
, reverse ['Q','W','E','R','T','Y','U','I','O','P']
, reverse ['A','S','D','F','G','H','J','K','L',';']
, reverse ['Z','X','C','V','B','N','M',',','.','/']
]
it "flips a keyboard vertically" $ do
App.transform VerticalFlip Keyboard.qwerty == do
Keyboard $ reverse [ ['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',',','.','/']
]
it "shifts a keyboard N times" $ do
App.transform (Shift 2) Keyboard.qwerty == do
Keyboard $ [ Utils.rotate 2 ['1','2','3','4','5','6','7','8','9','0']
, Utils.rotate 2 ['Q','W','E','R','T','Y','U','I','O','P']
, Utils.rotate 2 ['A','S','D','F','G','H','J','K','L',';']
, Utils.rotate 2 ['Z','X','C','V','B','N','M',',','.','/']
]
it "shifts negative amounts" $ do
App.transform (Shift (-3)) Keyboard.qwerty == do
Keyboard $ [ Utils.rotate (-3) ['1','2','3','4','5','6','7','8','9','0']
, Utils.rotate (-3) ['Q','W','E','R','T','Y','U','I','O','P']
, Utils.rotate (-3) ['A','S','D','F','G','H','J','K','L',';']
, Utils.rotate (-3) ['Z','X','C','V','B','N','M',',','.','/']
]

View file

@ -7,7 +7,7 @@ import Text.ParserCombinators.ReadP
data Transform = VerticalFlip data Transform = VerticalFlip
| HorizontalFlip | HorizontalFlip
| Shift Integer | Shift Int
deriving (Eq, Show) deriving (Eq, Show)
digit :: ReadP Char digit :: ReadP Char

View file

@ -6,3 +6,8 @@ import Data.Function ((&))
(|>) :: a -> (a -> b) -> b (|>) :: 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