web-rep 0.13.0.0 → 0.14.0.0
raw patch · 8 files changed
+460/−102 lines, 8 filesdep ~doctest-paralleldep ~markup-parsedep ~optparse-applicative
Dependency ranges changed: doctest-parallel, markup-parse, optparse-applicative
Files
- ChangeLog.md +5/−0
- app/rep-example.hs +1/−2
- readme.md +1/−14
- src/Web/Rep/Examples.hs +1/−1
- src/Web/Rep/Internal/FlatParse.hs +338/−0
- src/Web/Rep/SharedReps.hs +2/−2
- src/Web/Rep/Socket.hs +9/−2
- web-rep.cabal +103/−81
ChangeLog.md view
@@ -1,3 +1,8 @@+0.14+===++* Added Web.Rep.Internal.FlatParse (due to markup-parse-2.0 changes)+ 0.13 === * added sharedPage
app/rep-example.hs view
@@ -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
readme.md view
@@ -1,16 +1,7 @@ -# Table of Contents--1. [web-rep](#orgebbc06e)-2. [library reference](#org8d29302)-3. [Development](#orgddf3f50)---<a id="orgebbc06e"></a>- # 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 @@ <http://localhost:9160/> -<a id="org8d29302"></a>- # 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) --<a id="orgddf3f50"></a> # Development
src/Web/Rep/Examples.hs view
@@ -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
+ src/Web/Rep/Internal/FlatParse.hs view
@@ -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 ',')
@@ -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) ) )
src/Web/Rep/Socket.hs view
@@ -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"
web-rep.cabal view
@@ -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