diff --git a/Duckling/Numeral/DE/NumParser.hs b/Duckling/Numeral/DE/NumParser.hs index 0c4141cf..4e3762d4 100644 --- a/Duckling/Numeral/DE/NumParser.hs +++ b/Duckling/Numeral/DE/NumParser.hs @@ -1,32 +1,36 @@ +-- Copyright (c) 2016-present, Facebook, Inc. +-- All rights reserved. +-- +-- This source code is licensed under the BSD-style license found in the +-- LICENSE file in the root directory of this source tree. {-# LANGUAGE DeriveFunctor #-} module Duckling.Numeral.DE.NumParser (parseNumeral) where -import Prelude import Control.Applicative import Data.Char -import Data.List import Data.Foldable +import Data.List import Data.String +import Prelude -newtype Parser a - = Parser { runParser :: String -> Maybe (a, String) } - deriving Functor +newtype Parser a = Parser {runParser :: String -> Maybe (a, String)} + deriving (Functor) char :: Char -> Parser Char char c = Parser p where p [] = Nothing - p (x:xs) - | x == c = Just (x, xs) + p (x : xs) + | x == c = Just (x, xs) | otherwise = Nothing instance Applicative Parser where pure a = Parser (\s -> Just (a, s)) (Parser fp) <*> xp = Parser $ \s -> case fp s of - Nothing -> Nothing - Just (f,s') -> runParser (f <$> xp) s' + Nothing -> Nothing + Just (f, s') -> runParser (f <$> xp) s' instance Alternative Parser where empty = Parser (const Nothing) @@ -41,6 +45,7 @@ p .+. p' = (+) <$> p <*> p' p .*. p' = (*) <$> p <*> p' infixl 6 .+. + infixl 7 .*. opt :: NumParser -> NumParser @@ -48,16 +53,21 @@ opt p = p <|> Parser p' where p' s = Just (0, s) -data NumItem = NumItem { base :: NumParser - , plus10 :: NumParser - , times10 :: [NumParser] - } +data NumItem = NumItem + { base :: NumParser + , plus10 :: NumParser + , times10 :: [NumParser] + } defaultNumItem :: Integer -> String -> NumItem -defaultNumItem value form = NumItem { base = p - , plus10 = p .+. ten - , times10 = [p .*. ty] - } where p = assign value form +defaultNumItem value form = + NumItem + { base = p + , plus10 = p .+. ten + , times10 = [p .*. ty] + } + where + p = assign value form type Assignment = Integer -> String -> NumParser @@ -80,15 +90,27 @@ und :: NumParser und = assign 0 "und" one :: NumItem -one = (defaultNumItem 1 "ein") { plus10 = assign 11 "elf" - , times10 = [ ten ] } +one = + (defaultNumItem 1 "ein") + { plus10 = assign 11 "elf" + , times10 = [ten] + } two :: NumItem -two = (defaultNumItem 2 "zwei") { plus10 = assign 12 "zwölf" - , times10 = [ assign 20 "zwanzig" ] } +two = + (defaultNumItem 2 "zwei") + { plus10 = assign 12 "zwölf" + , times10 = [assign 20 "zwanzig"] + } + three :: NumItem -three = (defaultNumItem 3 "drei") { times10 = [ assign 30 "dreißig" - , assign 30 "dreissig" ] } +three = + (defaultNumItem 3 "drei") + { times10 = + [ assign 30 "dreißig" + , assign 30 "dreissig" + ] + } four :: NumItem four = defaultNumItem 4 "vier" @@ -97,12 +119,18 @@ five :: NumItem five = defaultNumItem 5 "fünf" six :: NumItem -six = (defaultNumItem 6 "sechs") { plus10 = assign 16 "sechzehn" - , times10 = [ assign 60 "sechzig" ] } +six = + (defaultNumItem 6 "sechs") + { plus10 = assign 16 "sechzehn" + , times10 = [assign 60 "sechzig"] + } seven :: NumItem -seven = (defaultNumItem 7 "sieben") { plus10 = assign 17 "siebzehn" - , times10 = [ assign 70 "siebzig" ] } +seven = + (defaultNumItem 7 "sieben") + { plus10 = assign 17 "siebzehn" + , times10 = [assign 70 "siebzig"] + } eight :: NumItem eight = defaultNumItem 8 "acht" @@ -120,10 +148,11 @@ tensFrom20 :: NumParser tensFrom20 = asum (concatMap times10 (tail digitLexicon)) from1to99 :: NumParser -from1to99 = opt (from1to9 .+. und) .+. tensFrom20 - <|> foldr ((<|>) . plus10) empty digitLexicon - <|> ten - <|> from1to9 +from1to99 = + opt (from1to9 .+. und) .+. tensFrom20 + <|> foldr ((<|>) . plus10) empty digitLexicon + <|> ten + <|> from1to9 from1to999 :: NumParser from1to999 = opt (from1to9 .*. hundred .+. opt und) .+. opt from1to99 @@ -135,18 +164,20 @@ from1to999999' :: NumParser from1to999999' = Parser p where p s - | isPrefixOf "hundert" s || isPrefixOf "tausend" s - = runParser from1to999999 ("ein" ++ s) - | otherwise - = runParser from1to999999 s + | isPrefixOf "hundert" s || isPrefixOf "tausend" s = + runParser from1to999999 ("ein" ++ s) + | otherwise = + runParser from1to999999 s fromYear1100to1999 :: NumParser -fromYear1100to1999 = asum ((\n -> plus10 n .*. hundred) <$> digitLexicon) - .+. opt (opt und .+. from1to99) +fromYear1100to1999 = + asum ((\n -> plus10 n .*. hundred) <$> digitLexicon) + .+. opt (opt und .+. from1to99) allNumerals :: NumParser -allNumerals = fromYear1100to1999 - <|> from1to999999' +allNumerals = + fromYear1100to1999 + <|> from1to999999' removeInflection :: (Integer, String) -> Maybe Integer removeInflection (n, suffix) @@ -154,7 +185,7 @@ removeInflection (n, suffix) where inflection = ["s", "e", "em", "en", "er", "es"] removeInflection (n, "") = Just n -removeInflection _ = Nothing +removeInflection _ = Nothing parseNumeral :: String -> Maybe Integer parseNumeral s = removeInflection =<< runParser allNumerals s