Compare commits
No commits in common. "98f732dbd27c95829217bac4bebbfcb20319d77a" and "4806e0644406a9c741518099986dfa35eea4bed2" have entirely different histories.
98f732dbd2
...
4806e06444
@ -7,9 +7,6 @@ import Control.Monad.Buuka
|
||||
|
||||
import Data.Environment
|
||||
|
||||
import UnliftIO.Directory
|
||||
(XdgDirectory(XdgData), getXdgDirectory)
|
||||
|
||||
import qualified Operations
|
||||
|
||||
commands :: Parser (BuukaM ())
|
||||
@ -22,5 +19,5 @@ commands = subparser
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
env <- Environment <$> getXdgDirectory XdgData "buuka"
|
||||
let env = Environment "."
|
||||
execParser (info (commands <**> helper) fullDesc) >>= runBuukaM env
|
||||
|
@ -61,13 +61,11 @@ executable buuka
|
||||
-- other-extensions:
|
||||
build-depends: buuka
|
||||
, optparse-applicative
|
||||
, unliftio
|
||||
hs-source-dirs: app
|
||||
|
||||
test-suite buuka-test
|
||||
import: common-stanza
|
||||
other-modules: Test.Database.Migrations
|
||||
Test.Data.Buuka
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: MyLibTest.hs
|
||||
|
@ -13,7 +13,7 @@ mkDerivation {
|
||||
aeson base bytestring conduit conduit-extra containers exceptions
|
||||
filepath mtl transformers unliftio yaml
|
||||
];
|
||||
executableHaskellDepends = [ base optparse-applicative unliftio ];
|
||||
executableHaskellDepends = [ base optparse-applicative ];
|
||||
testHaskellDepends = [
|
||||
aeson base hedgehog hedgehog-corpus tasty tasty-hedgehog text
|
||||
];
|
||||
|
@ -8,7 +8,6 @@ in
|
||||
mkShell {
|
||||
name = "shell-buuka";
|
||||
buildInputs = [
|
||||
hlint
|
||||
ghcid
|
||||
stylish-haskell
|
||||
cabal2nix
|
||||
|
@ -5,7 +5,6 @@ module Data.Buuka
|
||||
, BuukaU(..)
|
||||
, BuukaEntry(..)
|
||||
, URL(..)
|
||||
, Buuka
|
||||
|
||||
, insert
|
||||
)
|
||||
@ -39,7 +38,6 @@ instance SafeJSON BuukaEntry where
|
||||
type Version BuukaEntry = 0
|
||||
|
||||
newtype Buuka = Buuka ( Map URL BuukaEntry )
|
||||
deriving stock (Show, Eq)
|
||||
deriving newtype (Semigroup, Monoid, FromJSON, ToJSON)
|
||||
|
||||
insert :: BuukaEntry -> Buuka -> Buuka
|
||||
|
@ -2,13 +2,11 @@ module Main (main) where
|
||||
|
||||
import Test.Tasty
|
||||
|
||||
import qualified Test.Data.Buuka as Data.Buuka
|
||||
import qualified Test.Database.Migrations as Database.Migrations
|
||||
|
||||
tests :: TestTree
|
||||
tests = testGroup "buuka"
|
||||
[ Database.Migrations.tests
|
||||
, Data.Buuka.tests
|
||||
]
|
||||
|
||||
main :: IO ()
|
||||
|
@ -1,49 +0,0 @@
|
||||
module Test.Data.Buuka where
|
||||
|
||||
import Hedgehog
|
||||
import qualified Hedgehog.Gen as Gen
|
||||
import qualified Hedgehog.Range as Range
|
||||
import Test.Tasty
|
||||
import Test.Tasty.Hedgehog
|
||||
|
||||
import qualified Data.Aeson as A
|
||||
|
||||
import Data.List
|
||||
(intercalate)
|
||||
import qualified Data.Foldable as F
|
||||
|
||||
import Data.Buuka
|
||||
|
||||
genUrl :: Gen URL
|
||||
genUrl = URL . concat <$> sequence go
|
||||
where
|
||||
go = [ Gen.element protocols, Gen.element domains, Gen.element tlds, pure "/", genPath ]
|
||||
protocols = ["http://", "https://"]
|
||||
domains = ["example", "foo", "bar"]
|
||||
tlds = ["com", "fi", "org", "net", "info"]
|
||||
genPath = intercalate "/" <$> Gen.list (Range.linear 0 10) (Gen.element paths)
|
||||
paths = ["foo", "bar", "asd", "xyzzy"]
|
||||
|
||||
genBuukaEntry :: Gen BuukaEntry
|
||||
genBuukaEntry = BuukaEntry <$> genUrl <*> genTitle
|
||||
where
|
||||
genTitle = Gen.maybe (Gen.string (Range.linear 0 10) Gen.unicode)
|
||||
|
||||
genBuuka :: Gen Buuka
|
||||
genBuuka = F.foldl' (flip insert) mempty <$> Gen.list (Range.linear 0 10) genBuukaEntry
|
||||
|
||||
prop_buukaentry_encode_decode :: Property
|
||||
prop_buukaentry_encode_decode = property $ do
|
||||
x <- forAll genBuukaEntry
|
||||
tripping x A.encode A.eitherDecode
|
||||
|
||||
prop_buuka_encode_decode :: Property
|
||||
prop_buuka_encode_decode = property $ do
|
||||
x <- forAll genBuuka
|
||||
tripping x A.encode A.eitherDecode
|
||||
|
||||
tests :: TestTree
|
||||
tests = testGroup "Data.Buuka"
|
||||
[ testProperty "Entries can be encoded and decoded" prop_buukaentry_encode_decode
|
||||
, testProperty "Entire set can be encoded and decoded" prop_buuka_encode_decode
|
||||
]
|
Loading…
Reference in New Issue
Block a user