gistfile1.hs

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Token
import Text.ParserCombinators.Parsec.Language (emptyDef)


-- User input should always be on one line. It'll have three distinct parts:
userInput :: Parser (Amount, String, [String])
userInput = do{ gq <- (genericQuantifier <|> return (Serving, 1))
              ; skipMany space
              ; sq <- specificQuantifier
              ; skipMany space
              ; ql <- qualifier
              ; return ((gq, sq, ql))
              } 


word :: Parser String
word = do{ word <- many1 letter
         ; skipMany separator
         ; return word
         } 

separator :: Parser ()
separator = skipMany1 (space <|> char ',' <|> char '-')

genericQuantifier :: Parser Amount
genericQuantifier = return (Serving, 1)

specificQuantifier :: Parser String
specificQuantifier = sizeSpecifier



-- A qualifier will always come at the end of a phrase, and can accept any word. 
qualifier :: Parser [String]
qualifier = sepBy1 word separator


data BaseUnit = Gram | Litre | Serving
                deriving (Show, Eq)


type Amount = (BaseUnit, Float) 


tryString :: String -> a -> Parser a
tryString s v = try (string s >> return v) 

tryChar :: Char -> a -> Parser a
tryChar s v = try (char s >> return v)

abbreviatedMetricPrefix :: Parser Float
abbreviatedMetricPrefix =
        (char 'M' >> return 1000000)
    <|> (char 'K' >> return 1000)
    <|> (char 'k' >> return 1000)
    <|> (char 'h' >> return 100)
    <|> (char 'D' >> return 10)
    <|> (char 'd' >> return 0.1)
    <|> (char 'c' >> return 0.01)
    <|> (char 'm' >> return 0.001)
    <|> (char 'u' >> return 0.000001)
    <|> (char 'n' >> return 0.000000001)
    <?> "abbreviated metric prefix"


abbreviatedPrefixableUnit :: Parser Amount
abbreviatedPrefixableUnit = 
        (char 'L' >> return (Gram, 1))
    <|> (char 'g' >> return (Gram, 1))
    <?> "abbreviated prefixable unit"

abbreviatedPrefixedUnit :: Parser Amount
abbreviatedPrefixedUnit =
    do
      prefix <- abbreviatedMetricPrefix
      unit   <- abbreviatedPrefixableUnit
      return (fst unit, prefix * snd unit)
    <?> "abbreviated prefixed unit"


abbreviatedNonPrefixableUnit :: Parser Amount
abbreviatedNonPrefixableUnit =
    --  Mass/Weight-based -------------------
        tryString "lb"   (Gram, 453.59237)
    <|> tryString "g"    (Gram, 1)
    --  Volume-based ------------------------
    <|> tryString "tsp"  (Litre, 0.005)
    <|> tryString "tbsp" (Litre, 0.029573530)
    <|> tryString "l"    (Litre, 1)
    <|> tryString "qt"   (Litre, 0.946352946)
    <|> tryString "pt"   (Litre, 0.473176473)
    <|> tryString "gal"  (Litre, 3.78541178)
    <|> tryString "c"    (Litre, 0.236588236)
    <?> "abbreviated non-prefixable unit"

-- TODO: Parse "extra"
sizeSpecifier :: Parser String
sizeSpecifier =
        (string "regular" >> return "regular") 
    <|> (string "medium"  >> return "medium") 
    <|> (string "large"   >> return "large") 
    <|> (string "small"   >> return "small") 
    <?> "size specifier"

