alga 0.2.1 → 0.2.2

raw patch · 16 files changed

+199/−194 lines, 16 filesdep +file-embeddep +hspecdep +semigroupsdep −test-frameworkdep −test-framework-quickcheck2dep ~QuickCheckdep ~aesondep ~algaPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: file-embed, hspec, semigroups

Dependencies removed: test-framework, test-framework-quickcheck2

Dependency ranges changed: QuickCheck, aeson, alga, base, containers, data-default, exceptions, filepath, formatting, haskeline, hxt, megaparsec, mtl, optparse-applicative, path, path-io, text, tf-random, transformers, yaml

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• alga.cabal +55/−49
• license.txt +16/−0
• notice.txt +5/−0
• src/Alga/Interaction.hs +1/−1
• src/Alga/Interaction/Commands.hs +3/−3
• src/Alga/Language.hs +2/−1
• src/Alga/Language/Element.hs +2/−1
• src/Alga/Language/Environment.hs +4/−3
• src/Alga/Language/Eval.hs +13/−11
• src/Alga/Language/SyntaxTree.hs +63/−6
• src/Alga/Representation.hs +1/−2
• src/Alga/Representation/Parser.hs +8/−15
• src/Alga/Representation/Show.hs +4/−4
• src/Main.hs +5/−21
• tests/Main.hs +13/−77

@@ -1,3 +1,7 @@+## ALGA 0.2.2++* Refactoring, switch to Hspec for testing and Megaparsec 5.+ ## ALGA 0.2.1  * Fixed issues with `directory` package. Please use `directory-1.2.3.0` or

