Assignment 2

{-# LANGUAGE FlexibleContexts #-}
module A02 where

import Control.Monad.Writer
import Data.Char
import GHC.Stack
import System.Exit

{- Determine whether a given character is one of the five vowels. (Let's
 not include 'Y'.) It should work for upper- or lower-case characters. -}

isVowel :: Char -> Bool
isVowel c = False

{- Take a string and a character, and if the character is a vowel,
 return the given string. Otherwise return the 'singleton' string
 containing just the vowel. Hint: you should use the 'isVowel'
 function in a guard. -}

replaceVowelWith :: String -> Char -> String
replaceVowelWith s c = "?"

{- Given any value, construct a list that contains exactly two
 occurrences of that value. -}

two :: a -> [a]
two x = []

{- Given any list, duplicate each element in the list, so that (for
 example) [1,2,3] becomes [1,1,2,2,3,3]. Hint: you should try to use
 the 'two' function to do this, and also look into 'map', 'concat',
 and/or 'concatMap'. -}

dupe :: [a] -> [a]
dupe xs = []

{- This is a fun one: take a string, and reverse the order of *words* in
 the string, so that (for example) "in the end" becomes "end the in".
 Hint: look into the functions 'words' and 'unwords'. -}

backTalk :: String -> String
backTalk str = str

{- Given a list containing any type of elements, drop the first and last
 element and return just the "middle" part. So the string "chair"
 would become "hai". Hint: Try to do this using 'take', 'drop', and
 'length'. -}

dropFirstLast :: [a] -> [a]
dropFirstLast xs = xs

{- A "numeronym" is a number-based word. There's an obscure kind of
 numeronym used in some tech communities where long words are
 abbreviated by replacing the middle part with the *number* of
 characters replaced. For example "i18n" is an abbreviation for
 "internationalization" because there are 18 letters between the first
 and last letters. Similarly, "L10n" for "Localization". If the string
 is shorter than three characters, then just leave it alone.

 Big hint: you will need to convert a number (the length of a string)
 into a string; the 'show' function can do this. Also remember that
 (++) joins two strings, or 'concat' can join a list of strings. -}

numeronym :: String -> String
numeronym xs = xs

-- Test program -- don't change anything below

main = runTests $ do

  assertTrue  $ isVowel 'o'
  assertTrue  $ isVowel 'E'
  assertFalse $ isVowel 'k'
  assertTrue  $ all isVowel "AaOoEeUuIi"
  assertFalse $ any isVowel "Rhythm"

  replaceVowelWith "*!" 'A' @?= "*!"
  replaceVowelWith "!*" 'Z' @?= "Z"

  concatMap (replaceVowelWith "!!") "sigmoid" @?= "s!!gm!!!!d"
  concatMap (replaceVowelWith "") "watchful" @?= "wtchfl"

  two 3 @?= [3,3]
  two 'z' @?= "zz"

  dupe "zebra" @?= "zzeebbrraa"
  dupe "" @?= ""
  dupe "$" @?= "$$"

  backTalk "one two three" @?= "three two one"
  backTalk "lion eats lamb" @?= "lamb eats lion"
  backTalk "" @?= ""
  backTalk "zed" @?= "zed"

  dropFirstLast "travel" @?= "rave"
  dropFirstLast [1..5] @?= [2,3,4]
  dropFirstLast "XY" @?= ""
  dropFirstLast "Z" @?= ""
  dropFirstLast "" @?= ""

  numeronym "internationalization" @?= "i18n"
  numeronym "accessibility" @?= "a11y"
  numeronym "crowded" @?= "c5d"
  numeronym "Ten" @?= "T1n"
  numeronym "so" @?= "so"
  numeronym "x" @?= "x"
  numeronym "" @?= ""

-- Test framework -- don't change anything below

infix  1 @?~, @?=

type TestM = WriterT (Sum Int) IO

runTests :: TestM () -> IO ()
runTests tests = do
  numFails <- getSum <$> execWriterT tests
  when (numFails > 0) $ exitWith (ExitFailure numFails)

(@?~) :: (HasCallStack, Fractional a, Ord a, Show a)
  => a -> a -> TestM ()
(@?~) a1 a2 =
  testBinRel callStack "~="
  (\a b -> abs (a-b) <= 0.00001) a1 a2

(@?=) :: (HasCallStack, Eq a, Show a) => a -> a -> TestM ()
(@?=) a1 a2 =
  testBinRel callStack "==" (==) a1 a2

assertTrue :: HasCallStack => Bool -> TestM ()
assertTrue expr =
  testReport callStack expr "expected true"

assertFalse :: HasCallStack => Bool -> TestM ()
assertFalse expr =
  testReport callStack (not expr) "expected false"

testBinRel stack repr predicate a1 a2 =
  testReport stack (predicate a1 a2)
  (unwords [show a1, repr, show a2])

testReport stack pass descr = do
  unless pass (tell (Sum 1))
  lift . putStrLn $ unwords
    [ if pass then " OK " else "FAIL"
    , "line"
    , getLineNum stack
    , ":"
    , descr
    ]

getLineNum stack =
  case getCallStack stack of
    [] -> "?"
    (_, loc):_ -> show (srcLocStartLine loc)