diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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
diff --git a/alga.cabal b/alga.cabal
--- a/alga.cabal
+++ b/alga.cabal
@@ -17,7 +17,8 @@
-- with this program. If not, see .
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
diff --git a/license.txt b/license.txt
new file mode 100644
--- /dev/null
+++ b/license.txt
@@ -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 .
diff --git a/notice.txt b/notice.txt
new file mode 100644
--- /dev/null
+++ b/notice.txt
@@ -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.
diff --git a/src/Alga/Interaction.hs b/src/Alga/Interaction.hs
--- a/src/Alga/Interaction.hs
+++ b/src/Alga/Interaction.hs
@@ -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
diff --git a/src/Alga/Interaction/Commands.hs b/src/Alga/Interaction/Commands.hs
--- a/src/Alga/Interaction/Commands.hs
+++ b/src/Alga/Interaction/Commands.hs
@@ -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.
diff --git a/src/Alga/Language.hs b/src/Alga/Language.hs
--- a/src/Alga/Language.hs
+++ b/src/Alga/Language.hs
@@ -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)
diff --git a/src/Alga/Language/Element.hs b/src/Alga/Language/Element.hs
--- a/src/Alga/Language/Element.hs
+++ b/src/Alga/Language/Element.hs
@@ -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
diff --git a/src/Alga/Language/Environment.hs b/src/Alga/Language/Environment.hs
--- a/src/Alga/Language/Environment.hs
+++ b/src/Alga/Language/Environment.hs
@@ -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
diff --git a/src/Alga/Language/Eval.hs b/src/Alga/Language/Eval.hs
--- a/src/Alga/Language/Eval.hs
+++ b/src/Alga/Language/Eval.hs
@@ -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
diff --git a/src/Alga/Language/SyntaxTree.hs b/src/Alga/Language/SyntaxTree.hs
--- a/src/Alga/Language/SyntaxTree.hs
+++ b/src/Alga/Language/SyntaxTree.hs
@@ -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) ]
diff --git a/src/Alga/Representation.hs b/src/Alga/Representation.hs
--- a/src/Alga/Representation.hs
+++ b/src/Alga/Representation.hs
@@ -18,8 +18,7 @@
-- with this program. If not, see .
module Alga.Representation
- ( Statement (..)
- , probeAlga
+ ( probeAlga
, parseAlga
, showStatement
, showSyntaxTree
diff --git a/src/Alga/Representation/Parser.hs b/src/Alga/Representation/Parser.hs
--- a/src/Alga/Representation/Parser.hs
+++ b/src/Alga/Representation/Parser.hs
@@ -18,13 +18,12 @@
-- with this program. If not, see .
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
diff --git a/src/Alga/Representation/Show.hs b/src/Alga/Representation/Show.hs
--- a/src/Alga/Representation/Show.hs
+++ b/src/Alga/Representation/Show.hs
@@ -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
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -16,6 +16,8 @@
-- You should have received a copy of the GNU General Public License along
-- with this program. If not, see .
+{-# 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 .\n"
+license = $(embedStringFile "license.txt")
-- | Read configuration file if present and run ALGA monad.
diff --git a/tests/Main.hs b/tests/Main.hs
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -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 .
-{-
- 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]