@@ -17,7 +17,8 @@ -- with this program. If not, see <http://www.gnu.org/licenses/>.  name:                 alga-version:              0.2.1+version:              0.2.2+cabal-version:        >= 1.10 synopsis:             Algorithmic automation for various DAWs description: @@ -42,8 +43,10 @@ copyright:            Copyright © 2015–2016 Mark Karpov category:             Language build-type:           Simple-extra-source-files:   README.md, CHANGELOG.md-cabal-version:        >= 1.10+data-files:           notice.txt+                    , license.txt+extra-doc-files:      CHANGELOG.md+                    , README.md  flag dev   description:        Turn on development settings.@@ -56,19 +59,21 @@     ghc-options:      -O2 -Wall -Werror   else     ghc-options:      -O2 -Wall-  ghc-prof-options:   -O2 -Wall -prof -fprof-cafs -rtsopts-  build-depends:      base                   >= 4.8 && < 5-                    , containers             >= 0.5.5.1-                    , exceptions             >= 0.8-                    , haskeline              >= 0.7.1.3-                    , hxt                    >= 9.3.1.15-                    , megaparsec             >= 4.2-                    , mtl                    >= 2.1.3.1-                    , path                   >= 0.5.3+  build-depends:      QuickCheck             >= 2.8.2   && < 3.0+                    , base                   >= 4.8     && < 5.0+                    , containers             >= 0.5.5.1 && < 0.6+                    , exceptions             >= 0.8     && < 0.9+                    , haskeline              >= 0.7.1.3 && < 0.8+                    , hxt                    >= 9.3.1   && < 9.4+                    , megaparsec             >= 5.0     && < 6.0+                    , mtl                    >= 2.1.3.1 && < 3.0+                    , path                   >= 0.5.3   && < 0.6                     , random-                    , text                   >= 1.2.0.4-                    , tf-random              >= 0.5-                    , transformers           >= 0.2.0.0+                    , text                   >= 1.2.0.4 && < 1.3+                    , tf-random              >= 0.5     && < 1.0+                    , transformers           >= 0.2.0.0 && < 0.6+  if !impl(ghc >= 8.0)+    build-depends:    semigroups   == 0.18.*   default-extensions: FlexibleContexts                     , FlexibleInstances                     , OverloadedStrings@@ -91,32 +96,34 @@ executable alga   main-is:            Main.hs   hs-source-dirs:     src-  other-modules:      Alga.Interaction   if flag(dev)     ghc-options:      -O2 -Wall -Werror   else     ghc-options:      -O2 -Wall-  ghc-prof-options:   -O2 -Wall -prof -fprof-cafs -rtsopts-  build-depends:      alga                   >= 0.2.1-                    , aeson                  >= 0.7-                    , base                   >= 4.8 && < 5-                    , containers             >= 0.5.5.1-                    , data-default           >= 0.5.3-                    , exceptions             >= 0.8-                    , filepath               >= 1.3.0.2-                    , formatting             >= 6.2-                    , haskeline              >= 0.7.1.3-                    , hxt                    >= 9.3.1.15-                    , megaparsec             >= 4.2-                    , mtl                    >= 2.1.3.1-                    , optparse-applicative   >= 0.11.0.2-                    , path                   >= 0.5.3-                    , path-io                >= 0.3.1+  build-depends:      QuickCheck             >= 2.8.2   && < 3.0+                    , aeson                  >= 0.7     && < 0.12+                    , alga                   >= 0.2.2+                    , base                   >= 4.8     && < 5.0+                    , containers             >= 0.5.5.1 && < 0.6+                    , data-default           >= 0.5.3   && < 0.8+                    , exceptions             >= 0.8     && < 0.9+                    , file-embed             >= 0.0.9+                    , filepath               >= 1.3.0.2 && < 1.5+                    , formatting             >= 6.2     && < 7.0+                    , haskeline              >= 0.7.1.3 && < 0.8+                    , hxt                    >= 9.3.1   && < 9.4+                    , megaparsec             >= 5.0     && < 6.0+                    , mtl                    >= 2.1.3.1 && < 3.0+                    , optparse-applicative   >= 0.11    && < 0.13+                    , path                   >= 0.5.3   && < 0.6+                    , path-io                >= 0.3.1   && < 2.0                     , random-                    , text                   >= 1.2.0.4-                    , tf-random              >= 0.5-                    , transformers           >= 0.2.0.0-                    , yaml                   >= 0.8.15.1+                    , text                   >= 1.2.0.4 && < 1.3+                    , tf-random              >= 0.5     && < 1.0+                    , transformers           >= 0.2.0.0 && < 0.6+                    , yaml                   >= 0.8.15  && < 0.9+  if !impl(ghc >= 8.0)+    build-depends:    semigroups   == 0.18.*   default-extensions: FlexibleContexts                     , FlexibleInstances                     , OverloadedStrings@@ -151,20 +158,19 @@   else     ghc-options:      -O2 -Wall   default-language:   Haskell2010-  build-depends:      QuickCheck                 >= 2.4 && < 3-                    , alga                       >= 0.2.1-                    , base                       >= 4.8 && < 5-                    , containers                 >= 0.5.5.1-                    , hxt                        >= 9.3.1.15-                    , megaparsec                 == 4.*-                    , mtl                        >= 2.1.3.1+  build-depends:      QuickCheck                 >= 2.8.2   && < 3.0+                    , alga                       >= 0.2.2+                    , base                       >= 4.8     && < 5.0+                    , containers                 >= 0.5.5.1 && < 0.6+                    , hspec                      >= 2.0     && < 3.0+                    , hxt                        >= 9.3.1   && < 9.4+                    , megaparsec                 >= 5.0     && < 6.0+                    , mtl                        >= 2.1.3.1 && < 3.0                     , random-                    , test-framework             >= 0.4 && < 1-                    , test-framework-quickcheck2 >= 0.3 && < 0.4-                    , text                       >= 1.2.0.4-                    , tf-random                  >= 0.5-                    , transformers               >= 0.2.0.0+                    , text                       >= 1.2.0.4 && < 1.3+                    , tf-random                  >= 0.5     && < 1.0+                    , transformers               >= 0.2.0.0 && < 0.6  source-repository head   type:               git-  location:           git://github.com/mrkkrp/alga.git+  location:           https://github.com/mrkkrp/alga.git

