From 2924341479dfb22ddeded063888b253908da1b2a Mon Sep 17 00:00:00 2001 From: Maciej Bendkowski Date: Sun, 23 Jan 2022 14:13:59 +0100 Subject: [PATCH] Enable fourmolu code formatter --- benchmark/BinTree.hs | 28 ++++----- fourmolu.yaml | 8 +++ src/Data/Boltzmann/Oracle.hs | 95 ++++++++++++++--------------- src/Data/Boltzmann/Sampler.hs | 17 +++--- src/Data/Boltzmann/Sampler/Utils.hs | 58 +++++++++--------- src/Data/Boltzmann/Specifiable.hs | 45 +++++++------- src/Data/Boltzmann/Specification.hs | 77 ++++++++++++----------- src/Data/BuffonMachine.hs | 41 ++++++------- test/Data/Types/BinTree.hs | 38 ++++++------ test/Data/Types/Custom.hs | 46 +++++++------- test/Data/Types/Lambda.hs | 58 +++++++++--------- test/Data/Types/Tree.hs | 22 +++---- test/Spec.hs | 8 +-- test/Test/Unit/BuffonMachine.hs | 30 ++++----- test/Test/Unit/Sampler.hs | 8 +-- test/Test/Unit/Specifiable.hs | 28 ++++----- test/Test/Unit/Specification.hs | 87 +++++++++++++------------- 17 files changed, 347 insertions(+), 347 deletions(-) create mode 100644 fourmolu.yaml diff --git a/benchmark/BinTree.hs b/benchmark/BinTree.hs index a3146a2..c3cf64d 100644 --- a/benchmark/BinTree.hs +++ b/benchmark/BinTree.hs @@ -7,16 +7,16 @@ module BinTree where import Control.DeepSeq (NFData) import Data.Boltzmann.Sampler (BoltzmannSampler (..)) import Data.Boltzmann.Sampler.Utils (mkSampler) -import Data.Boltzmann.Specifiable - ( Specifiable, - ) -import Data.Boltzmann.Specification - ( SystemSpec, - specification, - withSystem, - withWeights, - (==>), - ) +import Data.Boltzmann.Specifiable ( + Specifiable, + ) +import Data.Boltzmann.Specification ( + SystemSpec, + specification, + withSystem, + withWeights, + (==>), + ) import GHC.Generics (Generic) data BinTree @@ -28,10 +28,10 @@ binTreeSysSpec :: SystemSpec binTreeSysSpec = (undefined :: BinTree, 4000) `withSystem` [ specification - (undefined :: BinTree) - ( withWeights - ['Leaf ==> 0] - ) + (undefined :: BinTree) + ( withWeights + ['Leaf ==> 0] + ) ] $(mkSampler ''BinTree) diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..fc79883 --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,8 @@ +indentation: 2 +comma-style: leading +record-brace-space: true +indent-wheres: true +diff-friendly-import-export: true +respectful: true +haddock-style: single-line +newlines-between-decls: 1 diff --git a/src/Data/Boltzmann/Oracle.hs b/src/Data/Boltzmann/Oracle.hs index a0a50f5..76bec97 100644 --- a/src/Data/Boltzmann/Oracle.hs +++ b/src/Data/Boltzmann/Oracle.hs @@ -8,59 +8,56 @@ -- License : BSD3 -- Maintainer : maciej.bendkowski@gmail.com -- Stability : experimental --- --- -module Data.Boltzmann.Oracle - ( mkSpecSampler, - ) -where +module Data.Boltzmann.Oracle ( + mkSpecSampler, +) where import Control.Monad (replicateM) import Data.Boltzmann.Sampler (BoltzmannSampler (sample)) -import Data.Boltzmann.Specifiable - ( Cons (args, name), - Specifiable (..), - SpecifiableType (..), - TypeDef, - ) +import Data.Boltzmann.Specifiable ( + Cons (args, name), + Specifiable (..), + SpecifiableType (..), + TypeDef, + ) import Data.Boltzmann.Specification (getWeight) import qualified Data.Boltzmann.Specification as S import Data.BuffonMachine (DDG) import qualified Data.Map as Map import Data.Map.Strict (Map) import Data.Maybe (fromJust) -import Data.Paganini - ( Expr, - FromVariable, - Let (Let), - PaganiniError, - Spec, - ddg, - debugPaganini, - tune, - variable, - variable', - (.=.), - ) +import Data.Paganini ( + Expr, + FromVariable, + Let (Let), + PaganiniError, + Spec, + ddg, + debugPaganini, + tune, + variable, + variable', + (.=.), + ) import Data.Set (Set) import qualified Data.Set as Set -import Data.Vector - ( fromList, - ) +import Data.Vector ( + fromList, + ) import Instances.TH.Lift () -import Language.Haskell.TH - ( Exp (LamCaseE), - Lit (IntegerL), - runIO, - ) -import Language.Haskell.TH.Syntax - ( Body (NormalB), - Exp (LitE), - Lit (StringL), - Match (Match), - Pat (LitP), - Q, - ) +import Language.Haskell.TH ( + Exp (LamCaseE), + Lit (IntegerL), + runIO, + ) +import Language.Haskell.TH.Syntax ( + Body (NormalB), + Exp (LitE), + Lit (StringL), + Match (Match), + Pat (LitP), + Q, + ) -- nicer sum for non-empty lists. sum' :: Num a => [a] -> a @@ -95,10 +92,10 @@ mkMarkingVariables sys = do return $ Map.fromList xs data Params = Params - { sizeVar :: forall a. FromVariable a => a, - typeVariable :: Map String Let, - markingVariable :: Map String Let, - systemSpec :: S.SystemSpec + { sizeVar :: forall a. FromVariable a => a + , typeVariable :: Map String Let + , markingVariable :: Map String Let + , systemSpec :: S.SystemSpec } mkTypeVariables :: Params -> Set SpecifiableType -> Spec () @@ -155,10 +152,10 @@ paganiniSpec sys@(S.SystemSpec {S.targetType = target, S.meanSize = n}) = do let params = Params - { sizeVar = z, - typeVariable = varDefs, - markingVariable = markDefs, - systemSpec = sys + { sizeVar = z + , typeVariable = varDefs + , markingVariable = markDefs + , systemSpec = sys } mkTypeVariables params specifiableTypes diff --git a/src/Data/Boltzmann/Sampler.hs b/src/Data/Boltzmann/Sampler.hs index fd5ab58..370a1a3 100644 --- a/src/Data/Boltzmann/Sampler.hs +++ b/src/Data/Boltzmann/Sampler.hs @@ -12,15 +12,14 @@ -- License : BSD3 -- Maintainer : maciej.bendkowski@gmail.com -- Stability : experimental -module Data.Boltzmann.Sampler - ( RejectionSampler, - DDGSelector, - WeightSelector, - BoltzmannSampler (..), - rejectionSampler, - rejectionSamplerIO, - ) -where +module Data.Boltzmann.Sampler ( + RejectionSampler, + DDGSelector, + WeightSelector, + BoltzmannSampler (..), + rejectionSampler, + rejectionSamplerIO, +) where import Control.Monad (guard) import Control.Monad.Trans (MonadTrans (lift)) diff --git a/src/Data/Boltzmann/Sampler/Utils.hs b/src/Data/Boltzmann/Sampler/Utils.hs index b716dcc..e5211a1 100644 --- a/src/Data/Boltzmann/Sampler/Utils.hs +++ b/src/Data/Boltzmann/Sampler/Utils.hs @@ -17,27 +17,27 @@ import qualified Control.Monad.Trans as T import Data.Boltzmann.Sampler (sample) import Data.BuffonMachine (choice) import Language.Haskell.TH (Exp (DoE, LamCaseE, TupE), Pat (VarP), Stmt (NoBindS), newName) -import Language.Haskell.TH.Datatype - ( ConstructorInfo (constructorName), - DatatypeInfo (..), - constructorFields, - constructorName, - reifyDatatype, - ) -import Language.Haskell.TH.Syntax - ( Body (NormalB), - Clause (Clause), - Dec (FunD, InstanceD), - Exp (AppE, ConE, InfixE, LamE, LitE, VarE), - Lit (IntegerL, StringL), - Match (Match), - Name, - Pat (LitP, TupP), - Q, - Stmt (BindS), - Type (AppT, ConT), - mkName, - ) +import Language.Haskell.TH.Datatype ( + ConstructorInfo (constructorName), + DatatypeInfo (..), + constructorFields, + constructorName, + reifyDatatype, + ) +import Language.Haskell.TH.Syntax ( + Body (NormalB), + Clause (Clause), + Dec (FunD, InstanceD), + Exp (AppE, ConE, InfixE, LamE, LitE, VarE), + Lit (IntegerL, StringL), + Match (Match), + Name, + Pat (LitP, TupP), + Q, + Stmt (BindS), + Type (AppT, ConT), + mkName, + ) import Prelude hiding (sum) application :: Exp -> Exp -> [Exp] -> Exp @@ -108,9 +108,9 @@ genConstrApplication s args' = do return $ foldl AppE con args' data ArgStmtExpr = ArgStmtExpr - { stmts :: [Stmt], - objs :: [Exp], - weights :: [Exp] + { stmts :: [Stmt] + , objs :: [Exp] + , weights :: [Exp] } genArgExprs :: ConstructorInfo -> Q ArgStmtExpr @@ -130,9 +130,9 @@ genArgExprs' ubExpr (_ : as) = do let stmt = BindS (TupP [xp, wp]) (AppE (AppE (AppE argExpr (VarE $ mkName "ddgs")) (VarE $ mkName "weight")) ubExpr) return ArgStmtExpr - { stmts = stmt : stmts argStmtExpr, - objs = x : objs argStmtExpr, - weights = w : weights argStmtExpr + { stmts = stmt : stmts argStmtExpr + , objs = x : objs argStmtExpr + , weights = w : weights argStmtExpr } genChoiceExpr :: Name -> Q Exp @@ -167,8 +167,8 @@ gen typ = do [pat "ddgs", pat "weight", pat "ub"] $ DoE Nothing - [ NoBindS guardExpr, - NoBindS $ InfixE (Just choiceExpr) bindOp (Just caseExpr) + [ NoBindS guardExpr + , NoBindS $ InfixE (Just choiceExpr) bindOp (Just caseExpr) ] genConstrGroup :: Name -> Q [(ConstructorInfo, Integer)] diff --git a/src/Data/Boltzmann/Specifiable.hs b/src/Data/Boltzmann/Specifiable.hs index a73a8f1..bc3409d 100644 --- a/src/Data/Boltzmann/Specifiable.hs +++ b/src/Data/Boltzmann/Specifiable.hs @@ -17,28 +17,27 @@ -- Stability : experimental -- -- Specifiable types, i.e. types which have corresponding (multiparametric) samplers. -module Data.Boltzmann.Specifiable - ( SpecifiableType (..), - TypeDef, - Cons (..), - Specifiable (..), - listTypeName, - ) -where +module Data.Boltzmann.Specifiable ( + SpecifiableType (..), + TypeDef, + Cons (..), + Specifiable (..), + listTypeName, +) where -import GHC.Generics - ( C1, - Constructor (conName), - D1, - Datatype (datatypeName, moduleName), - Generic (Rep, from), - K1, - R, - S1, - U1, - type (:*:), - type (:+:), - ) +import GHC.Generics ( + C1, + Constructor (conName), + D1, + Datatype (datatypeName, moduleName), + Generic (Rep, from), + K1, + R, + S1, + U1, + type (:*:), + type (:+:), + ) import Language.Haskell.TH.Syntax (Lift) -- | Specifiable, algebraic type definition given @@ -48,8 +47,8 @@ type TypeDef = [Cons] -- | Type constructors. data Cons = Cons { -- | Fully-qualified constructor name. - name :: String, - -- | List of (specifiable) arguments. + name :: String + , -- | List of (specifiable) arguments. args :: [SpecifiableType] } deriving (Eq, Show, Lift) diff --git a/src/Data/Boltzmann/Specification.hs b/src/Data/Boltzmann/Specification.hs index cf58f6a..6fc8456 100644 --- a/src/Data/Boltzmann/Specification.hs +++ b/src/Data/Boltzmann/Specification.hs @@ -8,30 +8,29 @@ -- License : BSD3 -- Maintainer : maciej.bendkowski@gmail.com -- Stability : experimental -module Data.Boltzmann.Specification - ( TypeSpec (..), - SystemSpec (..), - defaultTypeSpec, - withWeights, - withFrequencies, - specification, - withSystem, - (==>), - collectTypes, - ConsFreq, - Value, - constructorFrequencies, - getWeight, - getFrequency, - ) -where +module Data.Boltzmann.Specification ( + TypeSpec (..), + SystemSpec (..), + defaultTypeSpec, + withWeights, + withFrequencies, + specification, + withSystem, + (==>), + collectTypes, + ConsFreq, + Value, + constructorFrequencies, + getWeight, + getFrequency, +) where import Data.Bifunctor (Bifunctor (first)) -import Data.Boltzmann.Specifiable - ( Cons (args), - Specifiable (..), - SpecifiableType (..), - ) +import Data.Boltzmann.Specifiable ( + Cons (args), + Specifiable (..), + SpecifiableType (..), + ) import qualified Data.Map as Map import Data.Map.Strict (Map) import Data.Maybe (fromJust) @@ -44,11 +43,11 @@ data TypeSpec = forall a. Specifiable a => TypeSpec { -- | Corresponding specifiable type `a`. - specifiableType :: a, - -- | Constructors of `a` mapped to their (custom) weight. If no custom + specifiableType :: a + , -- | Constructors of `a` mapped to their (custom) weight. If no custom -- weight is provided, a default one of 1 is assumed. - weight :: Map String Integer, - -- | Constructors of `a` mapped to their (custom) frequencies. If no custom + weight :: Map String Integer + , -- | Constructors of `a` mapped to their (custom) frequencies. If no custom -- frequency is provided, no frequency is assumed. frequency :: Map String Integer } @@ -66,10 +65,10 @@ data SystemSpec = forall a. Specifiable a => SystemSpec { -- | Specifiable which is designated as the "target" tuning type. - targetType :: a, - -- | Target mean size of the objects corresponding to the tuned system. - meanSize :: Integer, - -- | Set of interdependent, specifiable types. + targetType :: a + , -- | Target mean size of the objects corresponding to the tuned system. + meanSize :: Integer + , -- | Set of interdependent, specifiable types. typeSpecs :: Set TypeSpec } @@ -109,13 +108,13 @@ getFrequency' name spec = name `Map.lookup` frequency spec defaultTypeSpec :: Specifiable a => a -> TypeSpec defaultTypeSpec typ = TypeSpec - { specifiableType = typ, - weight = + { specifiableType = typ + , weight = Map.fromList - [ (show '[], 0), - (show '(:), 0) - ], - frequency = Map.empty + [ (show '[], 0) + , (show '(:), 0) + ] + , frequency = Map.empty } -- | Constructor names with associated numeric values (for either weights or frequencies). @@ -154,9 +153,9 @@ withSystem :: SystemSpec withSystem (typ, size) specs = SystemSpec - { targetType = typ, - meanSize = size, - typeSpecs = Set.fromList specs + { targetType = typ + , meanSize = size + , typeSpecs = Set.fromList specs } toSpecifiableTypes :: SystemSpec -> Set SpecifiableType diff --git a/src/Data/BuffonMachine.hs b/src/Data/BuffonMachine.hs index 6399c77..ecdcabc 100644 --- a/src/Data/BuffonMachine.hs +++ b/src/Data/BuffonMachine.hs @@ -15,24 +15,23 @@ -- * J. Lumbroso : "Optimal Discrete Uniform Generation from Coin Flips, and Applications". -- * F. A. Saad, C. E. Freer, M. C. Rinard, V.K. Mansinghka "Optimal Approximate -- Sampling from Discrete Probability Distributions", POPL'20 (2020). -module Data.BuffonMachine - ( BuffonMachine, - Discrete, - Oracle (..), - DDG, - choice, - run, - runIO, - ) -where +module Data.BuffonMachine ( + BuffonMachine, + Discrete, + Oracle (..), + DDG, + choice, + run, + runIO, +) where -import Control.Monad.Trans.State.Strict - ( State, - evalState, - get, - modify', - put, - ) +import Control.Monad.Trans.State.Strict ( + State, + evalState, + get, + modify', + put, + ) import Data.Bits (Bits (testBit)) import Data.Vector (Vector, null, (!)) import Data.Word (Word32) @@ -42,10 +41,10 @@ import Prelude hiding (null) -- | Buffered random bit oracle. data Oracle g = Oracle { -- | 32-bit buffer of random bits. - buffer :: !Word32, - -- | Number of bits consumed from the current buffer. - usedBits :: !Int, - -- | Random number generator used to obtain random bits. + buffer :: !Word32 + , -- | Number of bits consumed from the current buffer. + usedBits :: !Int + , -- | Random number generator used to obtain random bits. rng :: g } diff --git a/test/Data/Types/BinTree.hs b/test/Data/Types/BinTree.hs index 6e622e1..5fe2b8b 100644 --- a/test/Data/Types/BinTree.hs +++ b/test/Data/Types/BinTree.hs @@ -6,19 +6,19 @@ module Data.Types.BinTree where import Data.Boltzmann.Sampler (BoltzmannSampler (..)) import Data.Boltzmann.Sampler.Utils (mkSampler) -import Data.Boltzmann.Specifiable - ( Cons (..), - Specifiable, - SpecifiableType (..), - TypeDef, - ) -import Data.Boltzmann.Specification - ( SystemSpec, - specification, - withSystem, - withWeights, - (==>), - ) +import Data.Boltzmann.Specifiable ( + Cons (..), + Specifiable, + SpecifiableType (..), + TypeDef, + ) +import Data.Boltzmann.Specification ( + SystemSpec, + specification, + withSystem, + withWeights, + (==>), + ) import GHC.Generics (Generic) import Test.Unit.Utils (Size (..)) @@ -36,18 +36,18 @@ binTree = SpecifiableType (undefined :: BinTree) expectedTypeDef :: TypeDef expectedTypeDef = - [ Cons {name = "Data.Types.BinTree.Leaf", args = []}, - Cons {name = "Data.Types.BinTree.Node", args = [binTree, binTree]} + [ Cons {name = "Data.Types.BinTree.Leaf", args = []} + , Cons {name = "Data.Types.BinTree.Node", args = [binTree, binTree]} ] binTreeSysSpec :: SystemSpec binTreeSysSpec = (undefined :: BinTree, 4000) `withSystem` [ specification - (undefined :: BinTree) - ( withWeights - ['Leaf ==> 0] - ) + (undefined :: BinTree) + ( withWeights + ['Leaf ==> 0] + ) ] $(mkSampler ''BinTree) diff --git a/test/Data/Types/Custom.hs b/test/Data/Types/Custom.hs index 6f19a2d..530751d 100644 --- a/test/Data/Types/Custom.hs +++ b/test/Data/Types/Custom.hs @@ -4,18 +4,18 @@ module Data.Types.Custom where -import Data.Boltzmann.Specifiable - ( Specifiable, - SpecifiableType (..), - ) -import Data.Boltzmann.Specification - ( SystemSpec, - specification, - withFrequencies, - withSystem, - withWeights, - (==>), - ) +import Data.Boltzmann.Specifiable ( + Specifiable, + SpecifiableType (..), + ) +import Data.Boltzmann.Specification ( + SystemSpec, + specification, + withFrequencies, + withSystem, + withWeights, + (==>), + ) import GHC.Generics (Generic) import Test.Unit.Utils (Size (..)) @@ -48,15 +48,15 @@ customSysSpec :: SystemSpec customSysSpec = (undefined :: Custom, 10000) `withSystem` [ specification - (undefined :: Custom) - ( withWeights - [ 'ConsA ==> 2, - 'ConsB ==> 3, - 'ConsC ==> 4 - ] - . withFrequencies - [ 'ConsA ==> 800, - 'ConsB ==> 900 - ] - ) + (undefined :: Custom) + ( withWeights + [ 'ConsA ==> 2 + , 'ConsB ==> 3 + , 'ConsC ==> 4 + ] + . withFrequencies + [ 'ConsA ==> 800 + , 'ConsB ==> 900 + ] + ) ] diff --git a/test/Data/Types/Lambda.hs b/test/Data/Types/Lambda.hs index 85f6f38..56fab4c 100644 --- a/test/Data/Types/Lambda.hs +++ b/test/Data/Types/Lambda.hs @@ -7,20 +7,20 @@ module Data.Types.Lambda where import Data.Boltzmann.Sampler (BoltzmannSampler (..)) import Data.Boltzmann.Sampler.Utils (mkSampler) -import Data.Boltzmann.Specifiable - ( Cons (..), - Specifiable, - SpecifiableType (..), - TypeDef, - ) -import Data.Boltzmann.Specification - ( SystemSpec, - specification, - withFrequencies, - withSystem, - withWeights, - (==>), - ) +import Data.Boltzmann.Specifiable ( + Cons (..), + Specifiable, + SpecifiableType (..), + TypeDef, + ) +import Data.Boltzmann.Specification ( + SystemSpec, + specification, + withFrequencies, + withSystem, + withWeights, + (==>), + ) import GHC.Generics (Generic) import Test.Unit.Utils (Size (..)) @@ -50,37 +50,37 @@ lambda = SpecifiableType (undefined :: Lambda) expectedDeBruijnTypeDef :: TypeDef expectedDeBruijnTypeDef = - [ Cons {name = "Data.Types.Lambda.S", args = [deBruijn]}, - Cons {name = "Data.Types.Lambda.Z", args = []} + [ Cons {name = "Data.Types.Lambda.S", args = [deBruijn]} + , Cons {name = "Data.Types.Lambda.Z", args = []} ] expectedLambdaTypeDef :: TypeDef expectedLambdaTypeDef = - [ Cons {name = "Data.Types.Lambda.Abs", args = [lambda]}, - Cons {name = "Data.Types.Lambda.App", args = [lambda, lambda]}, - Cons {name = "Data.Types.Lambda.Index", args = [deBruijn]} + [ Cons {name = "Data.Types.Lambda.Abs", args = [lambda]} + , Cons {name = "Data.Types.Lambda.App", args = [lambda, lambda]} + , Cons {name = "Data.Types.Lambda.Index", args = [deBruijn]} ] lambdaSysSpec :: SystemSpec lambdaSysSpec = (undefined :: Lambda, 1000) `withSystem` [ specification - (undefined :: Lambda) - ( withWeights - ['Index ==> 0] - . withFrequencies - ['Abs ==> 330] - ) + (undefined :: Lambda) + ( withWeights + ['Index ==> 0] + . withFrequencies + ['Abs ==> 330] + ) ] lambdaListSysSpec :: SystemSpec lambdaListSysSpec = (undefined :: [Lambda], 1000) `withSystem` [ specification - (undefined :: [Lambda]) - ( withWeights - ['Index ==> 0] - ) + (undefined :: [Lambda]) + ( withWeights + ['Index ==> 0] + ) ] $(mkSampler ''DeBruijn) diff --git a/test/Data/Types/Tree.hs b/test/Data/Types/Tree.hs index 6376ed9..7f81aee 100644 --- a/test/Data/Types/Tree.hs +++ b/test/Data/Types/Tree.hs @@ -6,17 +6,17 @@ module Data.Types.Tree where import Data.Boltzmann.Sampler (BoltzmannSampler (..)) import Data.Boltzmann.Sampler.Utils (mkSampler) -import Data.Boltzmann.Specifiable - ( Cons (..), - Specifiable, - SpecifiableType (..), - TypeDef, - ) -import Data.Boltzmann.Specification - ( SystemSpec, - defaultTypeSpec, - withSystem, - ) +import Data.Boltzmann.Specifiable ( + Cons (..), + Specifiable, + SpecifiableType (..), + TypeDef, + ) +import Data.Boltzmann.Specification ( + SystemSpec, + defaultTypeSpec, + withSystem, + ) import GHC.Generics (Generic) import Test.Unit.Utils (Size (..)) diff --git a/test/Spec.hs b/test/Spec.hs index 96ccb2a..ce2f37f 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -12,8 +12,8 @@ tests = testGroup "Unit tests" unitTests unitTests :: [TestTree] unitTests = - [ Specifiable.unitTests, - Specification.unitTests, - BuffonMachine.unitTests, - Sampler.unitTests + [ Specifiable.unitTests + , Specification.unitTests + , BuffonMachine.unitTests + , Sampler.unitTests ] diff --git a/test/Test/Unit/BuffonMachine.hs b/test/Test/Unit/BuffonMachine.hs index 286501b..a0f8b9d 100644 --- a/test/Test/Unit/BuffonMachine.hs +++ b/test/Test/Unit/BuffonMachine.hs @@ -4,15 +4,15 @@ import Control.Monad (replicateM) import Data.BuffonMachine (choice, runIO) import qualified Data.Map as Map import Data.Vector (Vector, fromList) -import Test.Tasty - ( TestTree, - testGroup, - ) -import Test.Tasty.HUnit - ( Assertion, - assertBool, - testCase, - ) +import Test.Tasty ( + TestTree, + testGroup, + ) +import Test.Tasty.HUnit ( + Assertion, + assertBool, + testCase, + ) unitTests :: TestTree unitTests = @@ -27,18 +27,18 @@ choiceTests = [ testCase "[1/2, 1/2] is correctly sampled from" $ do [(0, a), (1, b)] <- choiceTest distributionA 1000000 a `almostEqual` 0.5 - b `almostEqual` 0.5, - testCase "[1/3, 1/3, 1/3] is correctly sampled from" $ do + b `almostEqual` 0.5 + , testCase "[1/3, 1/3, 1/3] is correctly sampled from" $ do [(0, a), (1, b), (2, c)] <- choiceTest distributionB 1000000 a `almostEqual` 0.33 b `almostEqual` 0.33 - c `almostEqual` 0.33, - testCase "[1/7, 4/7, 2/7] is correctly sampled from" $ do + c `almostEqual` 0.33 + , testCase "[1/7, 4/7, 2/7] is correctly sampled from" $ do [(0, a), (1, b), (2, c)] <- choiceTest distributionC 1000000 a `almostEqual` 0.14 b `almostEqual` 0.57 - c `almostEqual` 0.28, - testCase "[1/1] is correctly sampled from" $ do + c `almostEqual` 0.28 + , testCase "[1/1] is correctly sampled from" $ do [(0, a)] <- choiceTest distributionD 1000000 a `almostEqual` 1.0 ] diff --git a/test/Test/Unit/Sampler.hs b/test/Test/Unit/Sampler.hs index e1cba44..4831bae 100644 --- a/test/Test/Unit/Sampler.hs +++ b/test/Test/Unit/Sampler.hs @@ -17,10 +17,10 @@ unitTests = sampleSizeTests :: [TestTree] sampleSizeTests = - [ testProperty "Lambda sampler respects size constraints for sizes around the mean of 1,000" lambdaSamplerSizeProp, - testProperty "BinTree sampler respects size constraints for sizes around the mean of 1,000" binTreeSamplerSizeProp, - testProperty "Tree sampler respects size constraints for sizes around the mean of 1,000" treeSamplerSizeProp, - testProperty "Lambda list sampler respects size constraints for sizes around the mean of 1,000" lambdaListSamplerSizeProp + [ testProperty "Lambda sampler respects size constraints for sizes around the mean of 1,000" lambdaSamplerSizeProp + , testProperty "BinTree sampler respects size constraints for sizes around the mean of 1,000" binTreeSamplerSizeProp + , testProperty "Tree sampler respects size constraints for sizes around the mean of 1,000" treeSamplerSizeProp + , testProperty "Lambda list sampler respects size constraints for sizes around the mean of 1,000" lambdaListSamplerSizeProp ] lambdaSamplerSizeProp :: Positive Int -> Property diff --git a/test/Test/Unit/Specifiable.hs b/test/Test/Unit/Specifiable.hs index 275cab5..9784e87 100644 --- a/test/Test/Unit/Specifiable.hs +++ b/test/Test/Unit/Specifiable.hs @@ -23,12 +23,12 @@ typeDefinitionTests = testGroup "Type definition unit tests" [ testCase "BinTree has a correct type definition" $ - BinTree.expectedTypeDef @=? typedef (undefined :: BinTree), - testCase "Tree has a correct type definition" $ - Tree.expectedTypeDef @=? typedef (undefined :: Tree), - testCase "DeBruijn has a correct type definition" $ - Lambda.expectedDeBruijnTypeDef @=? typedef (undefined :: DeBruijn), - testCase "Lambda has a correct type definition" $ + BinTree.expectedTypeDef @=? typedef (undefined :: BinTree) + , testCase "Tree has a correct type definition" $ + Tree.expectedTypeDef @=? typedef (undefined :: Tree) + , testCase "DeBruijn has a correct type definition" $ + Lambda.expectedDeBruijnTypeDef @=? typedef (undefined :: DeBruijn) + , testCase "Lambda has a correct type definition" $ Lambda.expectedLambdaTypeDef @=? typedef (undefined :: Lambda) ] @@ -37,13 +37,13 @@ typeNameTests = testGroup "Type name unit tests" [ testCase "BinTree's type name is correct" $ - show ''BinTree @=? typeName (undefined :: BinTree), - testCase "Tree's type name is correct" $ - show ''Tree @=? typeName (undefined :: Tree), - testCase "Lambda's type name is correct" $ - show ''Lambda @=? typeName (undefined :: Lambda), - testCase "[DeBruijn]'s type name is correct" $ - "[Data.Types.Lambda.DeBruijn]" @=? typeName (undefined :: [DeBruijn]), - testCase "[[DeBruijn]]'s type name is correct" $ + show ''BinTree @=? typeName (undefined :: BinTree) + , testCase "Tree's type name is correct" $ + show ''Tree @=? typeName (undefined :: Tree) + , testCase "Lambda's type name is correct" $ + show ''Lambda @=? typeName (undefined :: Lambda) + , testCase "[DeBruijn]'s type name is correct" $ + "[Data.Types.Lambda.DeBruijn]" @=? typeName (undefined :: [DeBruijn]) + , testCase "[[DeBruijn]]'s type name is correct" $ "[[Data.Types.Lambda.DeBruijn]]" @=? typeName (undefined :: [[DeBruijn]]) ] diff --git a/test/Test/Unit/Specification.hs b/test/Test/Unit/Specification.hs index ea5f226..d59fa77 100644 --- a/test/Test/Unit/Specification.hs +++ b/test/Test/Unit/Specification.hs @@ -1,9 +1,8 @@ {-# LANGUAGE TemplateHaskellQuotes #-} -module Test.Unit.Specification - ( unitTests, - ) -where +module Test.Unit.Specification ( + unitTests, +) where import qualified Data.Boltzmann.Specification as Specification import qualified Data.Map as Map @@ -14,14 +13,14 @@ import qualified Data.Types.Custom as Custom import Data.Types.Lambda (Lambda) import qualified Data.Types.Lambda as Lambda import qualified Data.Types.Tree as Tree -import Test.Tasty - ( TestTree, - testGroup, - ) -import Test.Tasty.HUnit - ( testCase, - (@=?), - ) +import Test.Tasty ( + TestTree, + testGroup, + ) +import Test.Tasty.HUnit ( + testCase, + (@=?), + ) unitTests :: TestTree unitTests = @@ -35,14 +34,14 @@ collectTypesTests = "Type collection unit tests" [ testCase "BinTree's types are collected correctly" $ Set.singleton BinTree.binTree - @=? Specification.collectTypes BinTree.binTreeSysSpec, - testCase "Lambda's types are collected correctly" $ + @=? Specification.collectTypes BinTree.binTreeSysSpec + , testCase "Lambda's types are collected correctly" $ Set.fromList [Lambda.lambda, Lambda.deBruijn] - @=? Specification.collectTypes Lambda.lambdaSysSpec, - testCase "Trees's types are collected correctly" $ + @=? Specification.collectTypes Lambda.lambdaSysSpec + , testCase "Trees's types are collected correctly" $ Set.fromList [Tree.tree, Tree.treeList] - @=? Specification.collectTypes Tree.treeSysSpec, - testCase "Custom's types are collected correctly" $ + @=? Specification.collectTypes Tree.treeSysSpec + , testCase "Custom's types are collected correctly" $ Set.fromList [Custom.custom, Custom.custom', Custom.customList'] @=? Specification.collectTypes Custom.customSysSpec ] @@ -52,13 +51,13 @@ constructorFrequenciesTests = testGroup "Constructor frequency tests" [ testCase "BinTree's constructor frequencies are collected correctly" $ - Map.empty @=? Specification.constructorFrequencies BinTree.binTreeSysSpec, - testCase "Lambda's constructor frequencies are collected correctly" $ + Map.empty @=? Specification.constructorFrequencies BinTree.binTreeSysSpec + , testCase "Lambda's constructor frequencies are collected correctly" $ Map.fromList [("Data.Types.Lambda.Abs", 330)] - @=? Specification.constructorFrequencies Lambda.lambdaSysSpec, - testCase "Tree's constructor frequencies are collected correctly" $ - Map.empty @=? Specification.constructorFrequencies Tree.treeSysSpec, - testCase "Custom's constructor frequencies are collected correctly" $ + @=? Specification.constructorFrequencies Lambda.lambdaSysSpec + , testCase "Tree's constructor frequencies are collected correctly" $ + Map.empty @=? Specification.constructorFrequencies Tree.treeSysSpec + , testCase "Custom's constructor frequencies are collected correctly" $ Map.fromList [("Data.Types.Custom.ConsA", 800), ("Data.Types.Custom.ConsB", 900)] @=? Specification.constructorFrequencies Custom.customSysSpec ] @@ -69,18 +68,18 @@ getWeightTests = "Constructor weight unit tests" [ testCase "BinTree's constructor weights are computed correctly" $ do 0 @=? BinTree.binTreeSysSpec `Specification.getWeight` show 'BinTree.Leaf - 1 @=? BinTree.binTreeSysSpec `Specification.getWeight` show 'BinTree.Node, - testCase "Lambda's constructor weights are computed correctly" $ do + 1 @=? BinTree.binTreeSysSpec `Specification.getWeight` show 'BinTree.Node + , testCase "Lambda's constructor weights are computed correctly" $ do 0 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Index 1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Abs 1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.App 1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.S - 1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Z, - testCase "Tree's constructor weights are computed correctly" $ do + 1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Z + , testCase "Tree's constructor weights are computed correctly" $ do 1 @=? Tree.treeSysSpec `Specification.getWeight` show 'Tree.Node 0 @=? Tree.treeSysSpec `Specification.getWeight` show '[] - 0 @=? Tree.treeSysSpec `Specification.getWeight` show '(:), - testCase "Custom's constructor weights are computed correctly" $ do + 0 @=? Tree.treeSysSpec `Specification.getWeight` show '(:) + , testCase "Custom's constructor weights are computed correctly" $ do 2 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsA 3 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsB 4 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsC @@ -92,18 +91,18 @@ getFrequencyTests = "Constructor frequencies unit tests" [ testCase "BinTree's constructor frequencies are computed correctly" $ do Nothing @=? BinTree.binTreeSysSpec `Specification.getFrequency` show 'BinTree.Leaf - Nothing @=? BinTree.binTreeSysSpec `Specification.getFrequency` show 'BinTree.Node, - testCase "Lambda's constructor frequencies are computed correctly" $ do + Nothing @=? BinTree.binTreeSysSpec `Specification.getFrequency` show 'BinTree.Node + , testCase "Lambda's constructor frequencies are computed correctly" $ do Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Index Just 330 @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Abs Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.App Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.S - Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Z, - testCase "Tree's constructor frequencies are computed correctly" $ do + Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Z + , testCase "Tree's constructor frequencies are computed correctly" $ do Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show 'Tree.Node Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show '[] - Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show '(:), - testCase "Custom's constructor frequencies are computed correctly" $ do + Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show '(:) + , testCase "Custom's constructor frequencies are computed correctly" $ do Just 800 @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsA Just 900 @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsB Nothing @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsC @@ -115,8 +114,8 @@ typeSpecTests = "TypeSpec unit tests" [ testCase "Equal type specs are correctly identified" $ do True @=? a == a - False @=? a == b, - testCase "Type specs are correctly ordered" $ do + False @=? a == b + , testCase "Type specs are correctly ordered" $ do True @=? a <= a True @=? b <= a False @=? a <= b @@ -124,14 +123,14 @@ typeSpecTests = where a = Specification.TypeSpec - { Specification.specifiableType = undefined :: Lambda, - Specification.weight = Map.empty, - Specification.frequency = Map.empty + { Specification.specifiableType = undefined :: Lambda + , Specification.weight = Map.empty + , Specification.frequency = Map.empty } b = Specification.TypeSpec - { Specification.specifiableType = undefined :: BinTree, - Specification.weight = Map.empty, - Specification.frequency = Map.empty + { Specification.specifiableType = undefined :: BinTree + , Specification.weight = Map.empty + , Specification.frequency = Map.empty }