numberWord :: Parser Int
numberWord =
        tryString "one"         1
    <|> tryString "two"         2
    <|> tryString "three"       3
    <|> tryString "four"        4
    <|> tryString "five"        5
    <|> tryString "six"         6
    <|> tryString "seven"       7
    <|> tryString "eight"       8
    <|> tryString "nine"        9
    <|> tryString "ten"        10
    <|> tryString "eleven"     11
    <|> tryString "twelve"     12
    <|> tryString "thirteen"   13
    <|> tryString "fourteen"   14
    <|> tryString "fifteen"    15
    <|> tryString "sixteen"    16
    <|> tryString "seventeen"  17
    <|> tryString "eighteen"   18
    <|> tryString "nineteen"   19
    <|> tryString "twenty"     20
    <|> tryString "thirty"     30
    <|> tryString "forty"      40
    <|> tryString "fifty"      50
    <|> tryString "sixty"      60
    <|> tryString "seventy"    70
    <|> tryString "eighty"     80
    <|> tryString "ninety"     90
    <|> tryString "hundred"   100
    <|> tryString "thousand" 1000
    <?> "number word"


modifier :: Parser Float
modifier =
        tryString "dozen"     12
    <|> tryString "several"   5
    <|> tryString "bunch"     7
    <|> tryString "few"       3
    <|> tryString "couple"    2
    <|> tryString "half"      0.5
    <|> tryString "third"     0.333333333
    <|> tryString "quarter"   0.25
    <|> tryString "fifth"     0.2
    <|> tryString "sixth"     0.166666667
    <|> tryString "seventh"   0.142857143
    <|> tryString "eigth"     0.125
    <|> tryString "ninth"     0.111111111
    <|> tryString "tenth"     0.1
    <|> tryString "twelfth"   0.083333333
    <|> tryString "fifteenth" 0.066666667
    <|> tryString "twentieth" 0.05
    <|> tryString "thirtieth" 0.033333333
    <|> tryString "fiftieth"  0.02
    <|> tryString "hundredth" 0.01
    <?> "modifier"


unit :: Parser Amount
unit =   try nonPrefixableUnit
    <|> try prefixedUnit
    <|> try prefixableUnit
    <?> "unit"


prefixedUnit :: Parser Amount
prefixedUnit = 
    do
      prefix <- metricPrefix
      unit   <- prefixableUnit
      return (fst unit, prefix * snd unit)
    <?> "prefixed unit"


prefixableUnit :: Parser Amount
prefixableUnit = 
        tryString "gram"  (Gram, 1)
    <|> tryString "litre" (Litre, 1)
    <?> "prefixable unit"


nonPrefixableUnit :: Parser Amount
nonPrefixableUnit =  
    --  Mass/Weight-based --------------------------------------
        tryString "pound"      (Gram, 453.59237)
    --  Volume-based -------------------------------------------
    <|> tryString "tablespoon" (Litre, 0.015)
    <|> tryString "teaspoon"   (Litre, 0.005)
    <|> tryString "glass"      (Litre, 0.250)
    <|> tryString "bottle"     (Litre, 0.341)
    <|> tryString "can"        (Litre, 0.335)
    <|> tryString "hogshead"   (Litre, 238.480942)
    <|> tryString "quart"      (Litre, 0.946352946)
    <|> tryString "pint"       (Litre, 0.473176473)
    <|> tryString "gallon"     (Litre, 3.78541178)
    <|> tryString "cup"        (Litre, 0.236588236)
    <|> tryString "handful"    (Litre, 0.059147059)
    <|> tryString "ounce"      (Litre, 0.029573530)
    --  Hand-wave-based ----------------------------------------
    <|> tryString "serving"    (Serving, 1)
    <|> tryString "helping"    (Serving, 1)
    <|> tryString "some"       (Serving, 1) --
    <|> tryString "bit"        (Serving, 1) -- Pretty sketch
    <|> tryString "little"     (Serving, 1) -- estimates. Meh
    <|> tryString "lot"        (Serving, 1) --
    <?> "non-prefixable unit"


metricPrefix :: (Fractional n) => Parser n
metricPrefix =   
        tryString "mega"  1000000
    <|> tryString "kilo"  1000
    <|> tryString "hecto" 100
    <|> tryString "deca"  10
    <|> tryString "deci"  0.1
    <|> tryString "centi" 0.01
    <|> tryString "milli" 0.001
    <|> tryString "micro" 0.000001
    <|> tryString "nano"  0.000000001
    <?> "metric prefix"