Haskell program with basic CLI parsing, file reading, and decoding file contents into specified types

Question

I recently completed the following exercise, but wanted some feedback on how idiomatic etc. my haskell program is. This is from a course which introduces us to file IO before we cover the theory of monads, so my monad-knowledge is still in its infancy. Any feedback much appreciated.

Here's the task:

In StudentTeacher.hs, observe that we have an old version of our Person type with the Student and Teacher constructor. Fill in studentTeacherBasic so that it will use arguments to determine the right type of person. If the arguments contain -s or --student, read two lines, for name and age, and make a student. If there is -t or --teacher, read two lines for the name and department. If there are no arguments, print:

Please specify the type of person!

Print the resulting person otherwise.

Fill in studentTeacherAdvanced, which should have the same result as your basic version, but read its input differently. Take a file name as the first argument. If it ends in .student, read lines from the file assuming they contain a student's information. If it’s .teacher, assume a teacher. Print the same failure message in any other case.

Here's my answer:

module StudentTeacher where
import Data.List.Split (splitOn)
import Text.Read (readMaybe)
import System.IO (openFile, withFile, IOMode(..), hGetLine, hGetContents, Handle, stdin)
import System.Environment (getArgs)
import Data.Maybe (isNothing)
data Person =
 Student String Int |
 Teacher String String
 deriving (Show)
type PersonDecoder = String -> Maybe Person
type CLIParser = [String] -> Maybe (PersonDecoder, (IO Handle))
studentTeacher :: CLIParser -> IO ()
studentTeacher cliparser = do
 arguments <- getArgs
 maybePerson <- case (cliparser arguments) of
 Nothing -> return Nothing
 Just (decoder, getHandle) -> do
 handle <- getHandle
 decodePersonFromHandle decoder handle
 case maybePerson of
 Nothing -> putStrLn "Please specify the type of person"
 Just person -> print person
studentTeacherBasic :: IO ()
studentTeacherBasic = studentTeacher parseArgsFlag
decodePersonFromHandle :: PersonDecoder -> Handle -> IO (Maybe Person)
decodePersonFromHandle decoder handle = do
 line1 <- hGetLine handle
 line2 <- hGetLine handle
 return $ decoder $ line1 ++ "\n" ++ line2
parseArgsFlag :: CLIParser
parseArgsFlag [] = Nothing
parseArgsFlag ("-t":_) = Just (decodeTeacher, wrapStdIn)
parseArgsFlag ("-s":_) = Just (decodeStudent, wrapStdIn)
parseArgsFlag ("--teacher":_) = parseArgsFlag ["-t"]
parseArgsFlag ("--student":_) = parseArgsFlag ["-s"]
wrapStdIn :: IO Handle
wrapStdIn = do
 return stdin
decodeTeacher :: PersonDecoder
decodeTeacher encoded =
 case lines of [] -> Nothing
 [_] -> Nothing
 (name:dept:_) -> Just (Teacher name dept)
 where lines = splitOn "\n" encoded
decodeStudent :: PersonDecoder
decodeStudent encoded =
 case lines of [] -> Nothing
 [_] -> Nothing
 (name:age:_) -> decodeStudentLines name age
 where lines = splitOn "\n" encoded
decodeStudentLines :: String -> String -> Maybe Person
decodeStudentLines name age =
 case decodedAge of Nothing -> Nothing
 (Just ageInt) -> Just (Student name ageInt)
 where decodedAge = readMaybe age :: Maybe Int
studentTeacherAdvanced :: IO ()
studentTeacherAdvanced = studentTeacher parseArgsSuffix
parseArgsSuffix :: CLIParser
parseArgsSuffix [] = Nothing
parseArgsSuffix (fname:_) =
 if hasSuffix fname "student" then Just (decodeStudent, openFile fname ReadMode)
 else if hasSuffix fname "teacher" then Just (decodeTeacher, openFile fname ReadMode)
 else Nothing
hasSuffix :: String -> String -> Bool
hasSuffix filename suffix = if length components == 0 || length components == 1
 then False
 else last components == suffix
 where
 components = splitOn "." filename

