# Haskell Quiz/The Solitaire Cipher/Solution Tirpen

```I used a slightly off-beat representation of a deck and choose to use Sequences instead of lists, since I do a lot of concats and poking around both ends of the seqs.
I hope someones finds it interesting.
```
```module Solitaire where

import Data.Sequence as S
import Data.Char(chr)

data Card = Card Int | A | B deriving (Eq, Show)

isJoker :: Card -> Bool
isJoker (Card _)= False
isJoker _ = True

value :: Card -> Int
value (Card i) = i
value _ = 53

type Deck = (Seq (Card), Card, Seq (Card), Card, Seq (Card))

bottomCard :: Deck -> Card
bottomCard (_,_,_,j,s3) = case (viewr s3) of
EmptyR -> j
(s :> c) -> c

-- Converting between Deck and (Seq Card)
toSeq :: Deck -> Seq Card
toSeq (s1,j1,s2,j2,s3) = s1 >< (singleton j1) >< s2 >< (singleton j2) >< s3

fromSeq :: Seq Card -> Deck
fromSeq s = let
(s1,rest1) = noJoke s
(j1 :< rest2) = viewl rest1
(s2,rest3) = noJoke rest2
(j2 :< rest4) = viewl rest3
s3 = rest4
in
(s1,j1,s2,j2,s3)
where
noJoke sq = noJoke' (viewl sq)
noJoke' (c :< cs) = if (isJoker c)
then (empty,(c <| cs))
else let (a,b) = noJoke' \$ viewl cs
in (c <| a,b)
noJoke' EmptyL = (empty, empty)

moveA, moveB  :: Deck -> Deck
moveA d@(s1, A, s2, B, s3) = moveFst d
moveA d@(s1, B, s2, A, s3) = moveSnd d
moveB d@(s1, B, s2, A, s3) = moveFst d
moveB d@(s1, A, s2, B, s3) = moveSnd d

--Moves the topmost joker down one step.
moveFst    :: Deck -> Deck
moveFst (s1, j1, s2, j2, s3) = case (viewl s2) of
EmptyL -> (s1,j2,empty,j1,s3)
(c :< s) -> (s1 |> c, j1, s, j2, s3)
--Moves the bottom joker down one step, possibly wrapping if it's the last card.
moveSnd    :: Deck -> Deck
moveSnd (s1, j1, s2, j2, s3) = case (viewl s3) of
(c :< s) -> (s1 , j1, s2 |> c, j2, s)
--If j2 is the last card, place it _under_ the top card
EmptyL -> case (viewl s1) of
(c :< s) -> (singleton c, j2, s, j1, s2)
EmptyL -> (empty, j1, empty, j2, s2)

--Switches the stuff above the top joker with the stuff below the bottom one.
trippleCut :: Deck -> Deck
trippleCut (s1,j1,s2,j2,s3) = (s3,j1,s2,j2,s1)

-- Looks at bottom card, remove that many from the top and place them just
-- above the last card.
takeTop :: Deck -> Deck
takeTop d = let botc = bottomCard d :: Card
num = (value botc) :: Int
(lst :> _) = viewr \$ toSeq d
in fromSeq \$ ((S.drop num lst) >< (S.take num lst)) |> botc

--Looks at top card, counts down that many card and returns the value of that card.
getValue :: Deck -> Int
getValue d = let (top :< rest) = viewl \$ toSeq d
num = (value top) :: Int
in (value \$ index rest (num - 1))

oneStep :: State Deck Int
oneStep = State \$ \d -> let d2 = takeTop . trippleCut . moveB . moveB . moveA \$ d
in (getValue d2, d2)

keyStream :: Deck -> [Int]
keyStream d = let (a,_) = runState (sequence (repeat oneStep)) testdeck
in filter (/= 53) a

encrypt :: String -> [Int] -> String
encrypt code keys = zipWith modChar code keys
where
charVal c = (fromEnum c) - 96
valToChar i = chr (96 + i)
modChar :: Char -> Int -> Char
modChar c i = valToChar \$ (charVal c + i) `mod` 26

decrypt :: String -> [Int] -> String
decrypt code keys = zipWith modChar code keys
where
charVal c = (fromEnum c) - 96
valToChar i = chr (96 + i)
modChar :: Char -> Int -> Char
modChar c i = valToChar \$ (260 + charVal c - i) `mod` 26

--The example from Rubyquiz
testCrypt = "clepkhhniycfpwhfdfeh"
testMess = "yourcipherisworkingx"
-- "unkeyed" deck
testdeck = fromSeq \$ fromList \$ (map Card [1..52]) ++ [A,B]

main = print \$ decrypt testCrypt  (keyStream testdeck)
```