iso3166-country-codes-0.1: Data/ISO3166_CountryCodes.preamble.hs

{- | Two letter Country Codes

     Defines the type CountryCode with constructors for each
     of the two-letter codes defined in
     <http://www.iso.org/iso/iso3166_en_code_lists.txt> and
     instances for 'Eq', 'Read', 'Show', 'Enum', 'Bounded'
     and 'Ord'.

     Also defines @'countryNameFromCode'@, which gives the
     official short country name all in uppercase and
     @'readableCountryName'@, which produces somewhat more user-friendly output

     Intended to be imported qualified as some country codes
     are the same as some standard Haskell constructors.

-}
module Data.ISO3166_CountryCodes
    (CountryCode(..),
     countryNameFromCode,
     readableCountryName
    ) where
import qualified Prelude as P
import Prelude ((.),not,(==),otherwise,(&&),(==),(/=))
import Control.Monad
import Data.Char
import Data.List

{- | A human readable version of the official name of a country
     from its country code

     Uses some ad-hockery to rearrange the order of the words.

-}
readableCountryName :: CountryCode -> String

readableCountryName
    = concat . intersperse " " . rearrange . fmap up1 . words .
      countryNameFromCode
      where up1 [] = []
            up1 (c:rest) | not (isAlpha c) = c:up1 rest
            up1 "OF" = "of"
            up1 "THE" = "the"
            up1 "AND" = "and"
            up1 "U.S." = "US" -- gawd
            up1 ('M':'C':l) = "Mc"++up1 l -- Don't do MacEdonia!
                                          -- but there are no Mac_ countries yet
            up1 ('D':'\'':l) = "d'"++up1 l
            up1 (c:cs) = toUpper c: downup cs
            downup [] = [] -- needed for hyphenated names
            downup (c:cs) | c=='-' = c:up1 cs
                          | otherwise = toLower c:downup cs
            rearrange [] = []
            rearrange [c] = [c]
            rearrange ll@(n:l)
                | last l `elem` ["of", "the"] && last n == ','
                    = onhead up1 l++[[c|c<-n,c/=',']]
                | otherwise = ll
            onhead f [] = []
            onhead f (h:r) = f h:r
{- Copyright © 2010 Jón Fairbairn
-}