mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

chore(users/Profpatsch): misc small improvements

Browse source 
Change-Id: I8fc128391196da22f03bac76a6c621f2cee73334
Reviewed-on: https://cl.tvl.fyi/c/depot/+/11084
Autosubmit: Profpatsch <mail@profpatsch.de>
Reviewed-by: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
This commit is contained in:
Profpatsch 2024-03-03 13:51:30 +01:00 committed by clbot
parent 5a086020cb
commit c869f9627e
3 changed files with 8 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
users/Profpatsch/my-webstuff/src/Multipart2.hs
View file

@ -108,7 +108,7 @@ parseMultipartOrThrow throwF parser req = do
Success a -> pure a Success a -> pure a
-- | Parse the field out of the multipart message -- | Parse the field out of the multipart message
field :: Applicative m => ByteString -> FieldParser ByteString a -> MultipartParseT backend m a field :: (Applicative m) => ByteString -> FieldParser ByteString a -> MultipartParseT backend m a
field fieldName fieldParser = MultipartParseT $ \mp -> field fieldName fieldParser = MultipartParseT $ \mp ->
mp.inputs mp.inputs
& findMaybe (\input -> if fst input == fieldName then Just (snd input) else Nothing) & findMaybe (\input -> if fst input == fieldName then Just (snd input) else Nothing)
@ -118,7 +118,7 @@ field fieldName fieldParser = MultipartParseT $ \mp ->
& pure & pure
-- | Parse the field out of the multipart message -- | Parse the field out of the multipart message
field' :: Applicative m => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (FormValidation a) field' :: (Applicative m) => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (FormValidation a)
field' fieldName fieldParser = MultipartParseT $ \mp -> field' fieldName fieldParser = MultipartParseT $ \mp ->
mp.inputs mp.inputs
& findMaybe (\input -> if fst input == fieldName then Just $ snd input else Nothing) & findMaybe (\input -> if fst input == fieldName then Just $ snd input else Nothing)
@ -136,15 +136,15 @@ field' fieldName fieldParser = MultipartParseT $ \mp ->
& pure & pure
-- | Parse the field out of the multipart message, and into a 'Label' of the given name. -- | Parse the field out of the multipart message, and into a 'Label' of the given name.
fieldLabel :: forall lbl backend m a. Applicative m => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (Label lbl a) fieldLabel :: forall lbl backend m a. (Applicative m) => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (Label lbl a)
fieldLabel fieldName fieldParser = label @lbl <$> field fieldName fieldParser fieldLabel fieldName fieldParser = label @lbl <$> field fieldName fieldParser
-- | Parse the field out of the multipart message, and into a 'Label' of the given name. -- | Parse the field out of the multipart message, and into a 'Label' of the given name.
fieldLabel' :: forall lbl backend m a. Applicative m => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (FormValidation (Label lbl a)) fieldLabel' :: forall lbl backend m a. (Applicative m) => ByteString -> FieldParser ByteString a -> MultipartParseT backend m (FormValidation (Label lbl a))
fieldLabel' fieldName fieldParser = fmap (label @lbl) <$> field' fieldName fieldParser fieldLabel' fieldName fieldParser = fmap (label @lbl) <$> field' fieldName fieldParser
-- | parse all fields out of the multipart message, with the same parser -- | parse all fields out of the multipart message, with the same parser
allFields :: Applicative m => FieldParser (T2 "key" ByteString "value" ByteString) b -> MultipartParseT backend m [b] allFields :: (Applicative m) => FieldParser (T2 "key" ByteString "value" ByteString) b -> MultipartParseT backend m [b]
allFields fieldParser = MultipartParseT $ \mp -> allFields fieldParser = MultipartParseT $ \mp ->
mp.inputs mp.inputs
<&> tupToT2 @"key" @"value" <&> tupToT2 @"key" @"value"
@ -157,7 +157,7 @@ tupToT2 (a, b) = T2 (label a) (label b)
-- | Parse a file by name out of the multipart message -- | Parse a file by name out of the multipart message
file :: file ::
Applicative m => (Applicative m) =>
ByteString -> ByteString ->
MultipartParseT backend m (MultipartFile Lazy.ByteString) MultipartParseT backend m (MultipartFile Lazy.ByteString)
file fieldName = MultipartParseT $ \mp -> file fieldName = MultipartParseT $ \mp ->
@ -172,14 +172,14 @@ file fieldName = MultipartParseT $ \mp ->
-- | Return all files from the multipart message -- | Return all files from the multipart message
allFiles :: allFiles ::
Applicative m => (Applicative m) =>
MultipartParseT backend m [MultipartFile Lazy.ByteString] MultipartParseT backend m [MultipartFile Lazy.ByteString]
allFiles = MultipartParseT $ \mp -> do allFiles = MultipartParseT $ \mp -> do
pure $ Success $ mp.files pure $ Success $ mp.files
-- | Ensure there is exactly one file and return it (ignoring the field name) -- | Ensure there is exactly one file and return it (ignoring the field name)
exactlyOneFile :: exactlyOneFile ::
Applicative m => (Applicative m) =>
MultipartParseT backend m (MultipartFile Lazy.ByteString) MultipartParseT backend m (MultipartFile Lazy.ByteString)
exactlyOneFile = MultipartParseT $ \mp -> exactlyOneFile = MultipartParseT $ \mp ->
mp.files mp.files

1
users/Profpatsch/netencode/Netencode/Parse.hs
View file

@ -13,7 +13,6 @@ import Data.Map.NonEmpty qualified as NEMap
import Data.Semigroupoid qualified as Semigroupiod import Data.Semigroupoid qualified as Semigroupiod
import Data.Semigroupoid qualified as Semigroupoid import Data.Semigroupoid qualified as Semigroupoid
import Data.Text qualified as Text import Data.Text qualified as Text
import Label
import Netencode qualified import Netencode qualified
import PossehlAnalyticsPrelude import PossehlAnalyticsPrelude
import Prelude hiding (log) import Prelude hiding (log)

29
users/Profpatsch/whatcd-resolver/build.ninja
View file

@ -1,29 +0,0 @@
builddir = .ninja
rule cabal-run
command = cabal run $target
rule cabal-repl
command = cabal repl $target
rule cabal-test
command = cabal test $target
rule hpack-file
description = hpack $in
command = $
hpack --force $in $
&& touch $out
build repl : cabal-repl | cabal-preconditions
target = whatcd-resolver-server
pool = console
build run : cabal-run | cabal-preconditions
target = whatcd-resolver-server
pool = console
build cabal-preconditions : phony whatcd-resolver-server.cabal
build whatcd-resolver-server.cabal : hpack-file package.yaml