chitauri (empty) → 0.1.0.0

raw patch · 10 files changed

+264/−0 lines, 10 filesdep +basedep +chitauridep +digitssetup-changed

Dependencies added: base, chitauri, digits, either-unwrap, generic-trie, haskeline, parsec

Files

LICENSE +30/−0
Setup.hs +2/−0
app/Main.hs +44/−0
chitauri.cabal +52/−0
src/MajorSystem.hs +27/−0
src/Parser.hs +47/−0
src/Phoneme.hs +46/−0
src/PhoneticDictionary.hs +7/−0
src/PhoneticWord.hs +7/−0
test/Spec.hs +2/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ app/Main.hs view

@@ -0,0 +1,44 @@+module Main where++import Parser (parseDictionary, dictionary)+import PhoneticWord (PhoneticWord(..))+import PhoneticDictionary (PhoneticDictionary)++import qualified Data.GenericTrie as T+import qualified System.Console.Haskeline as H+import Data.Either.Unwrap (fromRight)+import Text.Read (readMaybe)+import Data.Char (digitToInt, isDigit)+import Data.Maybe (fromMaybe)++main :: IO ()+main = do+  dict <- dictionary+  let parsed = parseDictionary dict+  case parseDictionary dict of+    Left a -> print a+    Right a -> mainLoop a++mainLoop dict = H.runInputT H.defaultSettings loop+  where+    loop :: H.InputT IO ()+    loop = do+      minput <- H.getInputLine "> "+      case minput of+        Nothing -> return ()+        Just "quit" -> return ()+        Just input -> do+          H.outputStrLn . formatPhoneticWords . findWords dict $ stringToDigits input+          loop++stringToDigits :: String -> [Int]+stringToDigits = fmap digitToInt . filter isDigit++formatPhoneticWords :: [PhoneticWord] -> String+formatPhoneticWords pWords = unlines $ zipWith formatPhoneticWord pWords [0..]+  where+    formatPhoneticWord :: PhoneticWord -> Int -> String+    formatPhoneticWord pWord i = show i ++ ") " ++ word pWord ++findWords :: PhoneticDictionary -> [Int] -> [PhoneticWord]+findWords dict ds = fromMaybe [] $ T.lookup ds dict

+ chitauri.cabal view

@@ -0,0 +1,52 @@+name:                chitauri+version:             0.1.0.0+synopsis:            Initial project template from stack+description:         Please see README.md+homepage:            https://github.com/githubuser/chitauri#readme+license:             BSD3+license-file:        LICENSE+author:              Author name here+maintainer:          example@example.com+copyright:           2016 Author name here+category:            Web+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Parser,+                       Phoneme,+                       PhoneticDictionary,+                       PhoneticWord,+                       MajorSystem+  build-depends:       base >= 4.7 && < 5,+                       parsec,+                       generic-trie,+                       either-unwrap+  default-language:    Haskell2010++executable chitauri+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base,+                       chitauri,+                       either-unwrap,+                       generic-trie,+                       haskeline,+                       digits+  default-language:    Haskell2010++test-suite chitauri-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , chitauri+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/githubuser/chitauri

+ src/MajorSystem.hs view

@@ -0,0 +1,27 @@+module MajorSystem where++import Phoneme++phonemeToNumber :: Phoneme -> Maybe Int+phonemeToNumber S  = Just 0+phonemeToNumber Z  = Just 0+phonemeToNumber D  = Just 1+phonemeToNumber T  = Just 1+phonemeToNumber TH = Just 1+phonemeToNumber N  = Just 2+phonemeToNumber M  = Just 3+phonemeToNumber ER = Just 4+phonemeToNumber R  = Just 4+phonemeToNumber L  = Just 5+phonemeToNumber CH = Just 6+phonemeToNumber JH = Just 6+phonemeToNumber SH = Just 6+phonemeToNumber ZH = Just 6+phonemeToNumber G  = Just 7+phonemeToNumber K  = Just 7+phonemeToNumber F  = Just 8+phonemeToNumber V  = Just 8+phonemeToNumber B  = Just 9+phonemeToNumber P  = Just 9+phonemeToNumber NG = Just 27+phonemeToNumber _  = Nothing

+ src/Parser.hs view

