3
\$\begingroup\$

Thanks to Gurkenglas for the help with the previous iteration: Haskell - Pig Latin Translator!

Given the constraint that the newtypes are required, what improvements could be made to the following Pig Latin translator?

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}

import Control.Monad (when)
import Data.Char (toLower, toUpper)
import System.IO (hFlush, stdout)

newtype PigLatin = PigLatin String

instance Show PigLatin where
  show :: PigLatin -> String
  show (PigLatin x) = x

instance Monoid PigLatin where
  mempty :: PigLatin
  mempty = PigLatin ""

  mappend :: PigLatin -> PigLatin -> PigLatin
  mappend (PigLatin a) (PigLatin b) = PigLatin $ a ++ " " ++ b

plMap :: (String -> String) -> PigLatin -> PigLatin
plMap f (PigLatin x) = PigLatin $ f x

newtype English = English String
  deriving (Eq)

safeTail :: [a] -> [a]
safeTail (_:xs) = xs
safeTail [] = []

quitCommand :: English
quitCommand = English "\\q"

wordToPig :: English -> PigLatin
wordToPig (English word@(x:_)) = PigLatin $ if isVowel x
                                              then word ++ "yay"
                                              else rearrangedWord ++ "ay"
    where rearrangedWord = drop (length initialConsonants) word ++ initialConsonants
          initialConsonants = takeWhile isConsonant word
          isConsonant = not . isVowel
wordToPig (English "") = PigLatin ""

isVowel :: Char -> Bool
isVowel letter = letter `elem` ['a', 'e', 'i', 'o', 'u']

englishWords :: English -> [English]
englishWords (English input) = map English $ words input

sentenceToPig :: English -> PigLatin
sentenceToPig = plMap (capitalize . safeTail) . foldl mappend mempty . map wordToPig . englishWords

capitalize :: String -> String
capitalize (x:xs) = toUpper x : map toLower xs
capitalize [] = ""

putStrNow :: String -> IO ()
putStrNow message = do
  putStr message
  hFlush stdout

prompt :: String -> IO English
prompt promptInput = do
  putStrNow promptInput
  input <- getLine
  return $ English input

main :: IO ()
main = do
    input <- prompt "> "
    when (input /= quitCommand) $ do
      print $ sentenceToPig input
      main
\$\endgroup\$

1 Answer 1

1
\$\begingroup\$

Problem 1: Monoid

One subtle problem here:

instance Monoid PigLatin where
  mempty :: PigLatin
  mempty = PigLatin ""

  mappend :: PigLatin -> PigLatin -> PigLatin
  mappend (PigLatin a) (PigLatin b) = PigLatin $ a ++ " " ++ b

While it may not seem it, this is in fact an invalid Monoid instance. When we write Monoid instances we want certain laws to hold true so we can reason about them more easily. One such law: mappend mempty x = x = mappend x mempty. We want mempty to act as an "identity element" (like adding zero to or multiplying one by an integer). The extra space character makes this impossible. If the Monoid instance had been lawful, we could have replaced foldl mappend mempty with mconcat.

So the first thing I would do is to excise this Monoid instance and instead use unwords, as we'll detail below. This approach has the advantage of letting us delete safeTail.

Problem 2: Slicing and dicing newtypes

The other thing we want to tackle is the problem of lifting String operations into our newtypes. We really want to lift unwords :: [String] -> String to unwords :: [PigLatin] -> [PigLatin]; that would obviate the need for the fold and the Monoid instance altogether. We also want to lift String -> String to PigLatin -> PigLatin, as evidenced by our plMap function. There's a similar problem with englishWords: we have a function String -> [String] but we want English -> [English] Haskell programmers are extraordinarily lazy and so we ask ourselves, how can we do this in the least amount of code possible?.

A common trick is to add a type variable:

newtype PigLatin a = PigLatin a
  deriving (Functor)

newtype English a = English a
  deriving (Eq, Functor, Foldable, Traversable)

This lets us derive instances for Functor, Foldable, and Traversable. It even admits an Applicative instance:

instance Applicative PigLatin where
  pure =
    PigLatin
  (<*>) (PigLatin a2b) (PigLatin a) =
    PigLatin (a2b a)

But why? Let's break down these typeclasses one by one.

Functor

