Add missing copyright header + auto-format NumParser.hs

Summary: as title

Reviewed By: yuzh174

Differential Revision: D39996261

fbshipit-source-id: 33902b34db68daefc48c03878b8686236ac9ded3
This commit is contained in:
Julien Odent 2022-10-02 18:33:59 -07:00 committed by Facebook GitHub Bot
parent 9509e042dc
commit 7520daaeba

View File

@ -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