@@ -0,0 +1,16 @@+ALGA — algorithmic automation for various DAWs.++Copyright © 2015–2016 Mark Karpov++ALGA is free software: you can redistribute it and/or modify it under the+terms of the GNU General Public License as published by the Free Software+Foundation, either version 3 of the License, or (at your option) any+later version.++ALGA is distributed in the hope that it will be useful, but WITHOUT ANY+WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS+FOR A PARTICULAR PURPOSE. See the GNU General Public License for more+details.++You should have received a copy of the GNU General Public License along+with this program. If not, see <http://www.gnu.org/licenses/>.

@@ -0,0 +1,5 @@+ALGA Copyright © 2015–2016 Mark Karpov++This program comes with ABSOLUTELY NO WARRANTY. This is free software,+and you are welcome to redistribute it under certain conditions; see+GNU General Public License for details.

@@ -89,7 +89,7 @@   file <- gets stSrcFile   case parseAlga (fromAbsFile file) expr of     Right x -> mapM_ f x-    Left  x -> liftIO $ fprint (string % "\n") x+    Left  x -> liftIO (putStrLn x)     where f (Definition n t) = processDef n t           f (Exposition   t) = do             len     <- gets stPrevLen

@@ -47,10 +47,10 @@ import Path import Path.IO import System.Exit (exitSuccess, ExitCode)-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as T+import qualified Data.Text.Lazy           as T+import qualified Data.Text.Lazy.IO        as T import qualified System.Console.Haskeline as L-import qualified System.FilePath as FP+import qualified System.FilePath          as FP  -- | Description of REPL command. 

@@ -19,6 +19,7 @@ module Alga.Language   ( SyntaxTree   , Sel (..)+  , Statement (..)   , Principle   , NRatio   , Element (..)@@ -39,7 +40,7 @@   , toPrin ) where -import Alga.Language.SyntaxTree (SyntaxTree, Sel (..))+import Alga.Language.SyntaxTree (SyntaxTree, Sel (..), Statement (..)) import Alga.Language.Element (Principle, NRatio, Element (..)) import Alga.Language.Environment import Alga.Language.Eval (evalDef, eval, toPrin)

@@ -27,6 +27,7 @@ where  import Control.Arrow ((***))+import Data.List.NonEmpty (NonEmpty (..)) import Data.Ratio (Ratio) import Numeric.Natural @@ -46,7 +47,7 @@   = Val  a             -- ^ Single value, evaluates to itself   | Sec  [Element a]   -- ^ Universal container for other values   | Mul  [Element a]   -- ^ Multivalue, the way to introduce varying elements-  | CMul [([Element a], [Element a])] -- ^ Conditional multivalue+  | CMul (NonEmpty ([Element a], [Element a])) -- ^ Conditional multivalue     deriving (Eq, Show, Functor, Foldable)  instance Applicative Element where

@@ -47,10 +47,11 @@ import Data.Ratio ((%)) import Data.Text.Lazy (Text) import Numeric.Natural-import System.Console.Haskeline.MonadException -- FIXME+import System.Console.Haskeline.MonadException import System.Random (split) import System.Random.TF (TFGen, mkTFGen)-import qualified Data.Map.Strict as M+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict    as M  -- | ALGA environment state. Basically this amounts to collection of -- definitions and random number generator.@@ -187,7 +188,7 @@         f (Value      _) = mempty         f (Section    x) = cm x         f (Multi      x) = cm x-        f (CMulti     x) = x >>= (cm *** cm >>> uncurry (<>))+        f (CMulti     x) = NE.toList x >>= (cm *** cm >>> uncurry (<>))         f (Reference  x) = return x <> tDefs x defs         f (Range    _ _) = mempty         f (Product  x y) = f x <> f y