One of our best friends. With Functor, plMap = fmap. The compiler automatically knows how to lift functions of type String -> String to PigLatin String -> PigLatin String. Not having to write any code is the best code there is. In fact, the compiler can even lift any type a -> a to PigLatin a -> PigLatin a even if in the end we only want to deal with PigLatin String values.

Foldable and Traversable

Having these two instances around permits the almight traverse. This humbly named function does something very very useful as it has type (a -> [b]) -> English a -> [English b], which is exactly what we need to lift words up through our English newtype. When we choose to equip English with a Foldable and a Traversable instance we are granted the keys to this wonderful kingdom. The end result is this function

englishWords :: English String -> [English String]
englishWords =
  traverse words

Which is hardly long enough to worth defining!

Applicative

I fibbed earlier as it turns out that traverse actually has type

(Applicative f, Traversable t) => (a -> f b) -> t a -> f (t b)

This unwieldy amalgam of variables and arrows can be broken down thusly. You can choose any types f, t and as long as there's an Applicative f and a Traversable t instance the compiler will do what you please.

Up above we chose f ~ [] (the list type) and t ~ English. What if instead we were to choose f ~ PigLatin and t ~ []? Well then we would have a very interesting function of type (a -> PigLatin b) -> [a] -> PigLatin [b].

Notice that wordToPig has type English String -> PigLatin String, which means traverse wordToPig would have type [English String] -> PigLatin [String], which is exactly what we want. Why?

sentenceToPig :: English String -> PigLatin String
sentenceToPig =
  fmap (capitalize . unwords) . traverse wordToPig . traverse words

Because that allows us to reach for our old friend fmap. capitalize . unwords takes [String] to String, which means when we lift it up with fmap we get a function PigLatin [String] -> PigLatin String. Exactly what we need.

Coercible, the hidden typeclass

One thing you may not be aware of is that GHC generates a Coercible instance for all newtypes. What this means is a little too complicated to go into detail here, but the end result is that you can type coerce (PigLatin "hello") :: String and get back "hello" :: String. Both the "hello" :: String and the PigLatin "hello" :: PigLatin String have the same in-memory representation, as guaranteed by the newtype keyword, and thus this poses no problem for the runtime. I like to use it for short scripts and it's especially handing for printing out newtypes. I noticed you defined a Show instance, and I think that's OK too. But I thought I'd bring it up since it's often overlooked.

Altogether now

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}

import Control.Monad (when)
import Data.Coerce (coerce)
import Data.Char (toLower, toUpper)
import System.IO (hFlush, stdout)

newtype PigLatin a = PigLatin a
  deriving (Functor)

newtype English a = English a
  deriving (Eq, Functor, Foldable, Traversable)

instance Applicative PigLatin where
  pure = PigLatin
  (<*>) (PigLatin a2b) (PigLatin a) = PigLatin (a2b a)

quitCommand :: English String
quitCommand = English "\\q"

wordToPig :: English String -> PigLatin String
wordToPig (English word@(x:_)) =
  PigLatin $ if isVowel x
             then word ++ "yay"
             else rearrangedWord ++ "ay"
  where
    rearrangedWord =
      drop (length initialConsonants) word ++ initialConsonants
    initialConsonants =
      takeWhile isConsonant word
    isConsonant =
      not . isVowel
wordToPig (English "") =
  PigLatin ""

isVowel :: Char -> Bool
isVowel letter = letter `elem` "aeiou"

sentenceToPig :: English String -> PigLatin String
sentenceToPig =
  fmap (capitalize . unwords) . traverse wordToPig . traverse words

capitalize :: String -> String
capitalize (x:xs) = toUpper x : map toLower xs
capitalize [] = ""

putStrNow :: String -> IO ()
putStrNow message = do
  putStr message
  hFlush stdout

prompt :: String -> IO (English String)
prompt promptInput = do
  putStrNow promptInput
  input <- getLine
  return $ English input

main :: IO ()
main = do
  input <- prompt "> "
  when (input /= quitCommand) $ do
    putStrLn . coerce $ sentenceToPig input
    main
\$\endgroup\$
1
  • \$\begingroup\$ Thanks so much! My original approach was to add the type variable, but it would be non-sensical for PigLatin or English to have any type parameter but String, and I'd like to make illegal states unrepresentable (I love that phrase so much). \$\endgroup\$ Apr 28, 2016 at 22:51

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.