diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,8 @@
+0.14
+===
+
+* Added Web.Rep.Internal.FlatParse (due to markup-parse-2.0 changes)
+
0.13
===
* added sharedPage
diff --git a/app/rep-example.hs b/app/rep-example.hs
--- a/app/rep-example.hs
+++ b/app/rep-example.hs
@@ -1,12 +1,11 @@
{-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
import Box
import Control.Monad
import Data.Bifunctor
-import MarkupParse
+import MarkupParse hiding (Parser)
import Optics.Core hiding (element)
import Options.Applicative
import Web.Rep
diff --git a/readme.md b/readme.md
--- a/readme.md
+++ b/readme.md
@@ -1,16 +1,7 @@
-# Table of Contents
-
-1. [web-rep](#orgebbc06e)
-2. [library reference](#org8d29302)
-3. [Development](#orgddf3f50)
-
-
-
-
# web-rep
-[](https://hackage.haskell.org/package/web-rep) [](https://github.com/tonyday567/web-rep/actions)
+[](https://hackage.haskell.org/package/web-rep) [](https://github.com/tonyday567/web-rep/actions/workflows/haskell-ci.yml)
Various functions and representations for a web page.
@@ -24,16 +15,12 @@
-
-
# library reference
- [scotty](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/flags.html#flag-reference)
- [bootstrap](https://getbootstrap.com/)
- [bootstrap-slider](https://seiyria.com/bootstrap-slider)
-
-
# Development
diff --git a/src/Web/Rep/Examples.hs b/src/Web/Rep/Examples.hs
--- a/src/Web/Rep/Examples.hs
+++ b/src/Web/Rep/Examples.hs
@@ -24,9 +24,9 @@
import FlatParse.Basic (takeRest)
import GHC.Generics
import MarkupParse
-import MarkupParse.FlatParse
import Optics.Core hiding (element)
import Web.Rep
+import Web.Rep.Internal.FlatParse
-- | simple page example
page1 :: Page
diff --git a/src/Web/Rep/Internal/FlatParse.hs b/src/Web/Rep/Internal/FlatParse.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Rep/Internal/FlatParse.hs
@@ -0,0 +1,338 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | flatparse parsing helpers
+--
+-- This module is exposed only for testing via doctest-parallel and is not intended to form part of the stable API.
+module Web.Rep.Internal.FlatParse
+ ( -- * Parsing
+ runParserMaybe,
+ runParserEither,
+ runParser_,
+
+ -- * Flatparse re-exports
+ runParser,
+ Parser,
+ Result (..),
+
+ -- * Parsers
+ isWhitespace,
+ ws_,
+ ws,
+ wss,
+ nota,
+ isa,
+ sq,
+ dq,
+ wrappedDq,
+ wrappedSq,
+ wrappedQ,
+ wrappedQNoGuard,
+ eq,
+ sep,
+ bracketed,
+ bracketedSB,
+ wrapped,
+ digit,
+ digits,
+ int,
+ double,
+ minus,
+ signed,
+ byteStringOf',
+ comma,
+ )
+where
+
+import Data.Bool
+import Data.ByteString (ByteString)
+import Data.Char hiding (isDigit)
+import FlatParse.Basic hiding (cut, take)
+import GHC.Exts
+import Prelude hiding (replicate)
+
+-- $setup
+-- >>> :set -XTemplateHaskell
+-- >>> :set -XOverloadedStrings
+-- >>> import Web.Rep.Internal.FlatParse
+-- >>> import FlatParse.Basic
+
+-- | Run a Parser, throwing away leftovers. Nothing on 'Fail' or 'Err'.
+--
+-- >>> runParserMaybe ws "x"
+-- Nothing
+--
+-- >>> runParserMaybe ws " x"
+-- Just ' '
+runParserMaybe :: Parser e a -> ByteString -> Maybe a
+runParserMaybe p b = case runParser p b of
+ OK r _ -> Just r
+ Fail -> Nothing
+ Err _ -> Nothing
+
+-- | Run a Parser, throwing away leftovers. Returns Left on 'Fail' or 'Err'.
+--
+-- >>> runParserEither ws " x"
+-- Right ' '
+runParserEither :: (IsString e) => Parser e a -> ByteString -> Either e a
+runParserEither p bs = case runParser p bs of
+ Err e -> Left e
+ OK a _ -> Right a
+ Fail -> Left "uncaught parse error"
+
+---- | Run parser, discards leftovers & throws an error on failure.
+--
+-- >>> runParser_ ws " "
+-- ' '
+--
+-- >>> runParser_ ws "x"
+
+-- *** Exception: uncaught parse error
+
+-- ...
+runParser_ :: Parser String a -> ByteString -> a
+runParser_ p bs = case runParser p bs of
+ Err e -> error e
+ OK a "" -> a
+ OK _ _ -> error "leftovers"
+ Fail -> error "uncaught parse error"
+
+-- | Consume whitespace.
+--
+-- >>> runParser ws_ " \nx"
+-- OK () "x"
+--
+-- >>> runParser ws_ "x"
+-- OK () "x"
+ws_ :: Parser e ()
+ws_ =
+ $( switch
+ [|
+ case _ of
+ " " -> ws_
+ "\n" -> ws_
+ "\t" -> ws_
+ "\r" -> ws_
+ "\f" -> ws_
+ _ -> pure ()
+ |]
+ )
+{-# INLINE ws_ #-}
+
+-- | \\n \\t \\f \\r and space
+isWhitespace :: Char -> Bool
+isWhitespace ' ' = True -- \x20 space
+isWhitespace '\x0a' = True -- \n linefeed
+isWhitespace '\x09' = True -- \t tab
+isWhitespace '\x0c' = True -- \f formfeed
+isWhitespace '\x0d' = True -- \r carriage return
+isWhitespace _ = False
+{-# INLINE isWhitespace #-}
+
+-- | single whitespace
+--
+-- >>> runParser ws " \nx"
+-- OK ' ' "\nx"
+ws :: Parser e Char
+ws = satisfy isWhitespace
+
+-- | multiple whitespace
+--
+-- >>> runParser wss " \nx"
+-- OK " \n" "x"
+--
+-- >>> runParser wss "x"
+-- Fail
+wss :: Parser e ByteString
+wss = byteStringOf $ some ws
+
+-- | Single quote
+--
+-- >>> runParserMaybe sq "'"
+-- Just ()
+sq :: ParserT st e ()
+sq = $(char '\'')
+
+-- | Double quote
+--
+-- >>> runParserMaybe dq "\""
+-- Just ()
+dq :: ParserT st e ()
+dq = $(char '"')
+
+-- | Parse whilst not a specific character
+--
+-- >>> runParser (nota 'x') "abcxyz"
+-- OK "abc" "xyz"
+nota :: Char -> Parser e ByteString
+nota c = withSpan (skipMany (satisfy (/= c))) (\() s -> unsafeSpanToByteString s)
+{-# INLINE nota #-}
+
+-- | Parse whilst satisfying a predicate.
+--
+-- >>> runParser (isa (=='x')) "xxxabc"
+-- OK "xxx" "abc"
+isa :: (Char -> Bool) -> Parser e ByteString
+isa p = withSpan (skipMany (satisfy p)) (\() s -> unsafeSpanToByteString s)
+{-# INLINE isa #-}
+
+-- | 'byteStringOf' but using withSpan internally. Doesn't seems faster...
+byteStringOf' :: Parser e a -> Parser e ByteString
+byteStringOf' p = withSpan p (\_ s -> unsafeSpanToByteString s)
+{-# INLINE byteStringOf' #-}
+
+-- | A single-quoted string.
+wrappedSq :: Parser b ByteString
+wrappedSq = $(char '\'') *> nota '\'' <* $(char '\'')
+{-# INLINE wrappedSq #-}
+
+-- | A double-quoted string.
+wrappedDq :: Parser b ByteString
+wrappedDq = $(char '"') *> nota '"' <* $(char '"')
+{-# INLINE wrappedDq #-}
+
+-- | A single-quoted or double-quoted string.
+--
+-- >>> runParserMaybe wrappedQ "\"quoted\""
+-- Just "quoted"
+--
+-- >>> runParserMaybe wrappedQ "'quoted'"
+-- Just "quoted"
+wrappedQ :: Parser e ByteString
+wrappedQ =
+ wrappedDq
+ <|> wrappedSq
+{-# INLINE wrappedQ #-}
+
+-- | A single-quoted or double-quoted wrapped parser.
+--
+-- >>> runParser (wrappedQNoGuard (many $ satisfy (/= '"'))) "\"name\""
+-- OK "name" ""
+--
+-- Will consume quotes if the underlying parser does.
+--
+-- >>> runParser (wrappedQNoGuard (many anyChar)) "\"name\""
+-- Fail
+wrappedQNoGuard :: Parser e a -> Parser e a
+wrappedQNoGuard p = wrapped dq p <|> wrapped sq p
+
+-- | xml production [25]
+--
+-- >>> runParserMaybe eq " = "
+-- Just ()
+--
+-- >>> runParserMaybe eq "="
+-- Just ()
+eq :: Parser e ()
+eq = ws_ *> $(char '=') <* ws_
+{-# INLINE eq #-}
+
+-- | Some with a separator.
+--
+-- >>> runParser (sep ws (many (satisfy (/= ' ')))) "a b c"
+-- OK ["a","b","c"] ""
+sep :: Parser e s -> Parser e a -> Parser e [a]
+sep s p = (:) <$> p <*> many (s *> p)
+
+-- | Parser bracketed by two other parsers.
+--
+-- >>> runParser (bracketed ($(char '[')) ($(char ']')) (many (satisfy (/= ']')))) "[bracketed]"
+-- OK "bracketed" ""
+bracketed :: Parser e b -> Parser e b -> Parser e a -> Parser e a
+bracketed o c p = o *> p <* c
+{-# INLINE bracketed #-}
+
+-- | Parser bracketed by square brackets.
+--
+-- >>> runParser bracketedSB "[bracketed]"
+-- OK "bracketed" ""
+bracketedSB :: Parser e [Char]
+bracketedSB = bracketed $(char '[') $(char ']') (many (satisfy (/= ']')))
+
+-- | Parser wrapped by another parser.
+--
+-- >>> runParser (wrapped ($(char '"')) (many (satisfy (/= '"')))) "\"wrapped\""
+-- OK "wrapped" ""
+wrapped :: Parser e () -> Parser e a -> Parser e a
+wrapped x p = bracketed x x p
+{-# INLINE wrapped #-}
+
+-- | A single digit
+--
+-- >>> runParserMaybe digit "5"
+-- Just 5
+digit :: Parser e Int
+digit = (\c -> ord c - ord '0') <$> satisfyAscii isDigit
+
+-- | An (unsigned) 'Int' parser
+--
+-- >>> runParserMaybe int "567"
+-- Just 567
+int :: Parser e Int
+int = do
+ (place, n) <- chainr (\n (!place, !acc) -> (place * 10, acc + place * n)) digit (pure (1, 0))
+ case place of
+ 1 -> empty
+ _ -> pure n
+
+digits :: Parser e (Int, Int)
+digits = do
+ (place, n) <- chainr (\n (!place, !acc) -> (place * 10, acc + place * n)) digit (pure (1, 0))
+ case place of
+ 1 -> empty
+ _ -> pure (place, n)
+
+-- | A 'Double' parser. uiua does not parse .1 as a double.
+--
+-- >>> runParser double "1.234x"
+-- OK 1.234 "x"
+--
+-- >>> runParser double "."
+-- Fail
+--
+-- >>> runParser double "123"
+-- OK 123.0 ""
+--
+-- >>> runParser double ".123"
+-- Fail
+--
+-- >>> runParser double "123."
+-- OK 123.0 "."
+double :: Parser e Double
+double = do
+ (placel, nl) <- digits
+ withOption
+ ($(char '.') *> digits)
+ ( \(placer, nr) ->
+ case placel of
+ 1 -> empty
+ _ -> pure $ fromIntegral nl + fromIntegral nr / fromIntegral placer
+ )
+ ( case placel of
+ 1 -> empty
+ _ -> pure $ fromIntegral nl
+ )
+
+minus :: Parser e ()
+minus = $(char '-') <|> byteString "¯"
+
+-- | Parser for a signed prefix to a number. Unlike uiua, this parses '-' as a negative number prefix.
+--
+-- >>> runParser (signed double) "-1.234x"
+-- OK (-1.234) "x"
+--
+-- >>> runParser (signed double) "¯1.234x"
+-- OK (-1.234) "x"
+signed :: (Num b) => Parser e b -> Parser e b
+signed p = do
+ m <- optional minus
+ case m of
+ Nothing -> p
+ Just () -> negate <$> p
+
+-- | Comma parser
+--
+-- >>> runParserMaybe comma ","
+-- Just ()
+comma :: Parser e ()
+comma = $(char ',')
diff --git a/src/Web/Rep/SharedReps.hs b/src/Web/Rep/SharedReps.hs
--- a/src/Web/Rep/SharedReps.hs
+++ b/src/Web/Rep/SharedReps.hs
@@ -51,11 +51,11 @@
import Data.String.Interpolate
import FlatParse.Basic hiding (take)
import MarkupParse
-import MarkupParse.FlatParse
import Optics.Core hiding (element)
import Optics.Zoom
import Web.Rep.Bootstrap
import Web.Rep.Html.Input
+import Web.Rep.Internal.FlatParse
import Web.Rep.Shared
import Prelude as P
@@ -355,7 +355,7 @@
join $
maybe
(Left "HashMap.lookup failed")
- (Right . first strToUtf8 . runParserEither ((== "true") <$> takeRest))
+ (Right . runParserEither ((== "true") <$> takeRest))
(HashMap.lookup name s)
)
)
diff --git a/src/Web/Rep/Socket.hs b/src/Web/Rep/Socket.hs
--- a/src/Web/Rep/Socket.hs
+++ b/src/Web/Rep/Socket.hs
@@ -44,6 +44,7 @@
import Box
import Box.Websocket (serverApp)
+import Control.Category ((>>>))
import Control.Concurrent.Async
import Control.Monad
import Control.Monad.State.Lazy
@@ -59,7 +60,6 @@
import FlatParse.Basic
import GHC.Generics
import MarkupParse
-import MarkupParse.FlatParse
import Network.Wai.Handler.WebSockets
import Network.WebSockets qualified as WS
import Optics.Core hiding (element)
@@ -165,7 +165,7 @@
(view #codeBoxEmitterQueue cfg)
(view #codeBoxCommitterQueue cfg)
( serveSocketBox (view #codeBoxSocket cfg) (view #codeBoxPage cfg)
- . dimap (either error id . runParserEither parserJ . encodeUtf8) (mconcat . fmap (decodeUtf8 . code))
+ . dimap (either (C.unpack >>> error) id . runParserEither parserJ . encodeUtf8) (mconcat . fmap (decodeUtf8 . code))
)
-- | Turn the default configuration into a live (Codensity) CodeBox
@@ -460,3 +460,10 @@
})
}
|]
+
+-- | Run a Parser, throwing away leftovers. Returns Left on 'Fail' or 'Err'.
+runParserEither :: Parser ByteString a -> ByteString -> Either ByteString a
+runParserEither p bs = case runParser p bs of
+ Err e -> Left e
+ OK a _ -> Right a
+ Fail -> Left "uncaught parse error"
diff --git a/web-rep.cabal b/web-rep.cabal
--- a/web-rep.cabal
+++ b/web-rep.cabal
@@ -1,6 +1,6 @@
cabal-version: 3.0
name: web-rep
-version: 0.13.0.0
+version: 0.14.0.0
license: BSD-3-Clause
license-file: LICENSE
copyright: Tony Day (c) 2015
@@ -11,100 +11,122 @@
bug-reports: https://github.com/tonyday567/web-page/issues
synopsis: representations of a web page
description:
- An applicative-based, shared-data representation of a web page.
+ An applicative-based, shared-data representation of a web page.
build-type: Simple
tested-with:
- , GHC == 9.10.1
- , GHC == 9.6.5
- , GHC == 9.8.2
+ ghc ==9.6.7
+ ghc ==9.8.4
+ ghc ==9.10.2
+ ghc ==9.12.2
+
extra-doc-files:
- ChangeLog.md
- readme.md
+ ChangeLog.md
+ readme.md
source-repository head
- type: git
- location: https://github.com/tonyday567/web-rep
+ type: git
+ location: https://github.com/tonyday567/web-rep
common ghc-options-exe-stanza
- ghc-options:
- -fforce-recomp
- -funbox-strict-fields
- -rtsopts
- -threaded
- -with-rtsopts=-N
+ ghc-options:
+ -fforce-recomp
+ -funbox-strict-fields
+ -rtsopts
+ -threaded
+ -with-rtsopts=-N
common ghc-options-stanza
- ghc-options:
- -Wall
- -Wcompat
- -Widentities
- -Wincomplete-record-updates
- -Wincomplete-uni-patterns
- -Wpartial-fields
- -Wredundant-constraints
+ ghc-options:
+ -Wall
+ -Wcompat
+ -Widentities
+ -Wincomplete-record-updates
+ -Wincomplete-uni-patterns
+ -Wpartial-fields
+ -Wredundant-constraints
-common ghc2021-stanza
- default-language: GHC2021
+common ghc2024-additions
+ default-extensions:
+ DataKinds
+ DerivingStrategies
+ DisambiguateRecordFields
+ ExplicitNamespaces
+ GADTs
+ LambdaCase
+ MonoLocalBinds
+ RoleAnnotations
+common ghc2024-stanza
+ if impl(ghc >=9.10)
+ default-language:
+ GHC2024
+ else
+ import: ghc2024-additions
+ default-language:
+ GHC2021
+
library
- import: ghc-options-stanza
- import: ghc2021-stanza
- hs-source-dirs: src
- build-depends:
- , async >=2.2.4 && <2.3
- , base >=4.14 && <5
- , bifunctors >=5.5.11 && <5.7
- , box >=0.9 && <0.10
- , box-socket >=0.5 && <0.6
- , bytestring >=0.11.3 && <0.13
- , flatparse >=0.3.5 && <0.6
- , markup-parse >=0.1.0.1 && <0.2
- , mtl >=2.2.2 && <2.4
- , optics-core >=0.4 && <0.5
- , optics-extra >=0.4 && <0.5
- , profunctors >=5.6.2 && <5.7
- , scotty >=0.11.5 && <0.23
- , string-interpolate >=0.3 && <0.4
- , text >=1.2 && <2.2
- , transformers >=0.5.6 && <0.6.2
- , unordered-containers >=0.2 && <0.3
- , wai-middleware-static >=0.9 && <0.10
- , wai-websockets >=3.0.1.2 && <3.1
- , websockets >=0.12 && <0.14
- exposed-modules:
- Web.Rep
- Web.Rep.Bootstrap
- Web.Rep.Examples
- Web.Rep.Html
- Web.Rep.Html.Input
- Web.Rep.Page
- Web.Rep.Render
- Web.Rep.Server
- Web.Rep.Shared
- Web.Rep.SharedReps
- Web.Rep.Socket
+ import: ghc-options-stanza
+ import: ghc2024-stanza
+ hs-source-dirs: src
+ build-depends:
+ async >=2.2.4 && <2.3,
+ base >=4.14 && <5,
+ bifunctors >=5.5.11 && <5.7,
+ box >=0.9 && <0.10,
+ box-socket >=0.5 && <0.6,
+ bytestring >=0.11.3 && <0.13,
+ flatparse >=0.3.5 && <0.6,
+ markup-parse >=0.2 && <0.3,
+ mtl >=2.2.2 && <2.4,
+ optics-core >=0.4 && <0.5,
+ optics-extra >=0.4 && <0.5,
+ profunctors >=5.6.2 && <5.7,
+ scotty >=0.11.5 && <0.23,
+ string-interpolate >=0.3 && <0.4,
+ text >=1.2 && <2.2,
+ transformers >=0.5.6 && <0.6.2,
+ unordered-containers >=0.2 && <0.3,
+ wai-middleware-static >=0.9 && <0.10,
+ wai-websockets >=3.0.1.2 && <3.1,
+ websockets >=0.12 && <0.14,
+ exposed-modules:
+ Web.Rep
+ Web.Rep.Bootstrap
+ Web.Rep.Examples
+ Web.Rep.Html
+ Web.Rep.Html.Input
+ Web.Rep.Internal.FlatParse
+ Web.Rep.Page
+ Web.Rep.Render
+ Web.Rep.Server
+ Web.Rep.Shared
+ Web.Rep.SharedReps
+ Web.Rep.Socket
+
executable web-rep-example
- import: ghc-options-exe-stanza
- import: ghc-options-stanza
- import: ghc2021-stanza
- main-is: rep-example.hs
- hs-source-dirs: app
- build-depends:
- , base >=4.14 && <5
- , box >=0.9 && <0.10
- , markup-parse >=0.1 && <0.2
- , optics-core >=0.4 && <0.5
- , optparse-applicative >=0.17 && <0.19
- , web-rep
+ import: ghc-options-exe-stanza
+ import: ghc-options-stanza
+ import: ghc2024-stanza
+ main-is: rep-example.hs
+ hs-source-dirs: app
+ build-depends:
+ base >=4.14 && <5,
+ box >=0.9 && <0.10,
+ markup-parse >=0.2 && <0.3,
+ optics-core >=0.4 && <0.5,
+ optparse-applicative >=0.17 && <0.20,
+ web-rep,
test-suite doctests
- import: ghc2021-stanza
- main-is: doctests.hs
- hs-source-dirs: test
- build-depends:
- , base >=4.14 && <5
- , doctest-parallel >=0.3 && <0.4
- ghc-options: -threaded
- type: exitcode-stdio-1.0
+ import: ghc2024-stanza
+ main-is: doctests.hs
+ hs-source-dirs: test
+ build-depends:
+ base >=4.14 && <5,
+ doctest-parallel >=0.3 && <0.5,
+
+ ghc-options: -threaded
+ type: exitcode-stdio-1.0