@@ -30,10 +30,12 @@ import Control.Arrow ((***)) import Control.Monad.State.Lazy import Data.List (tails)+import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (listToMaybe) import Data.Monoid ((<>)) import System.Random (next) import System.Random.TF (TFGen)+import qualified Data.List.NonEmpty as NE  -- | State record used for calculation\/evaluation of principles. @@ -67,7 +69,7 @@   where f (Val  x) = addHistory x >> return [x]         f (Sec  x) = resolve x         f (Mul  x) = choice x >>= maybe (return []) f-        f (CMul x) = listToMaybe <$> filterM (matchHistory . fst) x >>=+        f (CMul x) = listToMaybe <$> filterM (matchHistory . fst) (NE.toList x) >>=           maybe (f . toMul $ x) (f . Mul . snd)  -- | Run lazy state monad with 'CalcSt' state.@@ -106,9 +108,9 @@ -- | Convert internals of conditional multivalue into plain multivalue.  toMul-  :: [([Element NRatio], [Element NRatio])] -- ^ Pattern\/result pairs+  :: NonEmpty ([Element NRatio], [Element NRatio]) -- ^ Pattern\/result pairs   -> Element NRatio    -- ^ Internals of plain multivalue-toMul xs = Mul (xs >>= snd)+toMul xs = Mul (NE.toList xs >>= snd)  -- | A monadic wrapper around 'condMatch'. @@ -149,20 +151,20 @@ -- several elements after simplification.  simplifyElt :: Element NRatio -> Principle-simplifyElt x@(Val _)        = [x]-simplifyElt (Sec  [x])       = simplify [x]-simplifyElt (Mul  [x])       = simplify [x]-simplifyElt (CMul [(_, xs)]) = simplifyElt (Mul xs)-simplifyElt (Sec  xs)        = [Sec (simplifySec xs)]-simplifyElt (Mul  xs)        = [Mul (simplify xs)]-simplifyElt (CMul xs)        = [CMul ((simplify *** simplify) <$> xs)]+simplifyElt x@(Val _)  = [x]+simplifyElt (Sec  [x]) = simplify [x]+simplifyElt (Mul  [x]) = simplify [x]+simplifyElt (CMul ((_, xs):|[])) = simplifyElt (Mul xs)+simplifyElt (Sec  xs)  = [Sec (simplifySec xs)]+simplifyElt (Mul  xs)  = [Mul (simplify xs)]+simplifyElt (CMul xs)  = [CMul ((simplify *** simplify) <$> xs)]  -- | The meat of the algorithm that transforms 'SyntaxTree' into 'Principle'.  toPrin' :: HasEnv m   => SyntaxTree        -- ^ Syntax tree to transform   -> m Principle       -- ^ Resulting principle-toPrin' = liftM concat . mapM f+toPrin' = fmap concat . mapM f   where     fPair (c, x)     = (,) <$> toPrin' c <*> toPrin' x     f (Value      x) = return . Val <$> return x

