patternMinor
Haskell - Pig Latin Translator
Viewed 0 times
translatorlatinpighaskell
Problem
What improvements can I make to the following Pig Latin translator? So far, I've been wondering about the
``
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 "
when (input /= quitCommand
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 "
when (input /= quitCommand
Solution
You can let it derive the Functor declaration:
I wouldn't introduce the types
data PigLatin a = PigLatin a deriving Functorfoldl 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
mainCode Snippets
data PigLatin a = PigLatin a deriving Functorimport 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
mainContext
StackExchange Code Review Q#126187, answer score: 2
Revisions (0)
No revisions yet.