Initial commit

Author: icidasset

.gitignore

@@ -0,0 +1,2 @@
+/.stack-work
+/*.cabal

README.md

@@ -0,0 +1,7 @@
+__Elm Proofread.__  
+_This command-line tool runs your Elm documentation tests._
+
+
+```shell
+elm-proofread src/Main.elm
+```

bin/Main.hs

@@ -0,0 +1,71 @@
+module Main where
+
+import Data.Maybe (listToMaybe)
+import Data.Text (Text)
+import Proofread (Result(..))
+import Protolude
+import System.Console.Pretty
+import System.Environment (getArgs)
+
+import qualified Data.Text as Text
+import qualified Proofread
+
+
+-- 🍯
+
+
+main :: IO ()
+main = do
+    args <- getArgs
+
+    -- Fun w/ flags
+    let maybeFilePath = listToMaybe (excludeFlags args)
+
+    -- Format!
+    case maybeFilePath of
+        Just filePath   -> formatFile filePath
+        Nothing         -> putError "Argument missing"
+
+
+
+-- 📮
+
+
+{-| Format contents from a file.
+-}
+formatFile :: [Char] -> IO ()
+formatFile filePath = do
+    contents <- readFile filePath
+
+    let prefix = Text.pack (filePath ++ " → ")
+
+    case traceShowId (Proofread.proofread contents) of
+        Ok result   -> putSuccess (prefix <> "✔")
+        Err err     -> putError (prefix <> "✘") >> putError err >> exitFailure
+
+
+
+-- ⛳️
+
+
+excludeFlags :: [[Char]] -> [[Char]]
+excludeFlags = filter excludeFlag
+
+
+excludeFlag :: [Char] -> Bool
+excludeFlag ('-' : _) = False
+excludeFlag _ = True
+
+
+
+-- 🚦
+
+
+putError :: Text -> IO ()
+putError err =
+    putStr ( color Red err )
+
+
+putSuccess :: Text -> IO ()
+putSuccess msg =
+    putStr ( color Green msg )

package.yaml

@@ -0,0 +1,47 @@
+name: elm-proofread
+version: 0.1.0
+synopsis: Elm documentation testing.
+description: See README at <https://github.com/icidasset/elm-proofread#readme>
+maintainer: Steven Vandevelde <[email protected]>
+license: MIT
+github: icidasset/elm-proofread
+category: Development
+
+
+default-extensions:
+  DisambiguateRecordFields
+  DuplicateRecordFields
+  NoImplicitPrelude
+  OverloadedStrings
+
+
+ghc-options:
+  -Wall
+  -Wcompat
+  -Wincomplete-record-updates
+  -Wincomplete-uni-patterns
+  -Wredundant-constraints
+
+
+dependencies:
+  - base >= 4.7 && < 5
+  - flow == 1.*
+  - megaparsec == 6.5.*
+  - parser-combinators == 1.*
+  - pretty-terminal
+  - protolude == 0.2.*
+  - text == 1.*
+
+
+library:
+  source-dirs: src
+  exposed-modules:
+    Proofread
+
+
+executables:
+  elm-proofread:
+    main: Main.hs
+    source-dirs: bin
+    dependencies:
+      - elm-proofread

src/Proofread.hs

@@ -0,0 +1,42 @@
+{-
+
+ELM PROOFREAD
+=============
+
+-}
+module Proofread
+    ( Document(..)
+    , Result(..)
+    , Test(..)
+    , proofread
+    ) where
+
+import Flow
+import Proofread.Types
+import Protolude
+
+import qualified Data.Text as Text
+import qualified Proofread.Parser as Parser
+
+
+-- 🌳
+
+
+data Result
+    = Ok Document
+    | Err Text
+    deriving (Show)
+
+
+
+-- 📮
+
+
+proofread :: Text -> Result
+proofread contents =
+    case Parser.parse contents of
+        Parser.Ok document ->
+            Ok document
+
+        Parser.Err err ->
+            Err err

src/Proofread/Parser.hs

@@ -0,0 +1,119 @@
+{-
+
+PARSER
+======
+
+-}
+module Proofread.Parser
+    ( Proofread.Parser.parse
+    , Result(..)
+    ) where
+
+import Control.Monad.Combinators
+import Data.Text (Text)
+import Flow
+import Proofread.Parser.Types
+import Proofread.Parser.Utilities
+import Proofread.Types
+import Protolude hiding (and, one, or, some, try)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+
+import qualified Data.List as List
+import qualified Data.Text as Text
+import qualified Text.Megaparsec as Mega
+
+
+-- 🌳
+
+
+data Result
+    = Ok Document
+    | Err Text
+    deriving (Show)
+
+
+
+-- ⚡️
+
+
+parse :: Text -> Result
+parse contents =
+    contents
+        |> Text.unpack
+        |> Mega.parse document ""
+        |> either (parseErrorPretty .> Text.pack .> Err) Ok
+
+
+
+-- 📮
+
+
+document :: Parser Document
+document = do
+    _                   <- maybeSome whitespace
+    m                   <- one docModule
+    _                   <- maybeSome whitespace
+    t                   <- maybeSome test
+
+    return $ Document m t
+
+
+
+-- MODULE
+
+
+docModule :: Parser Text
+docModule = do
+    _                   <- one (string "module ")
+    moduleName          <- some (alphaNumChar `or` char '.' `or` char '_')
+    _                   <- one spaceCharacter
+    _                   <- manyTill anyChar (string "\n\n")
+
+    return $ Text.pack moduleName
+
+
+
+-- TESTS
+
+
+test :: Parser Test
+test =
+    try (skipManyTill anyChar testInMultiLineComment)
+
+
+
+{-| Parser for a test in a multiline comment.
+-}
+testInMultiLineComment :: Parser Test
+testInMultiLineComment = do
+    _                   <- one (string " >>> ")
+    startInput          <- someTill anyChar eol
+    additionalInput     <- maybeSome (try mlExtra)
+    _                   <- maybeSome whitespace
+    expectedOutput      <- manyTill anyChar (try mlEnd)
+
+    return $ Test
+        { input =
+            additionalInput
+                |> (<>) [ startInput, if length additionalInput > 0 then "\n" else "" ]
+                |> List.concat
+                |> Text.pack
+
+        , output =
+            Text.pack expectedOutput
+        }
+
+
+mlExtra :: Parser [Char]
+mlExtra = do
+    _                   <- some whitespace
+    _                   <- one (string "..> ")
+    input               <- manyTill anyChar eol
+
+    return input
+
+
+mlEnd :: Parser [Char]
+mlEnd =
+    eol `andThen` maybeSome spaceCharacter `andThen` (eol `or` string "-}")

src/Proofread/Parser/Types.hs

@@ -0,0 +1,11 @@
+module Proofread.Parser.Types where
+
+import Data.Void (Void)
+import Protolude (Char)
+import Text.Megaparsec (Parsec)
+
+
+-- 🌳
+
+
+type Parser = Parsec Void [Char]

src/Proofread/Parser/Utilities.hs

@@ -0,0 +1,50 @@
+module Proofread.Parser.Utilities where
+
+import Control.Applicative (Alternative, (<|>))
+import Prelude hiding (or)
+import Proofread.Parser.Types
+import Text.Megaparsec.Char
+
+import qualified Control.Applicative
+
+
+-- ⚗️ Combinators
+
+
+and :: (Applicative f, Monoid a) => f a -> f a -> f a
+and =
+    Control.Applicative.liftA2 mappend
+
+
+andThen :: Monad m => m a -> m b -> m b
+andThen =
+    (>>)
+
+
+or :: Alternative f => f a -> f a -> f a
+or =
+    (<|>)
+
+
+one :: a -> a
+one =
+    id
+
+
+maybeSome :: Alternative f => f a -> f [a]
+maybeSome =
+    Control.Applicative.many
+
+
+
+-- 🤖 Predefined combinations
+
+
+spaceCharacter :: Parser Char
+spaceCharacter =
+    char ' '
+
+
+whitespace :: Parser Char
+whitespace =
+    spaceChar

src/Proofread/Types.hs

@@ -0,0 +1,17 @@
+module Proofread.Types where
+
+import Data.Text (Text)
+import Protolude (Show)
+
+
+-- 🌳
+
+
+data Document =
+    Document Text [ Test ]
+    deriving (Show)
+
+
+data Test = Test
+    { input :: Text, output :: Text }
+    deriving (Show)

stack.yaml

@@ -0,0 +1,2 @@
+resolver: lts-12.16
+extra-deps: [ pretty-terminal-0.1.0.0 ]