MultiChor 1.0.0.0 → 1.0.1.0
raw patch · 9 files changed
+478/−27 lines, 9 filesdep −cabal-detailed-quickcheckdep ~Cabaldep ~basedep ~template-haskell
Dependencies removed: cabal-detailed-quickcheck
Dependency ranges changed: Cabal, base, template-haskell, time
Files
- MultiChor.cabal +15/−6
- examples/CLI.hs +1/−1
- examples/DiffieHellman.hs +1/−1
- examples/Distribution/TestSuite/QuickCheck.hs +442/−0
- examples/Lottery.hs +1/−1
- examples/ObliviousTransfer.hs +1/−1
- src/Choreography/Locations.hs +2/−2
- src/Choreography/Network/Local.hs +1/−1
- src/Choreography/Polymorphism.hs +14/−14
MultiChor.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: MultiChor-version: 1.0.0.0+version: 1.0.1.0 license-files: , LICENSE , LICENSE.inherited@@ -25,14 +25,14 @@ common basic-config default-language: GHC2021 build-depends:- , base >= 4.16 && < 4.20+ , base >= 4.16 && < 5 , bytestring >= 0.11 && < 0.13 , http-client >= 0.7 && < 0.8 , mtl >= 2.2.2 && < 3.0 , servant >= 0.19 && < 0.21 , servant-client >= 0.19 && < 0.21 , servant-server >= 0.19 && < 0.21- , template-haskell >= 2.18 && < 2.22+ , template-haskell >= 2.18 && < 2.23 , unordered-containers >= 0.2 && < 0.3 , warp >= 3.3 && < 3.4 ghc-options:@@ -71,26 +71,35 @@ import: basic-config build-depends: MultiChor +Flag test+ Description: Enable debug support+ Default: False+ Manual: True common example import: lib-dependent+ if flag(test)+ buildable: True+ else+ buildable: False hs-source-dirs: examples build-depends: , async >= 2.2 && < 2.3 , binary >= 0.8.9.0 && < 0.10.1.0 -- trying to get hls to work with TestSuite- , Cabal >= 3.6.3 && < 3.7- , cabal-detailed-quickcheck >= 0.2.0 && < 0.3+ , Cabal >= 3.6.3 && < 3.13+ --, cabal-detailed-quickcheck >= 0.2.0 && < 0.3 -- , containers >= 0.6 && < 0.7 , cryptonite >= 0.10 && < 0.31 , finite-field >= 0.10.0 && < 0.11.0 , split >= 0.2 && < 0.3 , random >= 1.2 && < 1.3- , time >= 1.11 && < 1.13+ , time >= 1.11 && < 1.15 , transformers >= 0.5 && < 0.7 , QuickCheck >= 2.14 && < 3 other-modules: Data+ , Distribution.TestSuite.QuickCheck , CLI Test-Suite testExamples
examples/CLI.hs view
@@ -6,8 +6,8 @@ module CLI where import Control.Monad (unless)-import Control.Monad.Cont (MonadIO (liftIO)) import Control.Monad.Freer+import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.State (MonadState (get, put), StateT (runStateT), lift) import Data.Typeable (Typeable, typeRep) import Text.Read (readMaybe)
examples/DiffieHellman.hs view
@@ -39,7 +39,7 @@ import CLI import Choreography import Choreography.Network.Http-import Control.Monad.Cont (MonadIO)+import Control.Monad.IO.Class (MonadIO) import System.Environment import System.Random
+ examples/Distribution/TestSuite/QuickCheck.hs view
@@ -0,0 +1,442 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module: Distribution.TestSuite.QuickCheck+-- Description: Convert QuickCheck properties into Cabal tests+-- Copyright: ⓒ Anselm Schüler 2022+-- License: MIT+-- Maintainer: Anselm Schüler <mail@anselmschueler.com>+-- Stability: stable+-- Portability: Portable+--+-- This module allows you to easily make Cabal tests for the @detailed-0.9@ interface. See the [docs](https://cabal.readthedocs.io/en/3.6/cabal-package.html#example-package-using-detailed-0-9-interface).+-- It sets sensible option declarations for the tests.+--+-- This module re-uses record names from "Distribution.TestSuite" and "Test.QuickCheck".+-- It is recommended that you enable the [@DisambiguateRecordFields@](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/exts/disambiguate_record_fields.html) extension in GHC and/or import the module qualified.+-- For many basic tests, you don’t need to import "Distribution.TestSuite".+--+-- To make a test, simply construct a 'PropertyTest' and call 'getPropertyTest' on it.+--+-- A simple sample test suite:+--+-- @+-- module Tests (tests) where+-- import "Distribution.TestSuite.QuickCheck"+-- import "Test.QuickCheck"+-- tests = [+-- 'getPropertyTest' 'PropertyTest' {+-- 'name' = /"addition-is-commutative"/,+-- 'tags' = [],+-- 'property' = \\a b -> a + b 'QC.===' b + a+-- }+-- ]+-- @+--+-- The tests you get as a result support several parameters:+--+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | Property name | Valid values | Effect |+-- +====================+==============+=================================================================================++-- | @silent@ | booleans | If true, all output is disabled. |+-- | | | Sets 'verbosity' to 'Silent'. See 'QC.chatty'. |+-- | | | Disabling Silent raises the verbosity to Chatty if it is not already higher. |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @chatty@ | booleans | If true, the default amount of output is emitted by QuickCheck. |+-- | | | Sets 'verbosity' to 'Chatty'. See 'QC.chatty'. |+-- | | | Note that setting this verbosity option to false does not undo setting it to |+-- | | | true, but lowers the verbosity by one level if it is not already lower. |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @verbose@ | booleans | If true, prints checked values as output. |+-- | | | Sets 'verbosity' to 'Verbose'. See 'QC.verbose'. |+-- | | | Note that setting this verbosity option to false does not undo setting it to |+-- | | | true, but lowers the verbosity by one level if it is not already lower. |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @verboseShrinking@ | booleans | If true, prints all checked and shrunk values as output. |+-- | | | See 'QC.verboseShrinking'. |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @verbosity@ | @Silent@, | Sets the 'verbosity' to the desired level. |+-- | | @Chatty@, | |+-- | | or @Verbose@ | |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @maxDiscardRatio@ | positive | Maximum number of discarded tests per successful test before giving up. |+-- | | integer | See 'QC.maxDiscardRatio'. |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @noShrinking@ | booleans | Disables shrinking of test cases. |+-- | | | See 'QC.noShrinking'. |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @shrinking@ | booleans | Opposite of @noShrinking@. |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @maxShrinks@ | nonnegative | Maximum number of shrinks before giving up or zero to disable shrinking. |+-- | | integer | See 'QC.maxShrinks'. |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @maxSuccess@ | positive | Maximum number of successful tests before succeeding. |+-- | | integer | See 'QC.maxSuccess'. |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @maxSize@ | positive | Size to use for the biggest test cases. |+-- | | integer | See 'QC.maxSize'. |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @sizeScale@ | positive | Scales all sizes by a number. |+-- | | integer | See 'QC.mapSize'. |+-- +--------------------+--------------+---------------------------------------------------------------------------------++-- | @replay@ | tuple of | Replays a previous test case. Pass a string representing a tuple of |+-- | | 'QCGen' and | the 'QC.usedSeed' and 'QC.usedSize' values of a test case. Use empty string to |+-- | | nonnegative | disable. |+-- | | integer or | |+-- | | empty | |+-- +--------------------+--------------+---------------------------------------------------------------------------------++--+-- You can set default values by using 'getPropertyTestWith'+-- You can access these values in your test by using 'getPropertyTestUsing'.+-- Do both with 'getPropertyTestWithUsing'.+module Distribution.TestSuite.QuickCheck+ ( -- * Create tests+ getPropertyTest,+ getPropertyTestWith,+ getPropertyTestUsing,+ getPropertyTestWithUsing,+ getPropertyTests,+ propertyTestGroup,++ -- * Argument data types+ PropertyTest (..),+ TestArgs (..),+ Verbosity (..),++ -- * Functions for using arguments+ argsToTestArgs,+ argsToTestArgsWith,+ testArgsToArgs,+ stdTestArgs,+ )+where++import Data.Bool (bool)+import Data.Functor ((<&>))+import Distribution.TestSuite qualified as T+import Test.QuickCheck qualified as QC+import Test.QuickCheck.Random (QCGen)+import Text.Read (readMaybe)++-- | Datatype for setting the verbosity of tests+data Verbosity+ = -- | QuickCheck prints nothing. This sets @'QC.chatty' = 'False'@.+ Silent+ | -- | Print basic statistics. This sets @'QC.chatty' = 'True'@.+ Chatty+ | -- | Print every test case. This applies 'QC.verbose'.+ Verbose+ deriving+ ( Eq,+ -- | 'Silent' < 'Chatty' < 'Verbose'+ Ord,+ Show,+ Read,+ Enum,+ Bounded+ )++-- ! [PARTIAL] This function fails when passed Silent+switchVerbosity :: Verbosity -> Bool -> Verbosity -> Verbosity+switchVerbosity v' True v = v'+switchVerbosity v' False v = min (pred v') v++-- | Arguments for altering property test behaviour.+-- These can be altered in the final Cabal 'T.Test' using 'T.setOption'.+data TestArgs = TestArgs+ { -- | Verbosity for tests. See 'QC.verbose' and 'QC.chatty'.+ verbosity :: Verbosity,+ -- TODO Consider joining verboseShrinking back into verbosity++ -- | Whether QuickCheck should print shrinks. See 'QC.verboseShrinking'.+ verboseShrinking :: Bool,+ -- | Maximum discarded tests per successful test. See 'QC.maxDiscardRatio'.+ maxDiscardRatio :: Int,+ -- | Disable shrinking. See 'QC.noShrinking'.+ noShrinking :: Bool,+ -- | Maximum number of shrink attempts. See 'QC.maxShrinks'.+ maxShrinks :: Int,+ -- | Maximum number of successful checks before passing. See 'QC.maxSuccess'.+ maxSuccess :: Int,+ -- | Maximum size of test cases. See 'QC.maxSize'.+ maxSize :: Int,+ -- | Scale size by an integer using 'QC.mapSize'.+ sizeScale :: Int,+ -- | Replay a previous test. Pass the seed and size given by 'QC.usedSeed' and 'QC.usedSize'.+ replay :: Maybe (QCGen, Int)+ }++-- | Transform a QuickCheck 'QC.Args' value to a 'TestArgs' value, defaulting all missing properties+--+-- @'argsToTestArgs' = 'argsToTestArgsWith' 'stdTestArgs'@+argsToTestArgs :: QC.Args -> TestArgs+argsToTestArgs = argsToTestArgsWith stdTestArgs++-- | Transform a QuickCheck 'QC.Args' value to a 'TestArgs' value, with fallbacks for missing properties given by the first argument.+argsToTestArgsWith :: TestArgs -> QC.Args -> TestArgs+argsToTestArgsWith testArgs QC.Args {..} =+ testArgs+ { verbosity = if chatty then Chatty else Silent,+ maxDiscardRatio,+ maxShrinks,+ maxSuccess,+ maxSize,+ replay+ }++-- | Recover arguments passed to 'QC.quickCheck' from a 'TestArgs'+testArgsToArgs :: TestArgs -> QC.Args+testArgsToArgs TestArgs {..} =+ QC.Args+ { replay,+ maxSuccess,+ maxDiscardRatio,+ maxSize,+ chatty = verbosity >= Chatty,+ maxShrinks+ }++-- | Default arguments for property tests+stdTestArgs :: TestArgs+stdTestArgs =+ TestArgs+ { verbosity = Chatty,+ verboseShrinking = False,+ maxDiscardRatio = 10,+ noShrinking = False,+ maxShrinks = maxBound,+ maxSuccess = 100,+ maxSize = 100,+ sizeScale = 1,+ replay = Nothing+ }++switchVIn :: Verbosity -> Bool -> TestArgs -> TestArgs+switchVIn v' q args@TestArgs {verbosity} = args {verbosity = switchVerbosity v' q verbosity}++setArgStr :: String -> String -> Maybe (TestArgs -> TestArgs)+setArgStr "silent" str =+ readMaybe str <&> \val args@TestArgs {verbosity} ->+ if val+ then args {verbosity = Silent}+ else args {verbosity = max Chatty verbosity}+setArgStr "chatty" str = readMaybe str <&> switchVIn Chatty+setArgStr "verbose" str = readMaybe str <&> switchVIn Verbose+setArgStr "verboseShrinking" str =+ readMaybe str <&> \val args ->+ args {verboseShrinking = val}+setArgStr "verbosity" str =+ readMaybe str <&> \val args ->+ args {verbosity = val}+setArgStr "maxDiscardRatio" str =+ readMaybe str <&> \val args ->+ args {maxDiscardRatio = val}+setArgStr "noShrinking" str =+ readMaybe str <&> \val args ->+ args {noShrinking = val}+setArgStr "shrinking" str =+ readMaybe str <&> \val args ->+ args {noShrinking = not val}+setArgStr "maxShrinks" str =+ readMaybe str <&> \val args ->+ args {maxShrinks = val}+setArgStr "maxSuccess" str =+ readMaybe str <&> \val args ->+ args {maxSuccess = val}+setArgStr "maxSize" str =+ readMaybe str <&> \val args ->+ args {maxSize = val}+setArgStr "sizeScale" str =+ readMaybe str <&> \val args ->+ args {sizeScale = val}+setArgStr "replay" str =+ case str of+ "" -> Just \args -> args {replay = Nothing}+ _ ->+ readMaybe str <&> \val args ->+ args {replay = Just val}+setArgStr _ _ = Nothing++positiveIntType :: T.OptionType+positiveIntType =+ T.OptionNumber+ { optionNumberIsInt = True,+ optionNumberBounds = (Just "1", Nothing)+ }++getOptionDescrs :: TestArgs -> [T.OptionDescr]+getOptionDescrs TestArgs {..} =+ [ T.OptionDescr+ { optionName = "silent",+ optionDescription = "Suppress QuickCheck output",+ optionType = T.OptionBool,+ optionDefault = Just . show $ verbosity == Silent+ },+ T.OptionDescr+ { optionName = "chatty",+ optionDescription = "Print QuickCheck output",+ optionType = T.OptionBool,+ optionDefault = Just . show $ verbosity > Chatty+ },+ T.OptionDescr+ { optionName = "verbose",+ optionDescription = "Print checked values",+ optionType = T.OptionBool,+ optionDefault = Just . show $ verbosity > Verbose+ },+ T.OptionDescr+ { optionName = "verboseShrinking",+ optionDescription = "Print all checked and shrunk values",+ optionType = T.OptionBool,+ optionDefault = Just . show $ verboseShrinking+ },+ T.OptionDescr+ { optionName = "verbosity",+ optionDescription = "Verbosity level",+ optionType = T.OptionEnum ["Silent", "Chatty", "Verbose", "VerboseShrinking"],+ optionDefault = Just $ show verbosity+ },+ T.OptionDescr+ { optionName = "maxDiscardRatio",+ optionDescription = "Maximum number of discarded tests per successful test before giving up",+ optionType = positiveIntType,+ optionDefault = Just $ show maxDiscardRatio+ },+ T.OptionDescr+ { optionName = "noShrinking",+ optionDescription = "Disable shrinking",+ optionType = T.OptionBool,+ optionDefault = Just $ show noShrinking+ },+ T.OptionDescr+ { optionName = "shrinking",+ optionDescription = "Enable shrinking",+ optionType = T.OptionBool,+ optionDefault = Just . show $ not noShrinking+ },+ T.OptionDescr+ { optionName = "maxShrinks",+ optionDescription = "Maximum number of shrinks before giving up or zero to disable shrinking",+ optionType =+ T.OptionNumber+ { optionNumberIsInt = True,+ optionNumberBounds = (Just "0", Nothing)+ },+ optionDefault = Just $ show maxShrinks+ },+ T.OptionDescr+ { optionName = "maxSuccess",+ optionDescription = "Maximum number of successful tests before succeeding",+ optionType = positiveIntType,+ optionDefault = Just $ show maxSuccess+ },+ T.OptionDescr+ { optionName = "maxSize",+ optionDescription = "Size to use for the biggest test cases",+ optionType = positiveIntType,+ optionDefault = Just $ show maxSize+ },+ T.OptionDescr+ { optionName = "sizeScale",+ optionDescription = "Scale all sizes by a number",+ optionType = positiveIntType,+ optionDefault = Just $ show sizeScale+ },+ T.OptionDescr+ { optionName = "replay",+ optionDescription = "Replay a previous test",+ optionType = T.OptionString False,+ optionDefault = Just $ show @(Maybe (QCGen, Int)) Nothing+ }+ ]++getModifiers :: (QC.Testable a) => TestArgs -> a -> QC.Property+getModifiers TestArgs {verbosity, noShrinking, verboseShrinking, sizeScale} =+ foldr (.) QC.property $+ snd+ <$> filter+ fst+ [ (verbosity == Verbose, QC.verbose),+ (verboseShrinking, QC.verboseShrinking),+ (noShrinking, QC.noShrinking),+ (sizeScale /= 1, QC.mapSize (* sizeScale))+ ]++-- | Property test declaration with metadata+data PropertyTest prop = PropertyTest+ { -- | Name of the test, for Cabal. See See Cabal’s 'T.name'.+ name :: String,+ -- | Tags of the test, for Cabal. See Cabal’s 'T.tags'.+ tags :: [String],+ -- | Property to check. This should usually be or return an instance of 'QC.Testable'.+ property :: prop+ }++qcTestArgs :: (QC.Testable a) => TestArgs -> a -> IO QC.Result+qcTestArgs args property = QC.quickCheckWithResult (testArgsToArgs args) (getModifiers args property)++-- | Get a Cabal 'T.Test' with custom 'TestArgs' from a 'PropertyTest' that takes the test arguments and returns a 'QC.testable' value+getPropertyTestWithUsing ::+ (QC.Testable prop) =>+ -- | The arguments for the test+ TestArgs ->+ -- | A property test whose 'property' takes a 'TestArgs' argument+ PropertyTest (TestArgs -> prop) ->+ T.Test+getPropertyTestWithUsing originalArgs PropertyTest {..} =+ let withArgs args =+ T.TestInstance+ { run = do+ result <- qcTestArgs args (property args)+ let resultStr = "\n" ++ show result+ return $ T.Finished case result of+ QC.Success {} -> T.Pass+ QC.GaveUp {} ->+ T.Error $ "GaveUp: QuickCheck gave up" ++ resultStr+ QC.Failure {} ->+ T.Fail $ "Failure: A property failed" ++ resultStr+ QC.NoExpectedFailure {} ->+ T.Fail $ "NoExpectedFailure: A property that should have failed did not" ++ resultStr,+ name,+ tags,+ options = getOptionDescrs originalArgs,+ setOption = \opt str -> case setArgStr opt str of+ Nothing -> Left "Parse error"+ Just f -> Right . withArgs $ f args+ }+ in T.Test $ withArgs originalArgs++-- | Get a Cabal 'T.Test' from a 'PropertyTest' that takes the test arguments and returns a 'QC.Testable' value+getPropertyTestUsing ::+ (QC.Testable prop) =>+ -- | A property test whose 'property' takes a 'TestArgs' argument+ PropertyTest (TestArgs -> prop) ->+ T.Test+getPropertyTestUsing = getPropertyTestWithUsing stdTestArgs++discardingTestArgs :: PropertyTest prop -> PropertyTest (TestArgs -> prop)+discardingTestArgs test@PropertyTest {property} = test {property = const property}++-- | Get a Cabal 'T.Test' from a 'PropertyTest' with custom 'TestArgs'+getPropertyTestWith ::+ (QC.Testable prop) =>+ -- | The arguments for the test+ TestArgs ->+ PropertyTest prop ->+ T.Test+getPropertyTestWith args = getPropertyTestWithUsing args . discardingTestArgs++-- | Get a Cabal 'T.Test' from a 'PropertyTest'+getPropertyTest :: (QC.Testable prop) => PropertyTest prop -> T.Test+getPropertyTest = getPropertyTestWithUsing stdTestArgs . discardingTestArgs++-- | Get a list of 'T.Test's from a list of 'PropertyTest's+getPropertyTests :: (QC.Testable prop) => [PropertyTest prop] -> [T.Test]+getPropertyTests = (getPropertyTest <$>)++-- | Get a named test group from a list of 'PropertyTest's. These are assumed to be able to run in parallel. See 'T.testGroup' and 'T.Group'.+propertyTestGroup :: (QC.Testable prop) => String -> [PropertyTest prop] -> T.Test+propertyTestGroup name = T.testGroup name . getPropertyTests
examples/Lottery.hs view
@@ -11,7 +11,7 @@ import Choreography.Network.Http import Control.Exception (Exception, throwIO) import Control.Monad (unless)-import Control.Monad.Cont (MonadIO, liftIO)+import Control.Monad.IO.Class (MonadIO (liftIO)) import Crypto.Hash (Digest) import Crypto.Hash qualified as Crypto import Data (TestArgs, reference)
examples/ObliviousTransfer.hs view
@@ -9,7 +9,7 @@ import CLI import Choreography import Choreography.Network.Http-import Control.Monad.Cont (MonadIO, liftIO)+import Control.Monad.IO.Class (MonadIO (liftIO)) -- For cryptonite import Crypto.Hash.Algorithms qualified as HASH
src/Choreography/Locations.hs view
@@ -54,11 +54,11 @@ consSet :: forall xs x xs'. (xs ~ (x ': xs')) => Subset xs' (x ': xs') consSet = Subset Later --- | Cons an element to the superset in a `Subset` value.+-- | Cons an element to the superset in a t`Subset` value. consSuper :: forall xs ys y. Subset xs ys -> Subset xs (y ': ys) consSuper sxy = transitive sxy consSet --- | Cons an element to the subset in a `Subset` value;+-- | Cons an element to the subset in a t`Subset` value; -- requires proof that the new head element is already a member of the superset. -- Used like ":" for subset proofs. -- Suppose you have @(alice :: Member "Alice" census)@
src/Choreography/Network/Local.hs view
@@ -41,7 +41,7 @@ locs :: LocalConfig -> [LocTm] locs = HashMap.keys . locToBuf --- | Run a `Network` behavior using the channels in a `LocalConfig` for communication.+-- | Run a `Network` behavior using the channels in a t`LocalConfig` for communication. -- Call this inside a concurrent thread. runNetworkLocal :: (MonadIO m) => LocalConfig -> LocTm -> Network m a -> m a runNetworkLocal cfg self = interpFreer handler
src/Choreography/Polymorphism.hs view
@@ -15,16 +15,16 @@ -- | A mapping, accessed by `Member` terms, from types (`Symbol`s) to values. -- The types of the values depend on the indexing type; this relation is expressed by the type-level function @f@.--- If the types of the values /don't/ depend on the index, use `Quire`.+-- If the types of the values /don't/ depend on the index, use t`Quire`. -- If the types vary only in that they are `Located` at the indexing party, use `Faceted`.--- `PIndexed` generalizes those two types in a way that's not usually necessary when writing choreographies.+-- t`PIndexed` generalizes those two types in a way that's not usually necessary when writing choreographies. newtype PIndexed ls f = PIndexed {pindex :: PIndex ls f} --- | An impredicative quantified type. Wrapping it up in `PIndexed` wherever possible will avoid a lot of type errors and headache.+-- | An impredicative quantified type. Wrapping it up in t`PIndexed` wherever possible will avoid a lot of type errors and headache. type PIndex ls f = forall l. (KnownSymbol l) => Member l ls -> f l -- | Sequence computations indexed by parties.--- Converts a `PIndexed` of computations into a computation yielding a `PIndexed`.+-- Converts a t`PIndexed` of computations into a computation yielding a t`PIndexed`. -- Strongly analogous to 'Data.Traversable.sequence'. -- In most cases, the [choreographic functions](#g:choreographicfunctions) below will be easier to use -- than messing around with `Data.Functor.Compose.Compose`.@@ -48,34 +48,34 @@ -- | A collection of values, all of the same type, assigned to each element of the type-level list. newtype Quire parties a = Quire {asPIndexed :: PIndexed parties (Const a)} --- | Access a value in a `Quire` by its index.+-- | Access a value in a t`Quire` by its index. getLeaf :: (KnownSymbol p) => Quire parties a -> Member p parties -> a getLeaf (Quire (PIndexed q)) p = getConst $ q p --- | Package a function as a `Quire`.+-- | Package a function as a t`Quire`. stackLeaves :: forall ps a. (forall p. (KnownSymbol p) => Member p ps -> a) -> Quire ps a stackLeaves f = Quire . PIndexed $ Const . f --- | Get the head item from a `Quire`.+-- | Get the head item from a t`Quire`. qHead :: (KnownSymbol p) => Quire (p ': ps) a -> a qHead (Quire (PIndexed f)) = getConst $ f First --- | Get the tail of a `Quire`.+-- | Get the tail of a t`Quire`. qTail :: Quire (p ': ps) a -> Quire ps a qTail (Quire (PIndexed f)) = Quire . PIndexed $ f . Later --- | Prepend a value to a `Quire`.+-- | Prepend a value to a t`Quire`. -- The corresponding `Symbol` to bind it to must be provided by type-application if it can't be infered. qCons :: forall p ps a. a -> Quire ps a -> Quire (p ': ps) a qCons a (Quire (PIndexed f)) = Quire . PIndexed $ \case First -> Const a Later mps -> f mps --- | An empty `Quire`.+-- | An empty t`Quire`. qNil :: Quire '[] a qNil = Quire $ PIndexed \case {} --- | Apply a function to a single item in a `Quire`.+-- | Apply a function to a single item in a t`Quire`. qModify :: forall p ps a. (KnownSymbol p, KnownSymbols ps) => Member p ps -> (a -> a) -> Quire ps a -> Quire ps a qModify First f q = f (qHead q) `qCons` qTail q qModify (Later m) f q = case tySpine @ps of TyCons -> qHead q `qCons` qModify m f (qTail q)@@ -114,7 +114,7 @@ -- | A unified representation of possibly-distinct homogeneous values owned by many parties. type Faceted parties common a = PIndexed parties (Facet a common) --- | Repackages `Located` with the type arguments correctly arranged for use with `PIndexed`.+-- | Repackages `Located` with the type arguments correctly arranged for use with t`PIndexed`. newtype Facet a common p = Facet {getFacet :: Located (p ': common) a} -- | Get a `Located` value of a `Faceted` at a given location.@@ -181,7 +181,7 @@ (PIndexed x) <- sequenceP (PIndexed $ Compose . (Const <$>) <$> body) rs `congruently` \un -> stackLeaves $ \q -> un refl (getConst $ x q) --- | The owner of a `Quire` sends its elements to their respective parties, resulting in a `Faceted`.+-- | The owner of a t`Quire` sends its elements to their respective parties, resulting in a `Faceted`. -- This represents the "scatter" idea common in parallel computing contexts. scatter :: forall census sender recipients a m.@@ -193,7 +193,7 @@ scatter sender recipients values = fanOut \r -> (sender, \un -> un First values `getLeaf` r) *~> inSuper recipients r @@ sender @@ nobody --- | The many owners of a `Faceted` each send their respective values to a constant list of recipients, resulting in a `Quire`.+-- | The many owners of a `Faceted` each send their respective values to a constant list of recipients, resulting in a t`Quire`. -- This represents the "gather" idea common in parallel computing contexts. gather :: forall census recipients senders a dontcare m.