Skip to content

Commit

Permalink
Add missing copyright header + auto-format NumParser.hs
Browse files Browse the repository at this point in the history
Summary: as title

Reviewed By: yuzh174

Differential Revision: D39996261

fbshipit-source-id: 33902b34db68daefc48c03878b8686236ac9ded3
  • Loading branch information
patapizza authored and facebook-github-bot committed Oct 3, 2022
1 parent 9509e04 commit 7520daa
Showing 1 changed file with 71 additions and 40 deletions.
111 changes: 71 additions & 40 deletions Duckling/Numeral/DE/NumParser.hs
Original file line number Diff line number Diff line change
@@ -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)
Expand All @@ -41,23 +45,29 @@ p .+. p' = (+) <$> p <*> p'
p .*. p' = (*) <$> p <*> p'

infixl 6 .+.

infixl 7 .*.

opt :: NumParser -> NumParser
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

Expand All @@ -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"
Expand All @@ -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"
Expand All @@ -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
Expand All @@ -135,26 +164,28 @@ 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)
| n `mod` 10 == 1 && suffix `elem` inflection = Just n
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

0 comments on commit 7520daa

Please sign in to comment.