@@ -18,24 +18,30 @@  module Alga.Language.SyntaxTree   ( SyntaxTree-  , Sel (..) )+  , Sel (..)+  , Statement (..) ) where  import Alga.Language.Element (NRatio)+import Alga.Representation.Base+import Data.Char (isLetter, isAlphaNum)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Ratio ((%))+import Test.QuickCheck  -- | Syntax tree in our case is just a collection of syntactic elements.  type SyntaxTree = [Sel] --- | Syntactic element corresponds to language features. Some of them have--- direct corresponding constructor in 'Alga.Language.Element.Element',--- others have to be simplified first.+-- | Syntactic element corresponds to language tokens. Some of them have+-- corresponding constructor in 'Alga.Language.Element.Element', others have+-- to be simplified first.  data Sel   = Value     NRatio   -- ^ Literal value   | Section   [Sel]    -- ^ Section   | Multi     [Sel]    -- ^ Multivalue-  | CMulti    [([Sel], [Sel])] -- ^ Conditional multivalue+  | CMulti    (NonEmpty ([Sel], [Sel])) -- ^ Conditional multivalue   | Reference String   -- ^ Reference (name of variable)   | Range     NRatio NRatio -- ^ Range of values   | Product   Sel Sel  -- ^ Product of principles@@ -45,4 +51,55 @@   | Loop      Sel Sel  -- ^ Loop   | Rotation  Sel Sel  -- ^ Rotation   | Reverse   Sel      -- ^ Reversed principle-    deriving (Eq, Show)+  deriving (Eq, Show)++instance Arbitrary Sel where+  arbitrary = sized arbitrarySel++arbitrarySel :: Int -> Gen Sel+arbitrarySel 0 =+  oneof [ Value     <$> nonNegative+        , Reference <$> identifier+        , Range     <$> nonNegative <*> nonNegative ]+  where nonNegative = (% 1) . getNonNegative <$> arbitrary+arbitrarySel n =+  oneof [ Section  <$> listSel+        , Multi    <$> listSel+        , CMulti   <$> listCnd+        , Product  <$> leafSel <*> leafSel+        , Division <$> leafSel <*> leafSel+        , Sum      <$> leafSel <*> leafSel+        , Diff     <$> leafSel <*> leafSel+        , Loop     <$> leafSel <*> leafSel+        , Rotation <$> leafSel <*> leafSel+        , Reverse  <$> leafSel ]+  where cnSel d = arbitrarySel (n `div` d)+        vcSel d = listOf (cnSel $ d * 20)+        leafSel = cnSel 10+        listSel = vcSel 20+        listCnd =+          let x = (,) <$> vcSel 25 <*> vcSel 25+          in (:|) <$> x <*> listOf x++-- | Statement can be either definition or exposition. Expositions are only+-- used in REPL.++data Statement+  = Definition String SyntaxTree+  | Exposition SyntaxTree+  deriving (Eq, Show)++instance Arbitrary Statement where+  arbitrary = oneof+    [ Definition <$> identifier <*> arbitrary+    , Exposition <$> arbitrary ]++----------------------------------------------------------------------------+-- Helpers++identifier :: Gen String+identifier = (:) <$> ch0 <*> chN+  where ch0 = u isLetter+        chN = listOf $ u (\x -> isAlphaNum x || x == autoDel)+        u f = frequency [ (1, return '_')+                        , (74, arbitrary `suchThat` f) ]

@@ -18,8 +18,7 @@ -- with this program. If not, see <http://www.gnu.org/licenses/>.  module Alga.Representation-  ( Statement (..)-  , probeAlga+  ( probeAlga   , parseAlga   , showStatement   , showSyntaxTree

@@ -18,13 +18,12 @@ -- with this program. If not, see <http://www.gnu.org/licenses/>.  module Alga.Representation.Parser-  ( Statement (..)-  , probeAlga+  ( probeAlga   , parseAlga ) where  import Alga.Language.Element (NRatio)-import Alga.Language.SyntaxTree (SyntaxTree, Sel (..))+import Alga.Language.SyntaxTree import Control.Applicative import Control.Monad (void) import Data.Ratio ((%))@@ -33,16 +32,9 @@ import Text.Megaparsec.Expr import Text.Megaparsec.Text.Lazy import qualified Alga.Representation.Base as B-import qualified Data.Text.Lazy as T-import qualified Text.Megaparsec.Lexer as L---- | Statement can be either definition or exposition. Expositions are only--- used in REPL.--data Statement-  = Definition String SyntaxTree-  | Exposition SyntaxTree-    deriving (Eq, Show)+import qualified Data.List.NonEmpty       as NE+import qualified Data.Text.Lazy           as T+import qualified Text.Megaparsec.Lexer    as L  -- | Test if given fragment of ALGA code is finished and self-contained. @@ -68,7 +60,7 @@     Right x -> if null x       then Left $ '\"' : file ++ "\":\ninvalid definition syntax"       else Right x-    Left  x -> Left . show $ x+    Left  x -> Left (parseErrorPretty x)   where parser = if T.pack B.defOp `T.isInfixOf` txt           then pSource           else return <$> pExposition@@ -122,7 +114,8 @@ pMulti = Multi <$> braces pPrinciple  pCMulti :: Parser Sel-pCMulti = CMulti <$> braces (many $ (,) <$> angles pPrinciple <*> pPrinciple)+pCMulti = CMulti . NE.fromList <$>+  braces (some $ (,) <$> angles pPrinciple <*> pPrinciple)  pExpression :: Parser Sel pExpression = makeExprParser (parens pExpression <|> pElement) optTable

