Merge pull request #85 from paulyoung/paulyoung/0.12

Updates for 0.12

Author: garyb

README.md

@@ -34,10 +34,6 @@ import Text.Markdown.SlamDown.Pretty
 Module documentation is [published on
 Pursuit](http://pursuit.purescript.org/packages/purescript-markdown).
 
-### Tests
-
-The tests use [purescript-strongcheck](http://github.com/purescript-contrib/purescript-strongcheck) to verify that an arbitrary `SlamDown` document can be rendered as a `String` and then parsed to a `SlamDown` equal to the original.
-
 ## Features
 
 In general, SlamDown is a subset of [CommonMark](http://spec.commonmark.org/), supporting the following features:

bower.json

@@ -22,18 +22,20 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-const": "^3.0.0",
-    "purescript-functors": "^2.0.0",
-    "purescript-lists": "^4.0.0",
-    "purescript-parsing": "^4.0.0",
-    "purescript-partial": "^1.2.0",
-    "purescript-precise": "^2.0.0",
-    "purescript-prelude": "^3.0.0",
-    "purescript-sets": "^3.0.0",
-    "purescript-strings": "^3.0.0",
-    "purescript-strongcheck": "^3.0.0",
-    "purescript-unicode": "^3.0.1",
-    "purescript-validation": "^3.0.0",
-    "purescript-datetime": "^3.0.0"
+    "purescript-const": "^4.0.0",
+    "purescript-datetime": "^4.0.0",
+    "purescript-functors": "^3.0.1",
+    "purescript-lists": "^5.0.0",
+    "purescript-ordered-collections": "^1.0.0",
+    "purescript-parsing": "^5.0.1",
+    "purescript-partial": "^2.0.0",
+    "purescript-precise": "^3.0.1",
+    "purescript-prelude": "^4.0.1",
+    "purescript-strings": "^4.0.0",
+    "purescript-unicode": "^4.0.1",
+    "purescript-validation": "^4.0.0"
+  },
+  "devDependencies": {
+    "purescript-assert": "^4.0.0"
   }
 }

package.json

@@ -6,9 +6,9 @@
     "test": "pulp test"
   },
   "devDependencies": {
-    "pulp": "^11.0.0",
-    "purescript": "^0.11.4",
-    "purescript-psa": "^0.5.0",
+    "pulp": "^12.3.0",
+    "purescript": "^0.12.0",
+    "purescript-psa": "^0.6.0",
     "rimraf": "^2.5.4"
   }
 }

src/Text/Markdown/SlamDown/Parser.purs

@@ -11,8 +11,8 @@ import Data.Foldable (any, all)
 import Data.List ((:))
 import Data.List as L
 import Data.Maybe as M
-import Data.Monoid (mempty)
-import Data.String as S
+import Data.String (Pattern(..), Replacement(..), drop, length, replace, split, take, trim) as S
+import Data.String.CodeUnits (countPrefix, dropWhile, singleton) as S
 import Data.String.Regex as RGX
 import Data.String.Regex.Unsafe as URX
 import Data.String.Regex.Flags as RXF
@@ -59,7 +59,7 @@ allChars p = all p <<< S.split (S.Pattern "")
 
 removeNonIndentingSpaces ∷ String → String
 removeNonIndentingSpaces s
-  | S.count (isSpace <<< S.singleton) s < 4 = S.dropWhile (isSpace <<< S.singleton) s
+  | S.countPrefix (isSpace <<< S.singleton) s < 4 = S.dropWhile (isSpace <<< S.singleton) s
   | otherwise = s
 
 isRuleChar ∷ String → Boolean
@@ -77,15 +77,15 @@ isRule s =
 isATXHeader ∷ String → Boolean
 isATXHeader s =
   let
-    level = S.count (\c → S.singleton c == "#") s
+    level = S.countPrefix (\c → S.singleton c == "#") s
     rest = S.drop level s
   in
     level >= 1 && level <= 6 && S.take 1 rest == " "
 
 splitATXHeader ∷ String → { level ∷ Int, contents ∷ String }
 splitATXHeader s =
   let
