made logging in parsing more generic
This commit is contained in:
parent
53290132e7
commit
b930a78f66
4 changed files with 14 additions and 13 deletions
|
|
@ -29,7 +29,7 @@ import Utilities
|
|||
|
||||
main :: IO ()
|
||||
main = do
|
||||
Shake.shakeArgs Shake.shakeOptions $ do
|
||||
Shake.shakeArgs Shake.shakeOptions {Shake.shakeProgress = Shake.progressSimple} $ do
|
||||
Shake.withTargetDocs "Build the site" $
|
||||
"build" ~> buildSite
|
||||
Shake.withTargetDocs "Clean the built site" $
|
||||
|
|
|
|||
|
|
@ -7,27 +7,28 @@ module Markdown where
|
|||
|
||||
import Control.Applicative (many, optional, some, (<|>))
|
||||
import Control.Monad (guard, void)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Data.Char (isAlpha)
|
||||
import Data.Functor.Identity (Identity)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Void (Void)
|
||||
import IR
|
||||
import Logger (Logger (logDebug))
|
||||
import Text.Megaparsec (ParsecT, anySingle, anySingleBut, between, choice, count, eof, manyTill, notFollowedBy, satisfy, skipSome, try, (<?>))
|
||||
import qualified Text.Megaparsec as MP
|
||||
import Text.Megaparsec.Char (alphaNumChar, char, digitChar, string)
|
||||
|
||||
type ParserT m = ParsecT Void String m
|
||||
|
||||
type Parser = ParserT IO
|
||||
type Parser = ParserT Identity
|
||||
|
||||
log_ :: String -> Parser ()
|
||||
log_ = lift . putStrLn
|
||||
log_ :: T.Text -> Parser ()
|
||||
log_ = logDebug
|
||||
|
||||
logP :: (Show s) => Parser s -> Parser s
|
||||
logP v = do
|
||||
underlying <- v
|
||||
log_ $ show underlying
|
||||
logDebug $ T.show underlying
|
||||
v
|
||||
|
||||
anyChar :: Parser Char
|
||||
|
|
@ -331,7 +332,7 @@ plainTextNo disallow = do
|
|||
log_ "a"
|
||||
firstChar <- noneOf disallow <?> "Plain Text Initial Disallow"
|
||||
log_ "b"
|
||||
remChars <- manyTill (plainTextCharNo disallow) lineEnding <?> "Remaining Characters"
|
||||
remChars <- many $ notFollowedBy lineEnding *> plainTextCharNo disallow
|
||||
pure $ Text $ T.map wspHandler $ T.pack $ firstChar : remChars
|
||||
where
|
||||
wspHandler '\n' = ' '
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ module Utilities where
|
|||
|
||||
import Config
|
||||
import Control.Monad (filterM)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Functor.Identity (Identity (runIdentity))
|
||||
import Data.List (find)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
|
@ -38,7 +38,7 @@ indexHtmlMarkdownSourcePath =
|
|||
markdownToHtml :: (FromJSON a) => FilePath -> Action (a, Text)
|
||||
markdownToHtml filePath = do
|
||||
content <- Shake.readFile' filePath
|
||||
parse <- liftIO $ runParserT (liftA2 (,) Markdown.metadata Markdown.document) filePath content
|
||||
let parse = runIdentity $ runParserT (liftA2 (,) Markdown.metadata Markdown.document) filePath content
|
||||
let (metadataText, document) = case parse of
|
||||
Right (a, b) -> (a, b)
|
||||
Left e -> error $ errorBundlePretty e
|
||||
|
|
@ -54,7 +54,7 @@ now = Shake.liftIO $ fmap (T.pack . iso8601Show) getCurrentTime
|
|||
markdownToPost :: FilePath -> Action Post
|
||||
markdownToPost path = do
|
||||
content <- Shake.readFile' path
|
||||
parse <- liftIO $ runParserT Markdown.metadata path content
|
||||
let parse = runIdentity $ runParserT Markdown.metadata path content
|
||||
let postData = case parse of
|
||||
Right p -> p
|
||||
Left e -> error $ errorBundlePretty e
|
||||
|
|
|
|||
|
|
@ -29,13 +29,13 @@ executable psb
|
|||
-- .hs or .lhs file containing the Main module.
|
||||
main-is: Main.hs
|
||||
|
||||
other-modules: Config Utilities Templates Types IR Markdown Restruct HTML
|
||||
other-modules: Config Utilities Templates Types IR Markdown Restruct HTML Logger
|
||||
|
||||
default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields
|
||||
default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields FlexibleInstances
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
-- https://hackage.haskell.org/package/texmath
|
||||
build-depends: base >=4.17.2.1, mustache >=2.4.2, shake >= 0.19.8, deriving-aeson >= 0.2.9, aeson, text, time, unordered-containers, yaml, megaparsec >= 9.7.0, transformers >= 0.6.2
|
||||
build-depends: base >=4.17.2.1, mustache >=2.4.2, shake >= 0.19.8, deriving-aeson >= 0.2.9, aeson, text >= 2.1.2, time, unordered-containers, yaml, megaparsec >= 9.7.0, transformers >= 0.6.2
|
||||
--parsec >= 3.1.18.0
|
||||
|
||||
-- Directories containing source files.
|
||||
|
|
|
|||
Loading…
Reference in a new issue