@@ -26,15 +26,15 @@  import Alga.Language.Element import Alga.Language.SyntaxTree-import Alga.Representation.Parser (Statement (..)) import Control.Arrow ((***), (>>>)) import Data.List (intersperse) import Data.Monoid ((<>)) import Data.Ratio (numerator, denominator) import Data.Text.Lazy (Text)-import qualified Alga.Representation.Base as B-import qualified Data.Text.Lazy.Builder as T (Builder, fromString, toLazyText)+import qualified Alga.Representation.Base   as B+import qualified Data.Text.Lazy.Builder     as T (Builder, fromString, toLazyText) import qualified Data.Text.Lazy.Builder.Int as T (decimal)+import qualified Data.List.NonEmpty         as NE  -- | Render a statement. This handles definitions and expositions. @@ -87,7 +87,7 @@     f (Value       x) = pRational x     f (Section     x) = "[" <> cm f x <> "]"     f (Multi       x) = "{" <> cm f x <> "}"-    f (CMulti      x) = "{" <> cm (c *** cm f >>> uncurry (<>)) x <> "}"+    f (CMulti      x) = "{" <> cm (c *** cm f >>> uncurry (<>)) (NE.toList x) <> "}"     f (Reference   x) = T.fromString x     f (Range     x y) = pRational x <> T.fromString B.rangeOp <> pRational y     f (Product   x y) = f x <> pad B.productOp   <> p y

@@ -16,6 +16,8 @@ -- You should have received a copy of the GNU General Public License along -- with this program. If not, see <http://www.gnu.org/licenses/>. +{-# LANGUAGE TemplateHaskell #-}+ module Main (main) where  import Alga.Configuration@@ -23,6 +25,7 @@ import Alga.Translation (toBackend) import Control.Monad import Control.Monad.IO.Class+import Data.FileEmbed import Data.Text.Lazy (Text) import Data.Version (showVersion) import Formatting@@ -68,31 +71,12 @@ -- | Shortish copyright notice.  notice :: Text-notice =-  "ALGA Copyright © 2015–2016 Mark Karpov\n\n\-  \This program comes with ABSOLUTELY NO WARRANTY. This is free software,\n\-  \and you are welcome to redistribute it under certain conditions; see\n\-  \GNU General Public License for details.\n"+notice = $(embedStringFile "notice.txt")  -- | Longer copyright notice.  license :: Text-license =-  "ALGA — algorithmic automation for various DAWs.\n\-  \Copyright © 2015–2016 Mark Karpov\n\-  \\n\-  \ALGA is free software: you can redistribute it and/or modify it under the\n\-  \terms of the GNU General Public License as published by the Free Software\n\-  \Foundation, either version 3 of the License, or (at your option) any\n\-  \later version.\n\-  \\n\-  \ALGA is distributed in the hope that it will be useful, but WITHOUT ANY\n\-  \WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS\n\-  \FOR A PARTICULAR PURPOSE. See the GNU General Public License for more\n\-  \details.\n\-  \\n\-  \You should have received a copy of the GNU General Public License along\n\-  \with this program. If not, see <http://www.gnu.org/licenses/>.\n"+license = $(embedStringFile "license.txt")  -- | Read configuration file if present and run ALGA monad. 