-    level = S.count (\c → S.singleton c == "#") s
+    level = S.countPrefix (\c → S.singleton c == "#") s
     contents = S.drop (level + 1) s
   in
     { level: level
@@ -120,7 +120,7 @@ splitBlockquote ss =
   blockquoteContents s = S.drop (if S.take 2 s == "> " then 2 else 1) s
 
 countLeadingSpaces ∷ String → Int
-countLeadingSpaces = S.count (isSpace <<< S.singleton)
+countLeadingSpaces = S.countPrefix (isSpace <<< S.singleton)
 
 isBulleted ∷ String → Boolean
 isBulleted s =
@@ -139,7 +139,7 @@ isBulleted s =
 isOrderedListMarker ∷ String → Boolean
 isOrderedListMarker s =
   let
-    n = S.count (isDigit <<< S.singleton) s
+    n = S.countPrefix (isDigit <<< S.singleton) s
     next = S.take 1 (S.drop n s)
     ls = countLeadingSpaces (S.drop (n + 1) s)
   in
@@ -149,14 +149,14 @@ listItemType ∷ String → SD.ListType
 listItemType s
   | isBulleted s = SD.Bullet (S.take 1 s)
   | otherwise =
-      let n = S.count (isDigit <<< S.singleton) s
+      let n = S.countPrefix (isDigit <<< S.singleton) s
       in SD.Ordered (S.take 1 (S.drop n s))
 
 listItemIndent ∷ String → Int
 listItemIndent s
   | isBulleted s = 1 + min 4 (countLeadingSpaces (S.drop 1 s))
   | otherwise =
-      let n = S.count (isDigit <<< S.singleton) s
+      let n = S.countPrefix (isDigit <<< S.singleton) s
       in n + 1 + min 4 (countLeadingSpaces (S.drop (n + 1) s))
 
 isListItemLine ∷ String → Boolean
@@ -210,7 +210,7 @@ splitIndentedChunks ss =
 isCodeFence ∷ String → Boolean
 isCodeFence s = isSimpleFence s || (isEvaluatedCode s && isSimpleFence (S.drop 1 s))
   where
-  isSimpleFence s' = S.count (isFenceChar <<< S.singleton) s' >= 3
+  isSimpleFence s' = S.countPrefix (isFenceChar <<< S.singleton) s' >= 3
 
 isEvaluatedCode ∷ String → Boolean
 isEvaluatedCode s = S.take 1 s == "!"
@@ -243,7 +243,7 @@ splitCodeFence indent fence ss =
     }
   where
   isClosingFence ∷ String → Boolean
-  isClosingFence s = S.count (\c → S.singleton c == fence) (removeNonIndentingSpaces s) >= 3
+  isClosingFence s = S.countPrefix (\c → S.singleton c == fence) (removeNonIndentingSpaces s) >= 3
 
   removeIndentTo ∷ String → String
   removeIndentTo s = S.drop (min indent (countLeadingSpaces s)) s

src/Text/Markdown/SlamDown/Parser/Inline.purs

@@ -23,7 +23,8 @@ import Data.HugeNum as HN
 import Data.Int as Int
 import Data.List as L
 import Data.Maybe as M
-import Data.String as S
+import Data.String (joinWith, trim) as S
+import Data.String.CodeUnits (fromCharArray, singleton, toCharArray) as S
 import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..), fst, snd)
 import Data.Validation.Semigroup as V
@@ -278,7 +279,7 @@ inlines = L.many inline2 <* PS.eof
         M.Nothing → pure $ Right $ SD.TextBox $ SD.transTextBox (const $ Compose M.Nothing) template
         M.Just _ → do
           PU.skipSpaces
-          mdef ← PC.optionMaybe $ PC.try $ parseTextBox (_ /= ')') (expr id) template
+          mdef ← PC.optionMaybe $ PC.try $ parseTextBox (_ /= ')') (expr identity) template
           case mdef of
             M.Just def → do
               PU.skipSpaces
