Merge pull request #6 from thomashoneyman/master

Migrate to PureScript 0.12
cdepillabout · Jun 13, 2018 · b2d193d · b2d193d
2 parents 04bae0f + 7161c3b
commit b2d193d
Show file tree

Hide file tree

Showing 4 changed files with 63 additions and 51 deletions.
diff --git a/bower.json b/bower.json
@@ -11,18 +11,16 @@
     "output"
   ],
   "dependencies": {
-    "purescript-generics": "^4.0",
-    "purescript-parsing": "^4.3",
-    "purescript-string-parsers": "^3.0",
-    "purescript-aff": "^4.0",
-    "purescript-transformers": "^3.4"
+    "purescript-string-parsers": "^4.0",
+    "purescript-aff": "^5.0",
+    "purescript-transformers": "^4.1"
   },
   "repository": {
     "type": "git",
     "url": "git://github.com/cdepillabout/purescript-email-validate"
   },
   "license": "BSD-3-Clause",
   "devDependencies": {
-    "purescript-spec": "^2.0.0"
+    "purescript-spec": "^3.0.0"
   }
 }
diff --git a/package.json b/package.json
@@ -7,9 +7,9 @@
     "test": "test"
   },
   "dependencies": {
-    "bower": "^1.8.0",
-    "pulp": "^11.0.2",
-    "purescript": "^0.11.6"
+    "bower": "^1.8.4",
+    "pulp": "^12.3.0",
+    "purescript": "^0.12.0"
   },
   "devDependencies": {},
   "scripts": {

diff --git a/src/Text/Email/Parser.purs b/src/Text/Email/Parser.purs
@@ -1,22 +1,27 @@
-
 module Text.Email.Parser
-    ( EmailAddress(..)
-    , EmailParser()
-    , addrSpec
-    , domainPart
-    , localPart
-    , toString
-    )
+  ( EmailAddress(..)
+  , EmailParser()
+  , addrSpec
+  , domainPart
+  , localPart
+  , toString
+  )
 where
 
 import Prelude
 
 import Control.Alt ((<|>))
 import Data.Char (fromCharCode)
 import Data.Foldable (fold, intercalate)
-import Data.Generic (class Generic, gEq)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Eq (genericEq)
+import Data.Generic.Rep.Show (genericShow)
 import Data.List (List)
-import Data.String (Pattern(..), contains, fromCharArray, singleton)
+import Data.List.NonEmpty (NonEmptyList)
+import Data.Maybe (fromJust)
+import Data.String (Pattern(..), contains)
+import Data.String.CodeUnits (singleton)
+import Partial.Unsafe (unsafePartial)
 import Text.Parsing.StringParser (Parser)
 import Text.Parsing.StringParser.Combinators (many, many1, optional, sepBy1)
 import Text.Parsing.StringParser.String (char, eof, satisfy)
@@ -32,9 +37,11 @@ localPart (EmailAddress email) = email.localPart
 domainPart :: EmailAddress -> String
 domainPart (EmailAddress email) = email.domainPart
 
-derive instance genericEmailAddress :: Generic EmailAddress
-instance showEmailAddress :: Show EmailAddress where show = toString
-instance eqEmailAddress :: Eq EmailAddress where eq = gEq
+derive instance genericEmailAddress :: Generic EmailAddress _
+instance showEmailAddress :: Show EmailAddress where
+  show = genericShow
+instance eqEmailAddress :: Eq EmailAddress where
+  eq = genericEq
 
 -- | Converts an email address to a 'String'
 toString :: EmailAddress -> String
@@ -60,7 +67,7 @@ domain = dottedAtoms <|> domainLiteral
 dottedAtoms :: EmailParser String
 dottedAtoms = intercalate "." <$> inner1
   where
-    inner1 :: EmailParser (List String)
+    inner1 :: EmailParser (NonEmptyList String)
     inner1 = inner2 `sepBy1` char '.'
 
     inner2 :: EmailParser String
@@ -81,8 +88,8 @@ domainLiteral = do
     pure $ "[" <> fold domainText <> "]"
 
 isDomainText :: Char -> Boolean
-isDomainText x = inClassRange (fromCharCode 33) (fromCharCode 90) x
-              || inClassRange (fromCharCode 94) (fromCharCode 126) x
+isDomainText x = inClassRange (unsafeFromCharCode 33) (unsafeFromCharCode 90) x
+              || inClassRange (unsafeFromCharCode 94) (unsafeFromCharCode 126) x
               || isObsNoWsCtl x
 
 quotedString :: EmailParser String
@@ -123,9 +130,9 @@ quotedContent :: EmailParser String
 quotedContent = takeWhile1 isQuotedText <|> quotedPair
 
 isQuotedText :: Char -> Boolean
-isQuotedText x = inClass (fromCharArray <<< pure $ fromCharCode 33) x
-              || inClassRange (fromCharCode 35) (fromCharCode 91) x
-              || inClassRange (fromCharCode 93) (fromCharCode 126) x
+isQuotedText x = inClass (singleton $ unsafeFromCharCode 33) x
+              || inClassRange (unsafeFromCharCode 35) (unsafeFromCharCode 91) x
+              || inClassRange (unsafeFromCharCode 93) (unsafeFromCharCode 126) x
               || isObsNoWsCtl x
 
 quotedPair :: EmailParser String
@@ -139,7 +146,7 @@ quotedPair = do
         vchar <|> whiteSpace <|> lf <|> cr <|> obsNoWsCtl <|> nullChar
 
 isVchar :: Char -> Boolean
-isVchar = inClassRange (fromCharCode 33) (fromCharCode 126)
+isVchar = inClassRange (unsafeFromCharCode 33) (unsafeFromCharCode 126)
 
 vchar :: EmailParser Char
 vchar = satisfy isVchar
@@ -152,13 +159,16 @@ comment = do
     pure unit
 
 isCommentText :: Char -> Boolean
-isCommentText x = inClassRange (fromCharCode 33) (fromCharCode 39) x
-               || inClassRange (fromCharCode 42) (fromCharCode 91) x
-               || inClassRange (fromCharCode 93) (fromCharCode 126) x
+isCommentText x = inClassRange (unsafeFromCharCode 33) (unsafeFromCharCode 39) x
+               || inClassRange (unsafeFromCharCode 42) (unsafeFromCharCode 91) x
+               || inClassRange (unsafeFromCharCode 93) (unsafeFromCharCode 126) x
                || isObsNoWsCtl x
 
+unsafeFromCharCode :: Int -> Char
+unsafeFromCharCode = unsafePartial $ fromJust <<< fromCharCode
+
 nullChar :: EmailParser Char
-nullChar = char $ fromCharCode 0
+nullChar = char $ unsafeFromCharCode 0
 
 skipWhile1 :: (Char -> Boolean) -> EmailParser Unit
 skipWhile1 x = do
@@ -194,8 +204,8 @@ crlf :: EmailParser Unit
 crlf = void $ cr *> lf
 
 isObsNoWsCtl :: Char -> Boolean
-isObsNoWsCtl c = inClassRange (fromCharCode 1) (fromCharCode 8) c
-              || inClassRange (fromCharCode 14) (fromCharCode 31) c
+isObsNoWsCtl c = inClassRange (unsafeFromCharCode 1) (unsafeFromCharCode 8) c
+              || inClassRange (unsafeFromCharCode 14) (unsafeFromCharCode 31) c
               || inClass "\11\12\127" c
 
 obsNoWsCtl :: EmailParser Char
@@ -213,6 +223,5 @@ atom = takeWhile1 isAtomText
     isAtomText :: Char -> Boolean
     isAtomText x = isAlphaNum x || inClass "!#$%&'*+/=?^_`{|}~-" x
 
-
 takeWhile1 :: (Char -> Boolean) -> EmailParser String
 takeWhile1 f = fold <<< map singleton <$> (many1 $ satisfy f)
diff --git a/test/Main.purs b/test/Main.purs
@@ -2,48 +2,50 @@ module Test.Main where
 
 import Prelude
 
-import Control.Monad.Aff (Aff)
-import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Class (liftEff)
-import Control.Monad.Eff.Console (CONSOLE, log)
 import Data.Char (fromCharCode)
 import Data.Either (Either(..))
 import Data.Foldable (traverse_)
-import Data.String (singleton)
+import Data.Maybe (fromJust)
+import Data.String.CodeUnits (singleton)
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+import Partial.Unsafe (unsafePartial)
 import Test.Spec (Spec, describe, it)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.Reporter.Console (consoleReporter)
-import Test.Spec.Runner (RunnerEffects, run)
+import Test.Spec.Runner (run)
 import Text.Email.Validate (runEmailParser)
 
-main :: Eff (RunnerEffects ()) Unit
+main :: Effect Unit
 main = run [consoleReporter] do
     describe "email validation" do
         traverse_ runUnitTests units
 
-runUnitTests :: forall e . EmailUnitTest -> Spec (console :: CONSOLE | e) Unit
+runUnitTests :: EmailUnitTest -> Spec Unit
 runUnitTests emailUnitTest@(EmailUnitTest {email: e, shouldPass: result, errorString: err }) = do
     let msg = if result
                 then "email address " <> e <> " is good"
                 else "email address " <> e <> " is bad because: " <> err
     it msg do
-        result <- doUnitTest
-        result `shouldEqual` true
+        result' <- doUnitTest
+        result' `shouldEqual` true
   where
-    doUnitTest :: Aff (console :: CONSOLE | e) Boolean
+    doUnitTest :: Aff Boolean
     doUnitTest = do
         let eitherParseResult = runEmailParser e
         case eitherParseResult of
              Left error -> do
                  when (result == true) $
-                    liftEff $ log $ "ERROR parsing "
+                    liftEffect $ log $ "ERROR parsing "
                                  <> e
                                  <> ": "
                                  <> show error
                  pure (not result)
              Right emailAddress -> do
                  when (result == false) $
-                    liftEff $ log $ "SUCCEED in parsing "
+                    liftEffect $ log $ "SUCCEED in parsing "
                                  <> e
                                  <> ", but should have FAILED because "
                                  <> err
@@ -54,6 +56,9 @@ newtype EmailUnitTest = EmailUnitTest { email :: String
                                       , errorString :: String
                                       }
 
+unsafeFromCharCode :: Int -> Char
+unsafeFromCharCode = unsafePartial $ fromJust <<< fromCharCode
+
 mkUnitTest :: String -> Boolean -> String -> EmailUnitTest
 mkUnitTest email shouldPass errorString =
     EmailUnitTest ({ email : email, shouldPass : shouldPass, errorString : errorString })
@@ -250,6 +255,6 @@ units = [ mkUnitTest "first.last@example.com" true ""
         , mkUnitTest "test.\r\n \r\n obs@syntax.com" true "obs-fws allows multiple lines"
         , mkUnitTest "test. \r\n \r\n obs@syntax.com" true "obs-fws allows multiple lines (test 2: space before break)"
         , mkUnitTest "test.\r\n\r\n obs@syntax.com" false "obs-fws must have at least one WSP per line"
-        , mkUnitTest ("\"null \\" <> singleton (fromCharCode 0) <> "\"@char.com") true "can have escaped null character"
-        , mkUnitTest ("\"null " <> singleton (fromCharCode 0) <> "\"@char.com") false "cannot have unescaped null character"
+        , mkUnitTest ("\"null \\" <> singleton (unsafeFromCharCode 0) <> "\"@char.com") true "can have escaped null character"
+        , mkUnitTest ("\"null " <> singleton (unsafeFromCharCode 0) <> "\"@char.com") false "cannot have unescaped null character"
         ]