@@ -1,5 +1,5 @@ ----- QuickCheck tests for ALGA.+-- Tests suite of ALGA. -- -- Copyright © 2015–2016 Mark Karpov --@@ -16,87 +16,23 @@ -- You should have received a copy of the GNU General Public License along -- with this program. If not, see <http://www.gnu.org/licenses/>. -{--  TODO:-  - parser for configuration files;-  - translation from syntax tree to internal language;-  - process of translation Principle -> [Double];-  - patching of XML files.--}- {-# OPTIONS -fno-warn-orphans #-}  module Main (main) where -import Control.Arrow ((&&&), (>>>))-import Data.Char (isLetter, isAlphaNum)-import Data.Ratio ((%))--import Test.Framework (defaultMain, testGroup, Test)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck--import Alga.Language (Sel (..)) import Alga.Representation-  ( Statement (..)-  , probeAlga-  , parseAlga-  , showStatement-  , autoDel )+import Test.Hspec+import Test.QuickCheck  main :: IO ()-main = defaultMain tests--tests :: [Test]-tests =-  [ testGroup "Printer and Parser"-    [ testProperty "Valid ALGA Probe"               prop_valid_probe-    , testProperty "Printer and Parser Consistency" prop_pp_consistency ] ]--prop_valid_probe :: Statement -> Bool-prop_valid_probe = probeAlga . showStatement--prop_pp_consistency :: Statement -> Bool-prop_pp_consistency = id &&& (parseAlga "" . showStatement) >>> check-  where check (x, Right [y]) = x == y-        check _              = False--instance Arbitrary Statement where-  arbitrary =-      oneof [ Definition <$> identifier <*> arbitrary-            , Exposition <$> arbitrary ]--instance Arbitrary Sel where-  arbitrary = sized arbitrarySel--arbitrarySel :: Int -> Gen Sel-arbitrarySel 0 =-  oneof [ Value     <$> nonNegative-        , Reference <$> identifier-        , Range     <$> nonNegative <*> nonNegative ]-  where nonNegative = (% 1) . getNonNegative <$> arbitrary-arbitrarySel n =-  oneof [ Section  <$> listSel-        , Multi    <$> listSel-        , CMulti   <$> listCnd-        , Product  <$> leafSel <*> leafSel-        , Division <$> leafSel <*> leafSel-        , Sum      <$> leafSel <*> leafSel-        , Diff     <$> leafSel <*> leafSel-        , Loop     <$> leafSel <*> leafSel-        , Rotation <$> leafSel <*> leafSel-        , Reverse  <$> leafSel ]-  where cnSel d = arbitrarySel (n `div` d)-        vcSel d = (getNonNegative <$> arbitrary)-                  >>= \s -> vectorOf s (cnSel $ d * s)-        leafSel = cnSel 2-        listSel = vcSel 1-        listCnd = (getPositive <$> arbitrary)-                  >>= \s -> vectorOf s $ (,) <$> vcSel s <*> vcSel s+main = hspec spec -identifier :: Gen String-identifier = (:) <$> ch0 <*> chN-  where ch0 = u isLetter-        chN = listOf $ u (\x -> isAlphaNum x || x == autoDel)-        u f = frequency [ (1, return '_')-                        , (74, arbitrary `suchThat` f) ]+spec :: Spec+spec = do+  describe "probeAlga" $+    it "returns True for every correct Statement" $+      property (probeAlga . showStatement)+  describe "parser and printer" $+    it "printed representation of statement can be parsed back" $+      property $ \stmt ->+        parseAlga "" (showStatement stmt) `shouldBe` Right [stmt]