iso639 0.1.0.0 → 0.1.0.1
raw patch · 2 files changed
+106/−2 lines, 2 files
Files
- generator/Generate.hs +103/−0
- iso639.cabal +3/−2
+ generator/Generate.hs view
@@ -0,0 +1,103 @@+module Generate where++-- needs: haskell-src, curl >= 1.3.8+import Language.Haskell.Syntax+import Language.Haskell.Pretty+import Data.Char (toUpper)++import Network.HTTP+import Data.Text (Text, pack, unpack, breakOn, splitOn)+import qualified Data.Text as T+import Data.Maybe+import Data.List++gen triples = prettyPrint $ + -- HsModule SrcLoc Module (Maybe [HsExportSpec]) [HsImportDecl] [HsDecl]+ HsModule (SrcLoc n 0 0) (Module n) Nothing + [HsImportDecl loc (Module "Prelude") False Nothing + (Just (True, [HsIThingAll (HsSymbol "Ordering") ]))+ ] + [iso639_1, iso639_1_show, iso639_1_read, iso639_1_name]+ where+ n = "Data.LanguageCodes"+ loc = SrcLoc n 0 0 + iso639_1 = HsDataDecl loc [] (HsIdent "ISO639_1") [] + (codes languages_1) (map (UnQual . HsIdent) ["Show", "Read", "Eq", "Enum", "Ord"])+ code (_,c) = HsConDecl loc (HsIdent (map toUpper c)) []+ codes lst = map code lst+ languages_1 = catMaybes $ map (\(l,_,c) -> fmap (\a -> (unpack l, unpack a)) c) triples+ iso639_1_read = HsFunBind + [ HsMatch loc (HsIdent "fromChars") + [HsPVar (HsSymbol "c1"), HsPVar (HsSymbol "c2")] + ( HsUnGuardedRhs + (HsCase ( HsTuple [ HsVar $ UnQual $ HsSymbol "c1"+ , HsVar $ UnQual $ HsSymbol "c2"+ ]+ ) ( map languageCodeAlt languages_1)+ )+ )+ []+ ]+ languageCodeAlt (_,c) = + HsAlt loc (HsPTuple [ HsPLit $ HsChar $ c !! 0+ , HsPLit $ HsChar $ c !! 1+ ]) + (HsUnGuardedAlt $ HsCon $ UnQual $ HsSymbol $ map toUpper c)+ []+ iso639_1_show = HsFunBind + [ HsMatch loc (HsIdent "toChars") + [HsPVar (HsSymbol "code")] + ( HsUnGuardedRhs (HsCase ( HsVar $ UnQual $ HsSymbol "code" )+ ( map languageAlt languages_1)+ )+ )+ []+ ]+ languageAlt (_,c) = + HsAlt loc (HsPApp (UnQual $ HsSymbol $ map toUpper c) [])+ (HsUnGuardedAlt $ + HsTuple [ HsLit (HsChar $ c !! 0)+ , HsLit (HsChar $ c !! 1)+ ]) + []+ iso639_1_name = HsFunBind + [ HsMatch loc (HsIdent "language") + [HsPVar (HsSymbol "code")] + ( HsUnGuardedRhs (HsCase ( HsVar $ UnQual $ HsSymbol "code" )+ ( map languageNameAlt languages_1 )+ )+ )+ []+ ]+ languageNameAlt (n,c) = + HsAlt loc (HsPApp (UnQual $ HsSymbol $ map toUpper c) [])+ (HsUnGuardedAlt $ HsLit $ HsString n) + []++-- fetch table from official site+fetchTable = do+ str <- simpleHTTP (getRequest url) >>= getResponseBody+ let site = pack str+ return site+ where+ url = "http://www.loc.gov/standards/iso639-2/php/English_list.php"++-- dirty table parsing+parseTable html = map (rowToTriple . T.lines) $ rows html + where + rows h = filter isValid $ map fixLine (tail $ T.splitOn (pack "</tr>") h)+ tagTxt = T.tail . T.takeWhile (/= '<') . T.dropWhile (/= '>')+ isValid t = T.take 3 t == T.pack "<tr"+ fixLine = T.replace (T.pack "><") (T.pack ">\n<") + . T.dropWhile (/= '<')+ rowToTriple l = (tagTxt (l !! 1), tagTxt (l !! 4)+ , if tagTxt (l !! 5) == pack " " + then Nothing+ else Just (tagTxt (l !! 5))+ )+ +doIt = do+ t <- fetchTable+ let uniqueLang f = nubBy (\(_,_,c1) (_,_,c2) -> c1 == c2) f+ sortedUnique = sortBy (\(_,_,c1) (_,_,c2) -> compare c1 c2) . uniqueLang+ writeFile "../Data/LanguageCodes.hs" $ gen (sortedUnique $ parseTable t)
iso639.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: iso639-version: 0.1.0.0+version: 0.1.0.1 synopsis: ISO-639-1 language codes mapping to Haskell datatypes from the official site (http://www.loc.gov/standards/iso639-2/php/English_list.php) -- description: license: BSD3@@ -12,8 +12,9 @@ -- copyright: category: Data build-type: Simple--- extra-source-files: +extra-source-files: generator/Generate.hs cabal-version: >=1.10+ library exposed-modules: Data.LanguageCodes