mirror of
https://github.com/typeable/country-codes.git
synced 2024-07-14 17:00:22 +03:00
Initial commit: initial version of generated code
This commit is contained in:
parent
5bdbe4ef1e
commit
7415654ffb
2
.gitignore
vendored
2
.gitignore
vendored
@ -9,3 +9,5 @@ cabal-dev
|
|||||||
.cabal-sandbox/
|
.cabal-sandbox/
|
||||||
cabal.sandbox.config
|
cabal.sandbox.config
|
||||||
cabal.config
|
cabal.config
|
||||||
|
.dist-buildwrapper
|
||||||
|
.project
|
||||||
|
27
LICENSE
Normal file
27
LICENSE
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
Copyright (c) 2014, Prowdsponsor
|
||||||
|
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 the Prowdsponsor nor the names of its
|
||||||
|
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 HOLDER 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.
|
61
country-codes.cabal
Normal file
61
country-codes.cabal
Normal file
@ -0,0 +1,61 @@
|
|||||||
|
name: country-codes
|
||||||
|
version: 0.1
|
||||||
|
cabal-version: >= 1.8
|
||||||
|
build-type: Simple
|
||||||
|
author: JP Moresmau <jpmoresmau@gmail.com>
|
||||||
|
license: BSD3
|
||||||
|
license-file: LICENSE
|
||||||
|
copyright: (c) 2014 Prowdsponsor
|
||||||
|
category: Data
|
||||||
|
homepage: https://github.com/prowdsponsor/country-codes
|
||||||
|
maintainer: Prowdsponsor <opensource@prowdsponsor.com>
|
||||||
|
synopsis: ISO 3166 country codes and i18n names.
|
||||||
|
description: ISO 3166 country codes and i18n names.
|
||||||
|
|
||||||
|
|
||||||
|
source-repository head
|
||||||
|
type: git
|
||||||
|
location: git://github.com/prowdsponsor/country-codes.git
|
||||||
|
|
||||||
|
|
||||||
|
flag generate
|
||||||
|
default: False
|
||||||
|
description: Build generate executable?
|
||||||
|
manual: True
|
||||||
|
|
||||||
|
|
||||||
|
library
|
||||||
|
hs-source-dirs: src
|
||||||
|
build-depends:
|
||||||
|
base >= 4 && < 5
|
||||||
|
, text >= 0.11
|
||||||
|
, aeson >= 0.5 && < 0.8
|
||||||
|
ghc-options: -Wall
|
||||||
|
other-modules: Data.CountryCodes.ISO31661
|
||||||
|
exposed-modules: Data.CountryCodes
|
||||||
|
|
||||||
|
|
||||||
|
executable country-codes-generate
|
||||||
|
hs-source-dirs: exe
|
||||||
|
build-depends:
|
||||||
|
base >= 4 && < 5
|
||||||
|
, text >= 0.11
|
||||||
|
, tagsoup >= 0.13 && < 0.14
|
||||||
|
ghc-options: -Wall -rtsopts
|
||||||
|
main-is: Main.hs
|
||||||
|
if !flag(generate)
|
||||||
|
buildable: False
|
||||||
|
|
||||||
|
|
||||||
|
test-suite country-codes-tests
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: country-codes-tests.hs
|
||||||
|
ghc-options: -Wall -rtsopts -threaded
|
||||||
|
build-depends:
|
||||||
|
base
|
||||||
|
, aeson
|
||||||
|
, country-codes
|
||||||
|
, HTF > 0.9
|
||||||
|
, HUnit >= 1.2.5
|
||||||
|
hs-source-dirs:
|
||||||
|
test
|
4577
data/ISO 3166-1 alpha-2 - Wikipedia, the free encyclopedia.html
Normal file
4577
data/ISO 3166-1 alpha-2 - Wikipedia, the free encyclopedia.html
Normal file
File diff suppressed because it is too large
Load Diff
119
exe/Main.hs
Normal file
119
exe/Main.hs
Normal file
@ -0,0 +1,119 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
import Text.HTML.TagSoup
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.IO as T
|
||||||
|
import Data.Maybe (mapMaybe)
|
||||||
|
import Data.Monoid ((<>))
|
||||||
|
import Data.List (foldl')
|
||||||
|
|
||||||
|
main :: IO()
|
||||||
|
main = do
|
||||||
|
txt <- T.readFile "data/ISO 3166-1 alpha-2 - Wikipedia, the free encyclopedia.html"
|
||||||
|
let assocs = extract txt
|
||||||
|
let haskell=generate assocs
|
||||||
|
T.writeFile "src/Data/CountryCodes/ISO31661.hs" haskell
|
||||||
|
return ()
|
||||||
|
|
||||||
|
|
||||||
|
extract :: T.Text -> [(T.Text,T.Text)]
|
||||||
|
extract txt =
|
||||||
|
let tts=parseTags txt
|
||||||
|
ps1=partitions (~== TagOpen ("span"::T.Text) [("id","Officially_assigned_code_elements")]) tts
|
||||||
|
in case ps1 of
|
||||||
|
[] -> error "No span with id 'Officially_assigned_code_elements' found"
|
||||||
|
(p1 : _) ->
|
||||||
|
let ps2=partitions (~== TagOpen ("table"::T.Text) [("class","wikitable sortable")]) p1
|
||||||
|
in case ps2 of
|
||||||
|
[] -> error "No wikitable found"
|
||||||
|
(p2 : _) ->
|
||||||
|
let rows= partitions (~== TagOpen ("tr" :: T.Text) []) p2
|
||||||
|
in mapMaybe (\r ->
|
||||||
|
let tds=partitions (~== TagOpen ("td"::T.Text) []) r
|
||||||
|
in if null tds || null (head tds)
|
||||||
|
then Nothing
|
||||||
|
else
|
||||||
|
let cid = fromAttrib "id" $ head $ head tds
|
||||||
|
name = fromAttrib "title" $ head $ head $ partitions (~== TagOpen ("a" :: T.Text) []) r
|
||||||
|
in Just (cid,name)
|
||||||
|
) rows
|
||||||
|
|
||||||
|
generate :: [(T.Text,T.Text)] -> T.Text
|
||||||
|
generate assocs =
|
||||||
|
let
|
||||||
|
header = "{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, NoImplicitPrelude, PatternGuards #-}" <> nl <>
|
||||||
|
"-- | This file is generated from the Wikipedia page" <> nl <>
|
||||||
|
"-- <http://en.wikipedia.org/wiki/ISO_3166-1_alpha-2>" <> nl <>
|
||||||
|
"module Data.CountryCodes.ISO31661 (" <> nl <>
|
||||||
|
" CountryCode(..)" <> nl <>
|
||||||
|
" , fromMText" <> nl <>
|
||||||
|
" , fromText" <> nl <>
|
||||||
|
" , fromMName" <> nl <>
|
||||||
|
" , fromName" <> nl <>
|
||||||
|
" , toText" <> nl <>
|
||||||
|
" , toName" <> nl <>
|
||||||
|
") where" <> nl <>
|
||||||
|
nl <>
|
||||||
|
"import Control.Applicative (pure)" <> nl <>
|
||||||
|
"import Data.Aeson" <> nl <>
|
||||||
|
"import Data.Typeable" <> nl <>
|
||||||
|
"import qualified Data.Text as T" <> nl <>
|
||||||
|
"import Prelude (Show,Read,Eq,Ord,Bounded,Enum,error,($),(++),Maybe(..),(.),fail)" <> nl <>
|
||||||
|
nl
|
||||||
|
cons = snd (foldl' constructor (True, header) assocs) <> nl <>
|
||||||
|
" deriving (Show,Read,Eq,Ord,Bounded,Enum,Typeable)"
|
||||||
|
fromMTexts = foldl' fromText (cons <> nl <> nl <>
|
||||||
|
"-- | Maybe get the CountryCode from the text code." <> nl <>
|
||||||
|
"fromMText :: T.Text -> Maybe CountryCode") assocs <> nl <>
|
||||||
|
"fromMText _ = Nothing"
|
||||||
|
fromTexts = fromMTexts <> nl <> nl <>
|
||||||
|
"-- | Get the CountryCode from the text code. Errors if the code is unknown" <> nl <>
|
||||||
|
"fromText :: T.Text -> CountryCode" <> nl <>
|
||||||
|
"fromText c = case fromMText c of" <> nl <>
|
||||||
|
" Just cc -> cc" <> nl <>
|
||||||
|
" _ -> error $ \"fromText: Unknown country code:\" ++ T.unpack c"
|
||||||
|
toTexts = foldl' toText (fromTexts <> nl <> nl <>
|
||||||
|
"-- | Get the code as text." <> nl <>
|
||||||
|
"toText :: CountryCode -> T.Text") assocs
|
||||||
|
fromMNames = foldl' fromName (toTexts <> nl <> nl <>
|
||||||
|
"-- | Maybe get the code from the user readable name." <> nl <>
|
||||||
|
"fromMName :: T.Text -> Maybe CountryCode") assocs <> nl <>
|
||||||
|
"fromMName _ = Nothing"
|
||||||
|
fromNames = fromMNames <> nl <> nl <>
|
||||||
|
"-- | Get the CountryCode from the user readable name. Errors if the name is unknown" <> nl <>
|
||||||
|
"fromName:: T.Text -> CountryCode" <> nl <>
|
||||||
|
"fromName c = case fromMName c of" <> nl <>
|
||||||
|
" Just cc -> cc" <> nl <>
|
||||||
|
" _ -> error $ \"fromName: Unknown country code:\" ++ T.unpack c"
|
||||||
|
toNames = foldl' toName (fromNames <> nl <> nl <>
|
||||||
|
"-- | Get the user readable name." <> nl <>
|
||||||
|
"toName :: CountryCode -> T.Text") assocs
|
||||||
|
json = toNames <>
|
||||||
|
"-- | to json: as a simple string" <> nl <>
|
||||||
|
"instance ToJSON CountryCode where" <> nl <>
|
||||||
|
" toJSON =toJSON . toText" <> nl <>
|
||||||
|
nl <>
|
||||||
|
"-- | from json: as a simple string" <> nl <>
|
||||||
|
"instance FromJSON CountryCode where" <> nl <>
|
||||||
|
" parseJSON (String s)" <> nl <>
|
||||||
|
" | Just a <- fromMText s=pure a" <> nl <>
|
||||||
|
" parseJSON _ =fail \"CountryCode\"" <> nl
|
||||||
|
in json
|
||||||
|
|
||||||
|
where
|
||||||
|
constructor :: (Bool,T.Text) -> (T.Text,T.Text) -> (Bool,T.Text)
|
||||||
|
constructor (True,acc) (i,_) = (False,acc <> "data CountryCode = " <> nl <> " " <> i)
|
||||||
|
constructor (False,acc) (i,_) = (False,acc <> nl <> " | " <> i)
|
||||||
|
fromText :: T.Text -> (T.Text,T.Text) -> T.Text
|
||||||
|
fromText acc (i,_) = acc <> nl <> "fromMText \"" <> i <> "\" = Just " <> i
|
||||||
|
toText :: T.Text -> (T.Text,T.Text) -> T.Text
|
||||||
|
toText acc (i,_) = acc <> nl <> "toText " <> i <> " = \"" <> i <> "\""
|
||||||
|
fromName :: T.Text -> (T.Text,T.Text) -> T.Text
|
||||||
|
fromName acc (i,n) = acc <> nl <> "fromMName \"" <> n <> "\" = Just " <> i
|
||||||
|
toName :: T.Text -> (T.Text,T.Text) -> T.Text
|
||||||
|
toName acc (i,n) = acc <> nl <> "toName " <> i <> " = \"" <> n <> "\""
|
||||||
|
|
||||||
|
nl :: T.Text
|
||||||
|
nl = "\n"
|
17
src/Data/CountryCodes.hs
Normal file
17
src/Data/CountryCodes.hs
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
module Data.CountryCodes (
|
||||||
|
CountryCode(..)
|
||||||
|
, allNames
|
||||||
|
, fromText
|
||||||
|
, fromName
|
||||||
|
, toText
|
||||||
|
, toName
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Arrow ((&&&))
|
||||||
|
import Data.Text (Text)
|
||||||
|
|
||||||
|
import Data.CountryCodes.ISO31661
|
||||||
|
|
||||||
|
|
||||||
|
allNames :: [(CountryCode,Text)]
|
||||||
|
allNames = map (id &&& toName) $ enumFrom minBound
|
1300
src/Data/CountryCodes/ISO31661.hs
Normal file
1300
src/Data/CountryCodes/ISO31661.hs
Normal file
File diff suppressed because it is too large
Load Diff
11
test/country-codes-tests.hs
Normal file
11
test/country-codes-tests.hs
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
{-# OPTIONS_GHC -F -pgmF htfpp #-}
|
||||||
|
-- | entry module for tests
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
import Test.Framework
|
||||||
|
|
||||||
|
|
||||||
|
-- | test entry point
|
||||||
|
main :: IO()
|
||||||
|
main = undefined -- htfMain htf_importedTests
|
||||||
|
|
Loading…
Reference in New Issue
Block a user