diff --git a/casa-abbreviations-and-acronyms.cabal b/casa-abbreviations-and-acronyms.cabal --- a/casa-abbreviations-and-acronyms.cabal +++ b/casa-abbreviations-and-acronyms.cabal @@ -1,7 +1,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: casa-abbreviations-and-acronyms -version: 0.0.6 +version: 0.0.7 synopsis: CASA Abbreviations and Acronyms description: <> @@ -60,7 +60,7 @@ , wreq >= 0.5 && < 0.6 , bytestring >= 0.10 && < 0.11 - main-is: AbbreviationsAndAcronymsGenerate.hs + main-is: Main.hs hs-source-dirs: src/pre-process diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +0.0.7 + +* The same acronym for multiple exact results. + 0.0.6 * fix extraneous spaces. diff --git a/src/executable/Main.hs b/src/executable/Main.hs --- a/src/executable/Main.hs +++ b/src/executable/Main.hs @@ -23,7 +23,7 @@ import Data.Functor((<$>), fmap) import Data.Int(Int) import Data.List(filter, take) -import Data.Maybe(Maybe(Just, Nothing), maybe, maybeToList) +import Data.Maybe(Maybe(Just, Nothing), maybe) import Data.Monoid(Monoid(mempty)) import Data.Ord(Ord((>=), (>)), max, min) import Data.Semigroup((<>)) @@ -53,7 +53,7 @@ fmap (\o -> (o & name . traverse %~ toUpper)) . case typ of ExactMatch -> - fmap (\a -> ShowAcronym a "-") . maybeToList . ex + fmap (\a -> ShowAcronym a "-") . ex InexactMatch x -> fmap (\(Fuzzy o _ s) -> ShowAcronym o (show s)) . maybe id (\n -> filter (\(Fuzzy _ _ s) -> s >= n)) x . fz in match term @@ -101,11 +101,11 @@ data MatchField = MatchField (String -> [Fuzzy Acronym String]) - (String -> Maybe Acronym) + (String -> [Acronym]) matchField' :: (String -> String -> String -> Bool -> [Fuzzy Acronym String]) - -> (String -> Maybe Acronym) + -> (String -> [Acronym]) -> MatchField matchField' f g = MatchField (\s -> f s "" "" False) g diff --git a/src/library/Data/Aviation/Casa/AbbreviationsAndAcronyms/Search.hs b/src/library/Data/Aviation/Casa/AbbreviationsAndAcronyms/Search.hs --- a/src/library/Data/Aviation/Casa/AbbreviationsAndAcronyms/Search.hs +++ b/src/library/Data/Aviation/Casa/AbbreviationsAndAcronyms/Search.hs @@ -31,74 +31,78 @@ import Data.Functor((<$>), fmap) import Data.List(sortBy, filter) import Data.Map(Map) -import qualified Data.Map as Map(fromList, lookup, insertWith, toList) -import Data.Maybe(Maybe) +import qualified Data.Map as Map(fromList, fromListWith, lookup, insertWith, toList) +import Data.Maybe(Maybe(Just, Nothing)) import Data.Ord(Ord((>)), compare) +import Data.Semigroup((<>)) import Data.String(String) import Data.Monoid.Textual(TextualMonoid) import qualified Text.Fuzzy as Fuzzy(filter, score) import Text.Fuzzy(Fuzzy(Fuzzy)) +import Data.List.NonEmpty(NonEmpty((:|))) all_Acronym_name_index :: - Map String (String, String) + Map String (NonEmpty (String, String)) all_Acronym_name_index = - Map.fromList ((\(Acronym _name _meaning _src) -> (_name, (_meaning, _src))) <$> allAcronyms) + Map.fromListWith (<>) (((\(Acronym _name _meaning _src) -> (_name, (_meaning, _src) :| [])) <$> allAcronyms)) all_Acronym_meaning_index :: - Map String (String, String) + Map String (NonEmpty (String, String)) all_Acronym_meaning_index = - Map.fromList ((\(Acronym _name _meaning _src) -> (_meaning, (_name, _src))) <$> allAcronyms) + Map.fromListWith (<>) (((\(Acronym _name _meaning _src) -> (_meaning, (_name, _src) :| [])) <$> allAcronyms)) all_Acronym_source_index :: - Map String (String, String) + Map String (NonEmpty (String, String)) all_Acronym_source_index = - Map.fromList ((\(Acronym _name _meaning _src) -> (_src, (_name, _meaning))) <$> allAcronyms) + Map.fromListWith (<>) (((\(Acronym _name _meaning _src) -> (_src, (_name, _meaning) :| [])) <$> allAcronyms)) searchIndexName :: String - -> Maybe Acronym + -> [Acronym] searchIndexName s = let s' = filter isAlpha . fmap toUpper $ s - in (\(_meaning, _src) -> Acronym s _meaning _src) <$> Map.lookup s' all_Acronym_name_index + in maybeNE (((\(_meaning, _src) -> Acronym s _meaning _src) <$>) <$> Map.lookup s' all_Acronym_name_index) searchIndexMeaning :: String - -> Maybe Acronym + -> [Acronym] searchIndexMeaning s = let s' = filter isAlpha . fmap toUpper $ s - in (\(_name, _src) -> Acronym _name s _src) <$> Map.lookup s' all_Acronym_meaning_index + in maybeNE (((\(_name, _src) -> Acronym _name s _src) <$>) <$> Map.lookup s' all_Acronym_meaning_index) searchIndexSource :: String - -> Maybe Acronym + -> [Acronym] searchIndexSource s = let s' = filter isAlpha . fmap toUpper $ s - in (\(_name, _meaning) -> Acronym s _name _meaning) <$> Map.lookup s' all_Acronym_source_index - + in maybeNE (((\(_name, _meaning) -> Acronym s _name _meaning) <$>) <$> Map.lookup s' all_Acronym_source_index) + searchIndexNameMeaning :: String - -> Maybe Acronym + -> [Acronym] searchIndexNameMeaning s = searchIndexName s <|> searchIndexMeaning s - + searchIndexNameSource :: String - -> Maybe Acronym + -> [Acronym] searchIndexNameSource s = searchIndexName s <|> searchIndexSource s searchIndexMeaningSource :: String - -> Maybe Acronym + -> [Acronym] searchIndexMeaningSource s = searchIndexMeaning s <|> searchIndexSource s - + searchIndexNameMeaningSource :: String - -> Maybe Acronym + -> [Acronym] searchIndexNameMeaningSource s = searchIndexName s <|> searchIndexMeaning s <|> searchIndexSource s +---- + searchFuzzyName :: String -> String @@ -181,3 +185,13 @@ in foldl' (\m' (Fuzzy o r s) -> Map.insertWith (\(s1, i1) (s2, i2) -> if i2 > i1 then (s2, i2) else (s1, i1)) o (r, s) m') m x2) x1' es in sortBy (\f1 f2 -> Fuzzy.score f2 `compare` Fuzzy.score f1) ((\(o, (r, s)) -> Fuzzy o r s) <$> Map.toList x2') + +---- + +maybeNE :: + Maybe (NonEmpty a) + -> [a] +maybeNE Nothing = + [] +maybeNE (Just (h :| t)) = + h:t diff --git a/src/pre-process/AbbreviationsAndAcronymsGenerate.hs b/src/pre-process/AbbreviationsAndAcronymsGenerate.hs deleted file mode 100644 --- a/src/pre-process/AbbreviationsAndAcronymsGenerate.hs +++ /dev/null @@ -1,128 +0,0 @@ -module AbbreviationsAndAcronymsGenerate where - -import qualified Data.ByteString.Lazy.Char8 as LazyChar8ByteString -import Control.Lens -import Control.Monad -import Data.Char -import Network.Wreq -import System.Environment - -getAbbreviationPage :: - String - -> IO String -getAbbreviationPage x = - do q <- get ("http://www.casa.gov.au/about-us/standard-page/aviation-abbreviations-and-acronyms?page=" ++ x) - let b = LazyChar8ByteString.unpack (q ^. responseBody) - pure b - -getAcronyms :: - [String] - -> [Acronym] -getAcronyms [] = - [] -getAcronyms (i1:a:i2:b:i3:c:i4:r) = - let matches = - [ - (i1, " ") - , (i2, " ") - , (i3, " ") - , (i4, " ") - ] - trim = - escapeChars . reverse . dropWhile isSpace . drop 15 . reverse . dropWhile isSpace . drop 12 - in if all (uncurry (==)) matches - then - Acronym - (trim a) - (trim b) - (trim c) - :getAcronyms r - else - getAcronyms (a:i2:b:i3:c:i4:r) -getAcronyms (_:t) = - getAcronyms t - -requestAcronyms :: - [Int] - -> IO [Acronym] -requestAcronyms x = - join <$> traverse (((getAcronyms . lines) <$>) . getAbbreviationPage . show) x - -requestAllAcronyms :: - IO [Acronym] -requestAllAcronyms = - requestAcronyms [0..49] - -data Acronym = - Acronym - String -- acronym - String -- meaning - String -- source - deriving (Eq, Ord, Show) - -render :: - [Acronym] - -> String -render acrs = - let render1 (Acronym acr mean src) = - concat - [ - "Acronym\n" - , " \"" - , acr - , "\"\n" - , " \"" - , mean - , "\"\n" - , " \"" - , src - , "\"" - ] - allAcronyms = - concat - [ - "allAcronyms =\n" - , " [\n" - , zip (True:cycle [False]) acrs >>= \(p, a) -> - concat - [ - " " - , if p then " " else "," - , " " - , render1 a - , "\n" - ] - , " ]\n" - ] - in allAcronyms - -escapeChars :: - String - -> String -escapeChars = - transform - (\x -> case x of - '&':'#':'0':'3':'9':';':r -> - '\'':r - h:t -> - if isSpace h - then - h : dropWhile isSpace t - else - x - _ -> - x - ) - -main :: - IO () -main = - do a <- getArgs - let n = - case a of - [] -> - [0..49] - q@(_:_) -> - read <$> q - c <- requestAcronyms n - writeFile "acronyms.hs" (render c) diff --git a/src/pre-process/Main.hs b/src/pre-process/Main.hs new file mode 100644 --- /dev/null +++ b/src/pre-process/Main.hs @@ -0,0 +1,128 @@ +module Main where + +import qualified Data.ByteString.Lazy.Char8 as LazyChar8ByteString +import Control.Lens +import Control.Monad +import Data.Char +import Network.Wreq +import System.Environment + +getAbbreviationPage :: + String + -> IO String +getAbbreviationPage x = + do q <- get ("http://www.casa.gov.au/about-us/standard-page/aviation-abbreviations-and-acronyms?page=" ++ x) + let b = LazyChar8ByteString.unpack (q ^. responseBody) + pure b + +getAcronyms :: + [String] + -> [Acronym] +getAcronyms [] = + [] +getAcronyms (i1:a:i2:b:i3:c:i4:r) = + let matches = + [ + (i1, " ") + , (i2, " ") + , (i3, " ") + , (i4, " ") + ] + trim = + escapeChars . reverse . dropWhile isSpace . drop 15 . reverse . dropWhile isSpace . drop 12 + in if all (uncurry (==)) matches + then + Acronym + (trim a) + (trim b) + (trim c) + :getAcronyms r + else + getAcronyms (a:i2:b:i3:c:i4:r) +getAcronyms (_:t) = + getAcronyms t + +requestAcronyms :: + [Int] + -> IO [Acronym] +requestAcronyms x = + join <$> traverse (((getAcronyms . lines) <$>) . getAbbreviationPage . show) x + +requestAllAcronyms :: + IO [Acronym] +requestAllAcronyms = + requestAcronyms [0..49] + +data Acronym = + Acronym + String -- acronym + String -- meaning + String -- source + deriving (Eq, Ord, Show) + +render :: + [Acronym] + -> String +render acrs = + let render1 (Acronym acr mean src) = + concat + [ + "Acronym\n" + , " \"" + , acr + , "\"\n" + , " \"" + , mean + , "\"\n" + , " \"" + , src + , "\"" + ] + allAcronyms = + concat + [ + "allAcronyms =\n" + , " [\n" + , zip (True:cycle [False]) acrs >>= \(p, a) -> + concat + [ + " " + , if p then " " else "," + , " " + , render1 a + , "\n" + ] + , " ]\n" + ] + in allAcronyms + +escapeChars :: + String + -> String +escapeChars = + transform + (\x -> case x of + '&':'#':'0':'3':'9':';':r -> + '\'':r + h:t -> + if isSpace h + then + h : dropWhile isSpace t + else + x + _ -> + x + ) + +main :: + IO () +main = + do a <- getArgs + let n = + case a of + [] -> + [0..49] + q@(_:_) -> + read <$> q + c <- requestAcronyms n + writeFile "acronyms.hs" (render c)