@@ -386,8 +387,8 @@ inlines = L.many inline2 <* PS.eof
     dropDown ∷ P.Parser String (SD.FormField a)
     dropDown = do
       let item = SD.stringValue <<< S.trim <$> manyOf \c → not $ c `elem` ['{','}',',','!','`','(',')']
-      ls ← PU.braces $ expr id $ (PC.try (PU.skipSpaces *> item)) `PC.sepBy` (PU.skipSpaces *> PS.string ",")
-      sel ← PC.optionMaybe $ PU.skipSpaces *> (PU.parens $ expr id $ item)
+      ls ← PU.braces $ expr identity $ (PC.try (PU.skipSpaces *> item)) `PC.sepBy` (PU.skipSpaces *> PS.string ",")
+      sel ← PC.optionMaybe $ PU.skipSpaces *> (PU.parens $ expr identity $ item)
       pure $ SD.DropDown sel ls
 
   other ∷ P.Parser String (SD.Inline a)

src/Text/Markdown/SlamDown/Parser/References.purs

@@ -7,7 +7,8 @@ import Prelude
 import Data.Array as A
 import Data.Either as E
 import Data.Maybe as M
-import Data.String as S
+import Data.String (trim) as S
+import Data.String.CodeUnits (fromCharArray) as S
 
 import Text.Parsing.Parser as P
 import Text.Parsing.Parser.Combinators as PC

src/Text/Markdown/SlamDown/Parser/Utils.purs

@@ -10,7 +10,7 @@ module Text.Markdown.SlamDown.Parser.Utils
 import Prelude
 
 import Data.Either (fromRight)
-import Data.String (singleton)
+import Data.String.CodeUnits (singleton)
 import Data.String.Regex as R
 import Data.String.Regex.Flags as RF
 

src/Text/Markdown/SlamDown/Pretty.purs

@@ -14,9 +14,9 @@ import Data.Identity (Identity(..))
 import Data.List as L
 import Data.Maybe as M
 import Data.Enum (fromEnum)
-import Data.Monoid (mempty)
 import Data.Newtype (unwrap)
-import Data.String as S
+import Data.String (Pattern(..), indexOf, joinWith, length, split, stripSuffix) as S
+import Data.String.CodeUnits (fromCharArray) as S
 import Data.Unfoldable as U
 
 import Text.Markdown.SlamDown.Syntax as SD
@@ -174,11 +174,11 @@ prettyPrintTextBox t =
     prettyPrintDefault ∷ SD.TextBox SD.Expr → String
     prettyPrintDefault =
       case _ of
-        SD.PlainText def → prettyPrintExpr id id def
-        SD.Numeric def → prettyPrintExpr id HN.toString def
-        SD.Date def → prettyPrintExpr id prettyPrintDate def
-        SD.Time prec def → prettyPrintExpr id (prettyPrintTime prec) def
-        SD.DateTime prec def → prettyPrintExpr id (prettyPrintDateTime prec) def
+        SD.PlainText def → prettyPrintExpr identity identity def
+        SD.Numeric def → prettyPrintExpr identity HN.toString def
+        SD.Date def → prettyPrintExpr identity prettyPrintDate def
+        SD.Time prec def → prettyPrintExpr identity (prettyPrintTime prec) def
+        SD.DateTime prec def → prettyPrintExpr identity (prettyPrintDateTime prec) def
 
 
 prettyPrintFormElement ∷ ∀ a. (SD.Value a) ⇒ SD.FormField a → String
@@ -200,8 +200,8 @@ prettyPrintFormElement el =
     SD.CheckBoxes (SD.Unevaluated bs) (SD.Unevaluated ls) →
       "[!`" <> bs <> "`] !`" <> ls <> "`"
     SD.DropDown sel lbls →
