# Assignment 3

due

{-# LANGUAGE FlexibleContexts #-} module A03 where import Control.Monad.Writer import Data.Char import GHC.Stack import System.Exit -- The idea of "splitFirst" is that it takes a list and returns a pair -- of lists. The first list is a singleton containing the first element -- of the parameter. The second list is all the remaining elements. -- (But if the original list is empty, both returned lists are empty.) -- Concatenating the pair should always produce the original list; that -- is, if splitFirst xs == (as, bs) then xs == as ++ bs. -- Try to write THREE different versions of the function, that all have -- the same behavior. I used take/drop for V1, splitAt for V2, and -- head/tail for V3, but yours can be different. splitFirstV1 :: [a] -> ([a], [a]) splitFirstV1 xs = (xs, xs) splitFirstV2 :: [a] -> ([a], [a]) splitFirstV2 xs = (xs, xs) splitFirstV3 :: [a] -> ([a], [a]) splitFirstV3 xs = (xs, xs) ------------------------------------------------------------------ -- Similarly, "splitLast" returns a pair of lists, where the first list -- contains all the elements UP TO the last one, and the second list is -- a singleton containing the last element. Again, it should just -- produce empty lists when the original is empty, and concatenating -- the pair should always produce the original list. -- Try three versions of this as well. I used splitAt for V1, init/last -- for V2, and reverse along with splitFirst (any version) for V3! splitLastV1 :: [a] -> ([a], [a]) splitLastV1 xs = (xs, xs) splitLastV2 :: [a] -> ([a], [a]) splitLastV2 xs = (xs, xs) splitLastV3 :: [a] -> ([a], [a]) splitLastV3 xs = (xs, xs) ------------------------------------------------------------------ -- Now, use (any version of) splitFirst and splitLast to create -- splitFirstLast, that returns a tuple of three lists. splitFirstLast :: [a] -> ([a], [a], [a]) splitFirstLast xs = (xs, xs, xs) -- This should produce the same behavior as dropFirstLast in assignment -- two, but implement it using splitFirstLast. dropFirstLast :: [a] -> [a] dropFirstLast xs = xs -- This should produce the same behavior as numeronym in assignment -- two, but implement it using splitFirstLast. numeronym :: String -> String numeronym xs = xs ------------------------------------------------------------------ -- Test program -- don't change anything below main = runTests $ do -- Test all splitFirst versions forM_ (zip [1..] [splitFirstV1, splitFirstV2, splitFirstV3]) $ \(n,f) -> do lift . putStrLn $ "~~~~ splitFirstV" ++ show n ++ " ~~~~" f "abc" @?= ("a", "bc") f "ab" @?= ("a", "b") f "a" @?= ("a", "") f "" @?= ("", "") -- Test all splitLast versions forM_ (zip [1..] [splitLastV1, splitLastV2, splitLastV3]) $ \(n,f) -> do lift . putStrLn $ "~~~~ splitLastV" ++ show n ++ " ~~~~" f "abc" @?= ("ab", "c") f "ab" @?= ("a", "b") f "a" @?= ("", "a") f "" @?= ("", "") lift $ putStrLn "~~ splitFirstLast ~~" splitFirstLast "travel" @?= ("t", "rave", "l") splitFirstLast [1..5] @?= ([1], [2,3,4], [5]) splitFirstLast "XY" @?= ("X", "", "Y") splitFirstLast "Z" @?= ("Z", "", "") splitFirstLast "" @?= ("", "", "") lift $ putStrLn "~~ dropFirstLast ~~" dropFirstLast "travel" @?= "rave" dropFirstLast [1..5] @?= [2,3,4] dropFirstLast "XY" @?= "" dropFirstLast "Z" @?= "" dropFirstLast "" @?= "" lift $ putStrLn "~~ numeronym ~~" 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)