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

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