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