-      braces (prettyPrintExpr id (A.fromFoldable >>> map SD.renderValue >>> S.joinWith ", ") lbls)
-        <> M.maybe "" (parens <<< prettyPrintExpr id SD.renderValue) sel
+      braces (prettyPrintExpr identity (A.fromFoldable >>> map SD.renderValue >>> S.joinWith ", ") lbls)
+        <> M.maybe "" (parens <<< prettyPrintExpr identity SD.renderValue) sel
     _ → "Unsupported form element"
 
 prettyPrintExpr ∷ ∀ a. (String → String) → (a → String) → SD.Expr a → String

src/Text/Markdown/SlamDown/Syntax.purs

@@ -9,34 +9,28 @@ module Text.Markdown.SlamDown.Syntax
 
 import Prelude
 
+import Data.Eq (class Eq1)
 import Data.List as L
-import Data.Monoid (class Monoid, mempty)
-import Test.StrongCheck.Arbitrary as SCA
-import Test.StrongCheck.Gen as Gen
-
-import Text.Markdown.SlamDown.Syntax.Block as SDB
-import Text.Markdown.SlamDown.Syntax.FormField as SDF
-import Text.Markdown.SlamDown.Syntax.Inline as SDI
+import Data.Ord (class Ord1)
+import Text.Markdown.SlamDown.Syntax.Block (Block(..), CodeBlockType(..), ListType(..)) as SDB
+import Text.Markdown.SlamDown.Syntax.FormField (class Value, Expr(..), FormField, FormFieldP(..), TextBox(..), TimePrecision(..), getLiteral, getUnevaluated, renderValue, stringValue, transFormField, transTextBox, traverseFormField, traverseTextBox) as SDF
+import Text.Markdown.SlamDown.Syntax.Inline (Inline(..), LinkTarget(..)) as SDI
 
 -- | `SlamDownP` is the type of SlamDown abstract syntax trees which take values in `a`.
-data SlamDownP a = SlamDown (L.List (SDB.Block a))
+newtype SlamDownP a = SlamDown (L.List (SDB.Block a))
 
 type SlamDown = SlamDownP String
 
-instance functorSlamDownP ∷ Functor SlamDownP where
-  map f (SlamDown bs) = SlamDown (map f <$> bs)
+derive instance functorSlamDownP ∷ Functor SlamDownP
 
 instance showSlamDownP ∷ (Show a) ⇒ Show (SlamDownP a) where
   show (SlamDown bs) = "(SlamDown " <> show bs <> ")"
 
-derive instance eqSlamDownP ∷ (Eq a, Ord a) ⇒ Eq (SlamDownP a)
-derive instance ordSlamDownP ∷ (Eq a, Ord a) ⇒ Ord (SlamDownP a)
-
-instance semigroupSlamDownP ∷ Semigroup (SlamDownP a) where
-  append (SlamDown bs1) (SlamDown bs2) = SlamDown (bs1 <> bs2)
+derive newtype instance eqSlamDownP ∷ Eq a ⇒ Eq (SlamDownP a)
+derive instance eq1SlamDownP ∷ Eq1 SlamDownP
 
-instance monoidSlamDownP ∷ Monoid (SlamDownP a) where
-  mempty = SlamDown mempty
+derive newtype instance ordSlamDownP ∷ Ord a ⇒ Ord (SlamDownP a)
+derive instance ord1SlamDownP ∷ Ord1 SlamDownP
 
-instance arbitrarySlamDownP ∷ (SCA.Arbitrary a, Eq a) ⇒ SCA.Arbitrary (SlamDownP a) where
-  arbitrary = SlamDown <<< L.fromFoldable <$> Gen.arrayOf SCA.arbitrary
+derive newtype instance semigroupSlamDownP ∷ Semigroup (SlamDownP a)
+derive newtype instance monoidSlamDownP ∷ Monoid (SlamDownP a)

src/Text/Markdown/SlamDown/Syntax/Block.purs

@@ -6,11 +6,9 @@ module Text.Markdown.SlamDown.Syntax.Block
 
 import Prelude
 
+import Data.Eq (class Eq1)
 import Data.List as L
