Initial commit: initial version of generated code

.gitignore

@@ -9,3 +9,5 @@ cabal-dev
 .cabal-sandbox/
 cabal.sandbox.config
 cabal.config
+.dist-buildwrapper
+.project

LICENSE

@@ -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.

country-codes.cabal

@@ -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

exe/Main.hs

@@ -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"

src/Data/CountryCodes.hs

@@ -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

test/country-codes-tests.hs

@@ -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
+