packages feed

roc-id (empty) → 0.1.0.0

raw patch · 14 files changed

+610/−0 lines, 14 filesdep +MonadRandomdep +Onlydep +QuickCheck

Dependencies added: MonadRandom, Only, QuickCheck, base, generic-arbitrary, hspec, roc-id, text, vector-sized

Files

+ .gitignore view
@@ -0,0 +1,2 @@+.stack-work/+*~
+ .hspec view
@@ -0,0 +1,1 @@+--qc-max-success=1000
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Jonathan Knowles (c) 2018++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 Jonathan Knowles 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.
+ README.md view
@@ -0,0 +1,8 @@+This package provides a [Haskell](https://www.haskell.org/) implementation of+the ROC Identification Number (中華民國身分證號碼) standard.++For more details of the standard, see:++* https://zh.wikipedia.org/wiki/中華民國國民身分證+* https://en.wikipedia.org/wiki/National_Identification_Card_(Republic_of_China)+
+ library/ROC/ID.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE DataKinds              #-}+{-# LANGUAGE DeriveGeneric          #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE LambdaCase             #-}+{-# LANGUAGE OverloadedStrings      #-}+{-# LANGUAGE RecordWildCards        #-}+{-# LANGUAGE ScopedTypeVariables    #-}++module ROC.ID+  ( Identity (..)+  , identityChecksum+  , parseIdentity+  , ParseError (..)+  , randomIdentity+  ) where++import Control.Monad.Random.Class (MonadRandom (..))+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Data.Tuple.Only (Only (..))+import Data.Vector.Sized (Vector)+import GHC.Generics (Generic)++import ROC.ID.Digit+import ROC.ID.Gender+import ROC.ID.Location+import ROC.ID.Serial+import ROC.ID.Utilities++import qualified Data.Text         as T+import qualified Data.Vector.Sized as V++-- Types:++-- | Represents a __valid__ 10-digit ROC national identification number+-- (中華民國身份證號碼) of the form __@A123456789@__.+--+-- By construction, invalid values are __not representable__ by this type.+--+-- An identification number encodes a person's 'Gender', the 'Location' in+-- which they first registered for an identification card, and a unique 'Serial'+-- number.+--+data Identity = Identity+  { identityGender   :: Gender+  -- ^ The gender of the person to whom this ID number belongs.+  , identityLocation :: Location+  -- ^ The location in which the person first registered for an ID card.+  , identitySerial   :: Serial+  -- ^ The serial number portion of this ID number.+  } deriving (Eq, Generic, Ord)++instance Show Identity where+  show i@Identity {..} = ""+    <> show identityLocation+    <> foldMap show (toDigits identityGender)+    <> foldMap show (toDigits identitySerial)+    <> show (identityChecksum i)++-- | Calculate the checksum of the specified 'Identity'.+--+identityChecksum :: Identity -> Digit+identityChecksum Identity {..} = toEnum $ negate total `mod` 10+  where+    total = 1 * p 0 + 9 * p 1 + 8 * g 0 + 7 * s 0 + 6 * s 1+          + 5 * s 2 + 4 * s 3 + 3 * s 4 + 2 * s 5 + 1 * s 6+    g = index identityGender+    p = index identityLocation+    s = index identitySerial+    index x = fromEnum . V.index e+      where+        e = toDigits x++class ToDigits t n | t -> n where+  toDigits :: t -> Vector n Digit++instance ToDigits Gender 1 where+  toDigits = V.fromTuple . Only . \case+    Male   -> D1+    Female -> D2++instance ToDigits Location 2 where+  toDigits = V.fromTuple . \case+    A -> (D1, D0); N -> (D2, D2)+    B -> (D1, D1); O -> (D3, D5)+    C -> (D1, D2); P -> (D2, D3)+    D -> (D1, D3); Q -> (D2, D4)+    E -> (D1, D4); R -> (D2, D5)+    F -> (D1, D5); S -> (D2, D6)+    G -> (D1, D6); T -> (D2, D7)+    H -> (D1, D7); U -> (D2, D8)+    I -> (D3, D4); V -> (D2, D9)+    J -> (D1, D8); W -> (D3, D2)+    K -> (D1, D9); X -> (D3, D0)+    L -> (D2, D0); Y -> (D3, D1)+    M -> (D2, D1); Z -> (D3, D3)++instance ToDigits Serial 7 where+  toDigits (Serial c) = c++-- | Attempt to parse an 'Identity' using the specified 'Text' as input.+--+-- The input must be of the form __@A123456789@__.+--+parseIdentity :: Text -> Either ParseError Identity+parseIdentity t = do+    v <-              guard InvalidLength   (parseRaw                     t)+    i <- Identity <$> guard InvalidGender   (parseGender   $ readGender   v)+                  <*> guard InvalidLocation (parseLocation $ readLocation v)+                  <*> guard InvalidSerial   (parseSerial   $ readSerial   v)+    c <-              guard InvalidChecksum (parseDigit    $ readChecksum v)+    if c == identityChecksum i then pure i else Left InvalidChecksum+  where+    readSerial   = V.slice (Proxy :: Proxy 2)+    readLocation = flip V.index 0+    readGender   = flip V.index 1+    readChecksum = flip V.index 9++-- | An error produced when parsing an 'Identity' with the 'parseIdentity'+--   function.+--+data ParseError+  = InvalidLength+    -- ^ The input was either too short or too long.+  | InvalidGender+    -- ^ The gender portion of the input was invalid.+  | InvalidLocation+    -- ^ The location portion of the input included non-alphabetic characters.+  | InvalidSerial+    -- ^ The serial number portion of the input included non-numeric characters.+  | InvalidChecksum+    -- ^ The computed checksum did not match the checksum portion of the input.+  deriving (Eq, Show)++parseRaw :: Text -> Maybe (Vector 10 Char)+parseRaw  = V.fromList . T.unpack++parseGender :: Char -> Maybe Gender+parseGender = \case+  '1' -> pure Male+  '2' -> pure Female+  _   -> Nothing++parseSerial :: Vector 7 Char -> Maybe Serial+parseSerial a = Serial <$> traverse parseDigit a++-- | Generate a random 'Identity'.+--+randomIdentity :: MonadRandom m => m Identity+randomIdentity = Identity <$> randomGender+                          <*> randomLocation+                          <*> randomSerial+
+ library/ROC/ID/Digit.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveGeneric #-}++module ROC.ID.Digit+  ( Digit (..)+  , parseDigit+  ) where++import GHC.Generics (Generic)++import ROC.ID.Utilities++-- | Represents a single decimal digit in the range 0 to 9.+--+data Digit+  = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9+  deriving (Bounded, Enum, Eq, Generic, Ord)++instance Show Digit where show = show . fromEnum++parseDigit :: Char -> Maybe Digit+parseDigit c = maybeRead [c] >>= maybeToEnum+
+ library/ROC/ID/Gender.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++module ROC.ID.Gender+  ( Gender (..)+  , printGender+  , randomGender+  ) where++import Control.Monad.Random.Class (MonadRandom (..))+import Data.Text (Text)+import GHC.Generics (Generic)++import ROC.ID.Language+import ROC.ID.Utilities++-- | A person's gender, encodable within an ROC identification number.+--+data Gender = Male | Female+  deriving (Bounded, Enum, Eq, Generic, Ord, Show)++-- | Pretty-print the specified 'Gender'.+--+printGender :: Language -> Gender -> Text+printGender = \case+  English -> printGenderEnglish+  Chinese -> printGenderChinese++printGenderEnglish :: Gender -> Text+printGenderEnglish = \case+  Male   -> "Male"+  Female -> "Female"++printGenderChinese :: Gender -> Text+printGenderChinese = \case+  Male   -> "男性"+  Female -> "女性"++-- | Generate a random 'Gender'.+--+randomGender :: MonadRandom m => m Gender+randomGender = randomBoundedEnum+
+ library/ROC/ID/Language.hs view
@@ -0,0 +1,6 @@+module ROC.ID.Language where++-- | A language into which values can be localized when pretty printing.+--+data Language = English | Chinese+
+ library/ROC/ID/Location.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++module ROC.ID.Location+  ( Location (..)+  , parseLocation+  , printLocation+  , randomLocation+  ) where++import Control.Monad.Random.Class (MonadRandom (..))+import Data.Text (Text)+import GHC.Generics (Generic)+import ROC.ID.Language (Language (..))+import ROC.ID.Utilities++-- | A location, encodable within an ROC identification number.+--+-- To generate the name of a 'Location', use the 'printLocation' function.+--+-- To parse a 'Location', use the 'parseLocation' function.+--+-- To generate a random 'Location', use the 'randomLocation' function.+--+data Location+  = A -- ^ 臺北市 Taipei City+  | B -- ^ 臺中市 Taichung City+  | C -- ^ 基隆市 Keelung City+  | D -- ^ 臺南市 Tainan City+  | E -- ^ 高雄市 Kaohsiung City+  | F -- ^ 新北市 New Taipei City+  | G -- ^ 宜蘭縣 Yilan County+  | H -- ^ 桃園市 Taoyuan City+  | I -- ^ 嘉義市 Chiayi City+  | J -- ^ 新竹縣 Hsinchu County+  | K -- ^ 苗栗縣 Miaoli County+  | L -- ^ 臺中縣 Taichung County+  | M -- ^ 南投縣 Nantou County+  | N -- ^ 彰化縣 Changhua County+  | O -- ^ 新竹市 Hsinchu City+  | P -- ^ 雲林縣 Yunlin County+  | Q -- ^ 嘉義縣 Chiayi County+  | R -- ^ 臺南縣 Pingtung County+  | S -- ^ 高雄縣 Kaohsiung County+  | T -- ^ 屏東縣 Pingtung County+  | U -- ^ 花蓮縣 Hualien County+  | V -- ^ 臺東縣 Taitung County+  | W -- ^ 金門縣 Kinmen County+  | X -- ^ 澎湖縣 Penghu County+  | Y -- ^ 陽明山 Yangmingshan+  | Z -- ^ 連江縣 Lienchiang County+  deriving (Bounded, Enum, Eq, Generic, Ord, Read, Show)++-- | Parse the specified uppercase alphabetic character as a 'Location'.+--+-- Returns 'Nothing' if the specified character is not an uppercase alphabetic+-- character.+--+parseLocation :: Char -> Maybe Location+parseLocation c = maybeRead [c]++-- | Pretty-print the specified 'Location'.+printLocation :: Language -> Location -> Text+printLocation = \case+  English -> printLocationEnglish+  Chinese -> printLocationChinese++printLocationChinese :: Location -> Text+printLocationChinese = \case+  A -> "臺北市"+  B -> "臺中市"+  C -> "基隆市"+  D -> "臺南市"+  E -> "高雄市"+  F -> "新北市"+  G -> "宜蘭縣"+  H -> "桃園市"+  I -> "嘉義市"+  J -> "新竹縣"+  K -> "苗栗縣"+  L -> "臺中縣"+  M -> "南投縣"+  N -> "彰化縣"+  O -> "新竹市"+  P -> "雲林縣"+  Q -> "嘉義縣"+  R -> "臺南縣"+  S -> "高雄縣"+  T -> "屏東縣"+  U -> "花蓮縣"+  V -> "臺東縣"+  W -> "金門縣"+  X -> "澎湖縣"+  Y -> "陽明山"+  Z -> "連江縣"++printLocationEnglish :: Location -> Text+printLocationEnglish = \case+  A -> "Taipei City"+  B -> "Taichung City"+  C -> "Keelung City"+  D -> "Tainan City"+  E -> "Kaohsiung City"+  F -> "New Taipei City"+  G -> "Yilan County"+  H -> "Taoyuan City"+  I -> "Chiayi City"+  J -> "Hsinchu County"+  K -> "Miaoli County"+  L -> "Taichung County"+  M -> "Nantou County"+  N -> "Changhua County"+  O -> "Hsinchu City"+  P -> "Yunlin County"+  Q -> "Chiayi County"+  R -> "Pingtung County"+  S -> "Kaohsiung County"+  T -> "Pingtung County"+  U -> "Hualien County"+  V -> "Taitung County"+  W -> "Kinmen County"+  X -> "Penghu County"+  Y -> "Yangmingshan"+  Z -> "Lienchiang County"++-- | Generate a random 'Location'.+--+randomLocation :: MonadRandom m => m Location+randomLocation = randomBoundedEnum+
+ library/ROC/ID/Serial.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE DataKinds     #-}+{-# LANGUAGE DeriveGeneric #-}++module ROC.ID.Serial+  ( Serial (..)+  , randomSerial+  ) where++import Control.Monad.Random.Class (MonadRandom (..))+import Data.Vector.Sized (Vector)+import GHC.Generics (Generic)++import ROC.ID.Digit+import ROC.ID.Utilities++import qualified Data.Vector.Sized as V++-- | A 7-digit serial number, as found within an ROC identification number.+--+-- A serial number is unique for a gender and location.+--+-- To generate a random 'Serial' number, use the 'randomSerial' function.+--+newtype Serial = Serial (Vector 7 Digit)+  deriving (Eq, Generic, Ord, Show)++-- | Generate a random 'Serial' number.+--+randomSerial :: MonadRandom m => m Serial+randomSerial = Serial <$> V.replicateM randomBoundedEnum+
+ library/ROC/ID/Utilities.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE ScopedTypeVariables    #-}++module ROC.ID.Utilities where++import Control.Monad.Random.Class (MonadRandom (..))+import Data.Maybe (listToMaybe)++guard :: x -> Maybe y -> Either x y+guard x = maybe (Left x) Right++maybeRead :: Read a => String -> Maybe a+maybeRead = fmap fst . listToMaybe . reads++maybeToEnum :: forall a . Bounded a => Enum a => Int -> Maybe a+maybeToEnum i+  | i < fromEnum (minBound :: a) = Nothing+  | i > fromEnum (maxBound :: a) = Nothing+  | otherwise                    = pure $ toEnum i++randomBoundedEnum :: forall a m . MonadRandom m => Bounded a => Enum a => m a+randomBoundedEnum =+  toEnum <$> getRandomR (fromEnum (minBound :: a), fromEnum (maxBound :: a))+
+ roc-id.cabal view
@@ -0,0 +1,75 @@+name:           roc-id+version:        0.1.0.0+synopsis:       Implementation of the ROC National ID standard.+category:       Identification+homepage:       https://github.com/jonathanknowles/roc-id#readme+bug-reports:    https://github.com/jonathanknowles/roc-id/issues+author:         Jonathan Knowles+maintainer:     mail@jonathanknowles.net+copyright:      Jonathan Knowles+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++description:+  This package provides an implementation of the ROC National Identification+  Number (中華民國身分證號碼) standard.+  .+  In particular, it provides functions for parsing and validating identification+  numbers from textual input.+  .+  See the "ROC.ID" module to get started.+  .+  For more details of the standard on which this package is based, see:+  .+  * https://zh.wikipedia.org/wiki/中華民國國民身分證+  * https://en.wikipedia.org/wiki/National_Identification_Card_(Republic_of_China)++extra-source-files:+  README.md++source-repository head+  type: git+  location: https://github.com/jonathanknowles/roc-id++library+  exposed-modules:+      ROC.ID+      ROC.ID.Digit+      ROC.ID.Gender+      ROC.ID.Language+      ROC.ID.Location+      ROC.ID.Serial+  other-modules:+      ROC.ID.Utilities+  hs-source-dirs:+      library+  ghc-options: -Wall+  build-depends:+      MonadRandom+    , Only+    , base >=4.7 && <5+    , text+    , vector-sized+  default-language: Haskell2010++test-suite roc-id-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_roc_id+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      MonadRandom+    , Only+    , QuickCheck+    , base >=4.7 && <5+    , generic-arbitrary+    , hspec+    , roc-id+    , text+    , vector-sized+  default-language: Haskell2010
+ stack.yaml view
@@ -0,0 +1,3 @@+resolver: lts-12.21+packages:+- .
+ test/Spec.hs view
@@ -0,0 +1,80 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import ROC.ID+import ROC.ID.Digit+import ROC.ID.Gender+import ROC.ID.Location+import ROC.ID.Serial++import Data.Char (intToDigit)+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Arbitrary.Generic++import qualified Data.Vector.Sized as V+import qualified Data.Text         as T++instance Arbitrary Digit where+  arbitrary = genericArbitrary+  shrink = genericShrink++instance Arbitrary Gender where+  arbitrary = genericArbitrary+  shrink = genericShrink++instance Arbitrary Identity where+  arbitrary = genericArbitrary+  shrink = genericShrink++instance Arbitrary Location where+  arbitrary = genericArbitrary+  shrink = genericShrink++instance Arbitrary Serial where+  arbitrary = Serial . V.fromTuple <$> arbitrary+  shrink (Serial v) = Serial <$> traverse shrink v++main :: IO ()+main = hspec $++  describe "parseIdentity" $ do++    it "successfully parses valid identification numbers" $+      property $ \(i :: Identity) ->+        parseIdentity (T.pack $ show i) `shouldBe` Right i++    it "does not parse identification numbers that are too short" $+      property $ \(i :: Identity) n -> do+        let newLength = n `mod` 10+        let invalidIdentity = T.pack $ take newLength $ show i+        parseIdentity invalidIdentity `shouldBe` Left InvalidLength++    it "does not parse identification numbers that are too long" $+      property $ \(i :: Identity) (NonEmpty s) -> do+        let invalidIdentity = T.pack $ show i <> s+        parseIdentity invalidIdentity `shouldBe` Left InvalidLength++    it "does not parse identification numbers with invalid gender codes" $+      property $ \(i :: Identity) (c :: Int) -> do+        let invalidGenderCode = intToDigit $ ((c `mod` 8) + 3) `mod` 10+        let invalidIdentity = T.pack $+              take 1 (show i) <> [invalidGenderCode] <> drop 2 (show i)+        parseIdentity invalidIdentity `shouldBe` Left InvalidGender++    it "does not parse identification numbers with invalid location codes" $+      property $ \(i :: Identity) (c :: Int) -> do+        let invalidLocationCode = intToDigit $ c `mod` 10+        let invalidIdentity = T.pack $ invalidLocationCode : drop 1 (show i)+        parseIdentity invalidIdentity `shouldBe` Left InvalidLocation++    it "does not parse identification numbers with invalid checksums" $+      property $ \(i :: Identity) (c :: Int) -> do+        let invalidChecksum = intToDigit $+              ((c `mod` 9) + fromEnum (identityChecksum i) + 1) `mod` 10+        let invalidIdentity = T.pack $ take 9 (show i) <> [invalidChecksum]+        parseIdentity invalidIdentity `shouldBe` Left InvalidChecksum+