• arrowd: You can use great hackage.haskell.org/package/optparse-applicative library for option parsing.

Answer 1

First things first: great work on adding a type signature on every function. Now, let's see how we can improve the code.

Use interesting case first, others later

When we pattern match in a binding or in a case expression, it's often easier to start with the interesting case first and then handle the Error cases:

decodeTeacher :: PersonDecoder
decodeTeacher encoded =
 case lines of (name:dept:_) -> Just (Teacher name dept)
 _ -> Nothing
 where lines = splitOn "\n" encoded
decodeStudent :: PersonDecoder
decodeStudent encoded =
 case lines of (name:age:_) -> decodeStudentLines name age
 _ -> Nothing
 where lines = splitOn "\n" encoded

Check the standard library for already existing functionality

We stay at those functions. The name lines is very unfortunate, as there is already a lines in the Prelude. It's a function with the following signature:

lines :: String -> [String]

With that function, we can get rid of splitOn:

decodeTeacher :: PersonDecoder
decodeTeacher encoded =
 case lines encoded of
 (name:dept:_) -> Just (Teacher name dept)
 _ -> Nothing
decodeStudent :: PersonDecoder
decodeStudent encoded =
 case lines encoded of
 (name:age:_) -> decodeStudentLines name age
 _ -> Nothing

Prefer simpler logic where possible

Next, we have a look at parseArgsSuffix:

parseArgsSuffix :: CLIParser
parseArgsSuffix [] = Nothing
parseArgsSuffix (fname:_) =
 if hasSuffix fname "student" then Just (decodeStudent, openFile fname ReadMode)
 else if hasSuffix fname "teacher" then Just (decodeTeacher, openFile fname ReadMode)
 else Nothing

That's a rather long if expression. A guard may be easier to read and handle:

parseArgsSuffix :: CLIParser
parseArgsSuffix [] = Nothing
parseArgsSuffix (fname:_)
 | fname `hasSuffix` "student" = Just (decodeStudent, openFile fname ReadMode)
 | fname `hasSuffix` "teacher" = Just (decodeTeacher, openFile fname ReadMode)
 | otherwise = Nothing

Note that we should keep the uninteresting case here first, as it improves readability. However, we're repeating ourselves. Something along

parseArgsSuffix :: CLIParser
parseArgsSuffix [] = Nothing
parseArgsSuffix (fname:_)
 | fname `hasSuffix` "student" = decodeVia decodeStudent 
 | fname `hasSuffix` "teacher" = decodeVia decodeTeacher
 | otherwise = Nothing
 where
 decodeVia f = Just (f, openFile fname ReadMode)

might reduce the duplication. Now, let's have a look at hasSuffix:

hasSuffix :: String -> String -> Bool
hasSuffix filename suffix = if length components == 0 || length components == 1
 then False
 else last components == suffix
 where
 components = splitOn "." filename

Again, splitOn is an overkill here. We only want to know if our filename ends with the given extension. The function isSuffixOf from Data.List handles that fine:

hasSuffix :: String -> String -> Bool
hasSuffix filename suffix = ('.' : suffix) `isSuffixOf` filename

We could probably even remove hasSuffix completely that way.

Make sure that functions are total

parseArgsFlag is partial. If we use parseArgsFlags on ["whoops!", "-t"], then none of the patterns match:

parseArgsFlag :: CLIParser
parseArgsFlag [] = Nothing
parseArgsFlag ("-t":_) = Just (decodeTeacher, wrapStdIn)
parseArgsFlag ("-s":_) = Just (decodeStudent, wrapStdIn)
parseArgsFlag ("--teacher":_) = parseArgsFlag ["-t"]
parseArgsFlag ("--student":_) = parseArgsFlag ["-s"]

If that is intended, then everything is fine. However, if you want to handle those cases, then add a match all pattern:

parseArgsFlag _ = Nothing

I would prefer something like this, by the way:

parseArgsFlag :: CLIParser
parseArgsFlag args
 | any (`elem` args) ["-t", "--teacher"] = Just (decodeTeacher, wrapStdIn)
 | any (`elem` args) ["-s", "--student"] = Just (decodeStudent, wrapStdIn)
 | otherwise = Nothing