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