diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,8 @@ +### 1.2.6.2 + +- In module *NgxExport.Tools.Read*, compute the wrapped type of data *Readable* + and *ReadableAsJSON* in a closed type family *WrappedTypeOf*. + ### 1.2.6.1 - Reimplement parts of *voidService* in terms of *voidHandler'*. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ The following license covers this documentation, and the source code, except where otherwise indicated. -Copyright 2018-2024, Alexey Radkov. All rights reserved. +Copyright 2018-2026, Alexey Radkov. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: diff --git a/NgxExport/Tools/Read.hs b/NgxExport/Tools/Read.hs --- a/NgxExport/Tools/Read.hs +++ b/NgxExport/Tools/Read.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools.Read --- Copyright : (c) Alexey Radkov 2018-2024 +-- Copyright : (c) Alexey Radkov 2018-2026 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com @@ -100,7 +100,7 @@ -- 'NgxExport.ngxExportYY' \'testReadConfWithRPtrJSONHandler -- @ -- --- Here five Haskell handlers are defined: /testReadIntHandler/, +-- Here, five Haskell handlers are defined: /testReadIntHandler/, -- /testReadConfHandler/, /testReadConfJSONHandler/, -- /testReadConfWithRPtrHandler/, and /testReadConfWithRPtrJSONHandler/. Four -- of them are /synchronous/ and one is /asynchronous/ for the sake of variety. @@ -141,10 +141,10 @@ -- \'{\"tag\":\"Unknown\"}\'; -- haskell_run __/testReadConfWithRPtrHandler/__ -- $hs_testReadConfWithRPtrHandler --- \'${_r_ptr}Conf 21\'; +-- \'__/${_r_ptr}/__Conf 21\'; -- haskell_run __/testReadConfWithRPtrJSONHandler/__ -- $hs_testReadConfWithRPtrJSONHandler --- \'$_r_ptr +-- \'__/$_r_ptr/__ -- {\"tag\":\"ConfJSONCon1\", \"contents\":4} -- \'; -- @@ -160,6 +160,18 @@ -- } -- @ -- +-- Handlers that read the pointer to the Nginx request object can also be +-- written in a fancy style as shown below. +-- +-- @ +-- haskell_run __/testReadConfWithRPtrHandler(r)/__ +-- $hs_testReadConfWithRPtrHandler +-- \'Conf 21\'; +-- haskell_run __/testReadConfWithRPtrJSONHandler(r)/__ +-- $hs_testReadConfWithRPtrJSONHandler +-- \'{\"tag\":\"ConfJSONCon1\", \"contents\":4}\'; +-- @ +-- -- ==== A simple test -- > $ curl 'http://localhost:8010/' -- > Handler variables: @@ -169,20 +181,24 @@ -- > hs_testReadConfJSONHandlerBadInput: Nothing -- > hs_testReadConfWithRPtrHandler: (0x00000000016fc790,Just (Conf 21)) -- > hs_testReadConfWithRPtrJSONHandler: (0x00000000016fc790,Just (ConfJSONCon1 4)) +-- +-- Note that /non-latin/ Unicode characters read in constructors of custom types +-- get truncated. Particularly, this means that string literals containing such +-- characters will be garbled. data Readable a data ReadableAsJSON a +type family WrappedTypeOf a where + WrappedTypeOf (_ a) = a + class FromByteString a where - type WrappedT a - fromByteString :: Proxy a -> ByteString -> Maybe (WrappedT a) + fromByteString :: Proxy a -> ByteString -> Maybe (WrappedTypeOf a) instance Read a => FromByteString (Readable a) where - type WrappedT (Readable a) = a fromByteString = const $ readMaybe . C8.unpack instance FromJSON a => FromByteString (ReadableAsJSON a) where - type WrappedT (ReadableAsJSON a) = a fromByteString = const decodeStrict -- | Reads an object of a custom type implementing an instance of 'Read' @@ -202,20 +218,20 @@ -- | Reads a pointer to the Nginx request object followed by an object of -- a custom type implementing an instance of 'Read' from a 'ByteString'. -- --- Throws an exception if unmarshalling of the request pointer fails. In the --- second element of the tuple returns 'Nothing' if reading of the custom --- object fails. Notice that the value of the returned request pointer is not --- checked against /NULL/. +-- Throws an exception if unmarshalling of the request pointer fails. Returns +-- 'Nothing' in the second element of the tuple if reading of the custom object +-- fails. Notice that the value of the returned request pointer is not checked +-- against /NULL/. readFromByteStringWithRPtr :: Read a => ByteString -> (Ptr (), Maybe a) readFromByteStringWithRPtr = ngxRequestPtr &&& readFromByteString . skipRPtr -- | Reads a pointer to the Nginx request object followed by an object of -- a custom type implementing an instance of 'FromJSON' from a 'ByteString'. -- --- Throws an exception if unmarshalling of the request pointer fails. In the --- second element of the tuple returns 'Nothing' if decoding of the custom --- object fails. Notice that the value of the returned request pointer is not --- checked against /NULL/. +-- Throws an exception if unmarshalling of the request pointer fails. Returns +-- 'Nothing' in the second element of the tuple if decoding of the custom object +-- fails. Notice that the value of the returned request pointer is not checked +-- against /NULL/. readFromByteStringWithRPtrAsJSON :: FromJSON a => ByteString -> (Ptr (), Maybe a) readFromByteStringWithRPtrAsJSON = diff --git a/ngx-export-tools.cabal b/ngx-export-tools.cabal --- a/ngx-export-tools.cabal +++ b/ngx-export-tools.cabal @@ -1,5 +1,5 @@ name: ngx-export-tools -version: 1.2.6.1 +version: 1.2.6.2 synopsis: Extra tools for Nginx Haskell module description: Extra tools for . @@ -10,7 +10,7 @@ author: Alexey Radkov maintainer: Alexey Radkov stability: stable -copyright: 2018-2024 Alexey Radkov +copyright: 2018-2026 Alexey Radkov category: Network build-type: Simple cabal-version: 1.20