@@ -0,0 +1,47 @@+module Parser where++import Text.Parsec.Char (endOfLine)+import Text.ParserCombinators.Parsec.Char (anyChar, upper, digit)+import Text.Parsec (lookAhead, manyTill, skipMany, many, many1, oneOf, parse, char, sepBy, endBy, (<|>))+import Text.Parsec.Error (ParseError)+import Data.GenericTrie (fromListWith)+import Data.Maybe (catMaybes)+import Data.Char (toLower, toUpper)+import Data.List (sortBy)+import Data.Ord (compare)+import Data.Function (on)++import PhoneticDictionary (PhoneticDictionary)+import Phoneme (charsToPhoneme)+import PhoneticWord (PhoneticWord(..))+import MajorSystem(phonemeToNumber)++parseDictionary :: String -> Either ParseError PhoneticDictionary+parseDictionary dict = do+  let wordsOrError = parse parser "Failure" dict+  wordsToDictionary <$> wordsOrError++wordsToDictionary ws = fromListWith combineEntries $ fmap wordToTuple ws+  where+    wordToTuple pWord = (catMaybes $ phonemeToNumber <$> phonemes pWord, [pWord])+    combineEntries :: [PhoneticWord] -> [PhoneticWord] -> [PhoneticWord]+    combineEntries xs ys = sortBy (compare `on` (length . word)) $ xs ++ ys++dictionary :: IO String+dictionary = readFile "assets/dict.txt"++phonemesParser = many1 (char ' ') *> sepBy phonemeParser (char ' ') +phonemeParser = many1 upper <* skipMany digit+wordParser = garbageParser *> (fixCase <$> manyTill anyChar (lookAhead $ char ' '))+garbageParser = many $ oneOf "?!@#$%^&*().,'><\"+=-_][}{/':; " <|> digit++fixCase :: String -> String+fixCase (x:xs) = toUpper x : map toLower xs+fixCase [] = []++line = do+  w <- wordParser+  ps <- catMaybes . fmap charsToPhoneme <$> phonemesParser+  return PhoneticWord { word = w, phonemes = ps }++parser = endBy line endOfLine

+ src/Phoneme.hs view

@@ -0,0 +1,46 @@+module Phoneme (Phoneme(..), charsToPhoneme) where++data Phoneme = AA | AE | AH | AO | AW | AY | B | CH | D | DH | EH | ER | EY | F | G | HH | IH | IY | JH | K | L | M | N | NG | OW | OY | P | R | S | SH | T | TH | UH | UW | V | W | Y | Z | ZH+  deriving (Show)++charsToPhoneme :: String -> Maybe Phoneme+charsToPhoneme "AA" = Just AA+charsToPhoneme "AE" = Just AE+charsToPhoneme "AH" = Just AH+charsToPhoneme "AO" = Just AO+charsToPhoneme "AW" = Just AW+charsToPhoneme "AY" = Just AY+charsToPhoneme "B"  = Just B+charsToPhoneme "CH" = Just CH+charsToPhoneme "D"  = Just D+charsToPhoneme "DH" = Just DH+charsToPhoneme "EH" = Just EH+charsToPhoneme "ER" = Just ER+charsToPhoneme "EY" = Just EY+charsToPhoneme "F"  = Just F+charsToPhoneme "G"  = Just G+charsToPhoneme "HH" = Just HH+charsToPhoneme "IH" = Just IH+charsToPhoneme "IY" = Just IY+charsToPhoneme "JH" = Just JH+charsToPhoneme "K"  = Just K+charsToPhoneme "L"  = Just L+charsToPhoneme "M"  = Just M+charsToPhoneme "N"  = Just N+charsToPhoneme "NG" = Just NG+charsToPhoneme "OW" = Just OW+charsToPhoneme "OY" = Just OY+charsToPhoneme "P"  = Just P+charsToPhoneme "R"  = Just R+charsToPhoneme "S"  = Just S+charsToPhoneme "SH" = Just SH+charsToPhoneme "T"  = Just T+charsToPhoneme "TH" = Just TH+charsToPhoneme "UH" = Just UH+charsToPhoneme "UW" = Just UW+charsToPhoneme "V"  = Just V+charsToPhoneme "W"  = Just W+charsToPhoneme "Y"  = Just Y+charsToPhoneme "Z"  = Just Z+charsToPhoneme "ZH" = Just ZH+charsToPhoneme _    = Nothing

+ src/PhoneticDictionary.hs view

@@ -0,0 +1,7 @@+module PhoneticDictionary where++import Data.GenericTrie (Trie)++import PhoneticWord (PhoneticWord)++type PhoneticDictionary = Trie [Int] [PhoneticWord]

+ src/PhoneticWord.hs view

@@ -0,0 +1,7 @@+module PhoneticWord (PhoneticWord(..)) where++import Phoneme (Phoneme)++data PhoneticWord = PhoneticWord { word :: String+                                 , phonemes :: [Phoneme]+                                 } deriving (Show)

+ test/Spec.hs view

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"