3
\$\begingroup\$

What improvements can I make to the following Pig Latin translator? So far, I've been wondering about the FlexibleInstances declaration, but I can't think of how to remove it (since it's required for PigLatin String in instances, which is required for me to use " " in the Monoid instance; I need the extra type argument for Functor).

{-# LANGUAGE FlexibleInstances #-}

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

data PigLatin a = PigLatin a

instance Monoid (PigLatin String) where
  mempty = PigLatin ""
  mappend (PigLatin a) (PigLatin b) = PigLatin $ a ++ " " ++ b

instance Functor PigLatin where
  fmap f (PigLatin x) = PigLatin $ f x

instance Show (PigLatin String) where
  show (PigLatin s) = s

data English a = English a
  deriving (Eq)

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

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` ['a', 'e', 'i', 'o', 'u']

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

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

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

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

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

You can let it derive the Functor declaration:

data PigLatin a = PigLatin a deriving Functor

foldl mappend mempty <- You want fold.

break implements some of your stuff already.

I wouldn't introduce the types PigLatin a and English a in the first place. They just introduce wrapping without extra type-level structural info.

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

--This turns empty words to yay, but words doesnt send empty words, right?
wordToPig :: String -> String
wordToPig = break (`elem` "aeiou") >>> \(initialConsonants, rest) ->
  rest ++ initialConsonants ++ if null initialConsonants then "yay" else "ay"

-- Your pig latin rules drop the first character of each sentence at the end?
sentenceToPig :: String -> String
sentenceToPig = capitalize . drop 1 . unwords . map wordToPig . words

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

main :: IO ()
main = do
  putStr "> "
  hFlush stdout
  input <- getLine
  when (input /= "\\q") $ do
    print $ sentenceToPig input
    main
\$\endgroup\$
  • \$\begingroup\$ Thanks! fold, however, seems to have different semantics; also, the newtypes are required. \$\endgroup\$ – BalinKingOfMoria Apr 28 '16 at 21:24
  • \$\begingroup\$ It shouldn't matter for foldl mappend mempty, which is associative by Monoid law. That your task assignment requires the newtypes doesn't change that they should not be there; just remember not to use them in this situation if you ever want to write code to actually use. \$\endgroup\$ – Gurkenglas Apr 29 '16 at 7:33

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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