=={{header|Haskell}}==
<lang haskell>import Data.List (tails)▼
{{Works with|GHC|7.8.3}}
▲<lang haskell>import Data.List (tails)
, (["fly ", Every, "I.\nI don't know why she swallowed thea fly. \nPerhaps she'll die.\n" )▼
, ("spider ", Once, "That.\nThat wriggledwiggled and jiggled and tickled inside her." )▼
, ("bird ",.\t\nHow Onceabsurd, "Quite absurd. Toto swallow a bird." )▼
, ("cat ", Once, "Fancy.\t\nImagine that. ToShe swallowswallowed a cat." )▼
, ("dog ", Once, "What.\t\nWhat a hog . Toto swallow a dog." )▼
, ("goat ", Once, "She.\t\nShe just opened her throat . Toand swallowswallowed athat goat." )▼
, ("cow ", Once, "I.\nI don't know how . Toshe swallowswallowed athat cow." )▼
[ (,"horse ", Die, "She.\nShe's dead, of course !." )]▼
beginnings = letmap lns = [(" IThere knowwas an old lady who swallowed a " ++ ) anim ++ ".", phrase]animals▼
-- Once means the phrase is only printed in the verse about that animal.
swalloed x let whyy = "She swallowed the " ++ takeWhile prevAnim(/='.') y++ " to catch the " ++ animtakeWhile ++(/='\t') "."x▼
-- Every means the phrase is printed for every verse. It is used for "fly",
lastVerse = tail $ reverse $ zipWith swalloed animals $ tail animals
-- and could optionally be used for "spider", in the version of the song where
main = putStr $ concatMap unlines $ zipWith (:) beginnings $ cycle $ reverse $ tails $ lastVerse</lang>
-- "wriggled and jiggled..." is repeated every verse.
-- Die is only used for the horse, and means the chain of animals won't be
-- included in the verse.
data AnimalAction
= Once
| Every
| Die
▲ [ ("horse", Die, "She's dead, of course!")
, ("donkey", Once, "It was rather wonky. To swallow a donkey.")
▲ , ("cow", Once, "I don't know how. To swallow a cow.")
▲ , ("goat", Once, "She just opened her throat. To swallow a goat.")
, ("pig", Once, "Her mouth was so big. To swallow a pig.")
▲ , ("dog", Once, "What a hog. To swallow a dog.")
▲ , ("cat", Once, "Fancy that. To swallow a cat.")
▲ , ("bird", Once, "Quite absurd. To swallow a bird.")
▲ , ("spider", Once, "That wriggled and jiggled and tickled inside her.")
▲ , ("fly", Every, "I don't know why she swallowed the fly.")
]
verse :: [(String, AnimalAction, String)] -> [String]
verse ((anim, act, phrase):restAnims) =
▲ let lns = ["I know an old lady who swallowed a " ++ anim ++ ".", phrase]
in case act of
Die -> lns
_ -> lns ++ verse' restAnims anim
verse' :: [(String, AnimalAction, String)] -> String -> [String]
verse' [] _ = ["Perhaps she'll die."]
verse' ((anim, act, phrase):restAnims) prevAnim =
▲ let why = "She swallowed the " ++ prevAnim ++ " to catch the " ++ anim ++ "."
lns =
case act of
Every -> [why, phrase]
_ -> [why]
in lns ++ verse' restAnims anim
song :: [String]
song = concatMap verse . tail . reverse $ tails animals
main :: IO ()
main = putStr $ unlines song</lang>
=={{header|Icon}} and {{header|Unicon}}==
|