--------------------
-- Sample implementations of Rot13
-- Fritz Ruehr * CS 154 * Fall 2012
--------------------
module Rots where
import Char
rot13 = map rotc1
sample = "This is a message; it is a test, just a test."
--------------------
-- characterwise functions in several different styles
rotc0 c = if isUpper c then (if c <= 'M' then chr (ord c + 13)
else chr (ord c - 13))
else if isLower c then (if c <= 'm' then chr (ord c + 13)
else chr (ord c - 13))
else c
rotc1 c = if 'A' <= c && c <= 'M' then chr (ord c + 13)
else if 'N' <= c && c <= 'Z' then chr (ord c - 13)
else if 'a' <= c && c <= 'm' then chr (ord c + 13)
else if 'n' <= c && c <= 'z' then chr (ord c - 13)
else c
rotc2 c = if 'A' <= c && c <= 'M' then shift 13
else if 'N' <= c && c <= 'Z' then shift (-13)
else if 'a' <= c && c <= 'm' then shift 13
else if 'n' <= c && c <= 'z' then shift (-13)
else c
where shift n = chr (ord c + n)
rotc3 c = if betw 'A' 'M' then shift 13
else if betw 'N' 'Z' then shift (-13)
else if betw 'a' 'm' then shift 13
else if betw 'n' 'z' then shift (-13)
else c
where shift n = chr (ord c + n)
betw x y = x <= c && c <= y
rotc4 c = when 'A' 'M' 13
(when 'N' 'Z' (-13)
(when 'a' 'm' 13
(when 'n' 'z' (-13) c)))
where when x y n z = if x<=c && c<=y then chr (ord c + n) else z
rotc5 c = foldr shift c trips
where shift (x,y,n) z = if x<=c && c<=y then chr (ord c + n) else z
trips = [('A','M',13),('N','Z',-13),('a','m',13),('n','z',-13)]
--------------------
-- testing functions
ptext = "ABCLMNOPXYZ; abclmnopxyz?!"
ctext = "NOPYZABCKLM; nopyzabcklm?!"
test r = map r ptext == ctext && map r ctext == ptext
testall = map test [rotc0,rotc1,rotc2,rotc3,rotc4,rotc5, shupp 13 . shlow 13]
--------------------
-- a version with more reusable parts??
within n m f x = if (x<n || x>m) then x else f x
rel n f = (+n) . f . (\x -> x-n)
addmod k m = (`mod` m) . (+k)
shift n m k = within n m (rel n (addmod k (m-n+1)))
charly sh = chr . sh . ord
shsym a z = charly . shift (ord a) (ord z)
shupp = shsym 'A' 'Z'
shlow = shsym 'a' 'z'
rot k = map (shupp k . shlow k)
--------------------
-- parts tests
{-
map (within 4 7 (^2)) [1..10]
map (rel 5 (*2)) [1..10]
map (shift 4 7 2) [1..10]
map (charly (+3)) ['a'..'z']
map (shsym 'l' 'p' 2) ['a'..'z']
-}
--------------------
-- end of file Rots
--------------------