Sulkta-OSS/agora
3
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

better queries

Browse source
This commit is contained in:
Seungheon Oh 2022-05-25 14:35:57 -05:00
parent 6068ecded5
commit 34caeab332
1 changed files with 8 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

24
agora-spec/Spec/Specification.hs
View file

@ -47,7 +47,6 @@ module Spec.Specification (
toTestTree, toTestTree,
) where ) where
import Data.Maybe (catMaybes)
import Plutarch.Api.V1 (PMintingPolicy, PValidator) import Plutarch.Api.V1 (PMintingPolicy, PValidator)
import Plutarch.Builtin (pforgetData) import Plutarch.Builtin (pforgetData)
import Plutarch.Evaluate (evalScript) import Plutarch.Evaluate (evalScript)
@ -98,25 +97,18 @@ group name st
| otherwise = Group name st | otherwise = Group name st
-- | Query specific @Specification@ from a tree. -- | Query specific @Specification@ from a tree.
getSpecification :: String -> SpecificationTree -> Maybe Specification getSpecification :: String -> SpecificationTree -> [Specification]
getSpecification name (Terminal spec@(Specification sn _ _)) getSpecification name (Terminal spec@(Specification sn _ _))
| name == sn = Just spec | name == sn = [spec]
| otherwise = Nothing | otherwise = []
getSpecification name (Group _ st) getSpecification name (Group _ st) = mconcat $ (getSpecification name) <$> st
| length specs == 1 = Just $ head specs
| otherwise = Nothing
where
specs = catMaybes $ getSpecification name <$> st
-- | Query specific @SpecificationTree@ from a tree. -- | Query specific @SpecificationTree@ from a tree.
getSpecificationTree :: String -> SpecificationTree -> Maybe SpecificationTree getSpecificationTree :: String -> SpecificationTree -> [SpecificationTree]
getSpecificationTree name specTree@(Group gn st) getSpecificationTree name specTree@(Group gn st)
| gn == name = Just specTree | gn == name = [specTree]
| length trees == 1 = Just $ head trees | otherwise = mconcat $ (getSpecificationTree name) <$> st
| otherwise = Nothing getSpecificationTree _ _ = []
where
trees = catMaybes $ getSpecificationTree name <$> st
getSpecificationTree _ _ = Nothing
-- | Convert @SpecificationTree@ into @TestTree@ to be used as a unit test. -- | Convert @SpecificationTree@ into @TestTree@ to be used as a unit test.
toTestTree :: SpecificationTree -> TestTree toTestTree :: SpecificationTree -> TestTree