-
-import Test.StrongCheck.Arbitrary as SCA
-import Test.StrongCheck.Gen as Gen
-
+import Data.Ord (class Ord1)
 import Text.Markdown.SlamDown.Syntax.Inline (Inline)
 
 data Block a
@@ -22,18 +20,9 @@ data Block a
   | LinkReference String String
   | Rule
 
-instance functorBlock ∷ Functor Block where
-  map f x =
-    case x of
-      Paragraph is → Paragraph (map f <$> is)
-      Header n is → Header n (map f <$> is)
-      Blockquote bs → Blockquote (map f <$> bs)
-      Lst ty bss → Lst ty (map (map f) <$> bss)
-      CodeBlock ty ss → CodeBlock ty ss
-      LinkReference l uri → LinkReference l uri
-      Rule → Rule
+derive instance functorBlock ∷ Functor Block
 
-instance showBlock ∷ (Show a) ⇒ Show (Block a) where
+instance showBlock ∷ Show a ⇒ Show (Block a) where
   show (Paragraph is) = "(Paragraph " <> show is <> ")"
   show (Header n is) = "(Header " <> show n <> " " <> show is <> ")"
   show (Blockquote bs) = "(Blockquote " <> show bs <> ")"
@@ -42,24 +31,10 @@ instance showBlock ∷ (Show a) ⇒ Show (Block a) where
   show (LinkReference l uri) = "(LinkReference " <> show l <> " " <> show uri <> ")"
   show Rule = "Rule"
 
-derive instance eqBlock ∷ (Eq a, Ord a) ⇒ Eq (Block a)
-derive instance ordBlock ∷ (Ord a) ⇒ Ord (Block a)
-
--- | Nota bene: this does not generate any recursive structure
-instance arbitraryBlock ∷ (SCA.Arbitrary a, Eq a) ⇒ SCA.Arbitrary (Block a) where
-  arbitrary = do
-    k ← Gen.chooseInt 0 6
-    case k of
-      0 → Paragraph <$> listOf SCA.arbitrary
-      1 → Header <$> SCA.arbitrary <*> listOf SCA.arbitrary
-      2 → pure $ Blockquote L.Nil
-      3 → Lst <$> SCA.arbitrary <*> listOf (pure L.Nil)
-      4 → CodeBlock <$> SCA.arbitrary <*> listOf SCA.arbitrary
-      5 → LinkReference <$> SCA.arbitrary <*> SCA.arbitrary
-      _ → pure Rule
-
-listOf ∷ ∀ f a. (Monad f) ⇒ Gen.GenT f a → Gen.GenT f (L.List a)
-listOf = map L.fromFoldable <<< Gen.arrayOf
+derive instance eqBlock ∷ Eq a ⇒ Eq (Block a)
+derive instance eq1Block ∷ Eq1 Block
+derive instance ordBlock ∷ Ord a ⇒ Ord (Block a)
+derive instance ord1Block ∷ Ord1 Block
 
 data ListType
   = Bullet String
@@ -72,11 +47,6 @@ instance showListType ∷ Show ListType where
 derive instance eqListType ∷ Eq ListType
 derive instance ordListType ∷ Ord ListType
 
-instance arbitraryListType ∷ SCA.Arbitrary ListType where
-  arbitrary = do
-    b ← SCA.arbitrary
-    if b then Bullet <$> SCA.arbitrary else Ordered <$> SCA.arbitrary
-
 data CodeBlockType
   = Indented
   | Fenced Boolean String
@@ -87,8 +57,3 @@ instance showCodeBlockType ∷ Show CodeBlockType where
 
 derive instance eqCodeBlockType ∷ Eq CodeBlockType
 derive instance ordCodeBlockType ∷ Ord CodeBlockType
-
-instance arbitraryCodeBlockType ∷ SCA.Arbitrary CodeBlockType where
-  arbitrary = do
-    b ← SCA.arbitrary
-    if b then pure Indented else Fenced <$> SCA.arbitrary <*> SCA.arbitrary