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 Data.Environment
|
||||||
|
|
||||||
import UnliftIO.Directory
|
|
||||||
(XdgDirectory(XdgData), getXdgDirectory)
|
|
||||||
|
|
||||||
import qualified Operations
|
import qualified Operations
|
||||||
|
|
||||||
commands :: Parser (BuukaM ())
|
commands :: Parser (BuukaM ())
|
||||||
@ -22,5 +19,5 @@ commands = subparser
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
env <- Environment <$> getXdgDirectory XdgData "buuka"
|
let env = Environment "."
|
||||||
execParser (info (commands <**> helper) fullDesc) >>= runBuukaM env
|
execParser (info (commands <**> helper) fullDesc) >>= runBuukaM env
|
||||||
|
@ -61,13 +61,11 @@ executable buuka
|
|||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
build-depends: buuka
|
build-depends: buuka
|
||||||
, optparse-applicative
|
, optparse-applicative
|
||||||
, unliftio
|
|
||||||
hs-source-dirs: app
|
hs-source-dirs: app
|
||||||
|
|
||||||
test-suite buuka-test
|
test-suite buuka-test
|
||||||
import: common-stanza
|
import: common-stanza
|
||||||
other-modules: Test.Database.Migrations
|
other-modules: Test.Database.Migrations
|
||||||
Test.Data.Buuka
|
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
hs-source-dirs: test
|
hs-source-dirs: test
|
||||||
main-is: MyLibTest.hs
|
main-is: MyLibTest.hs
|
||||||
|
@ -13,7 +13,7 @@ mkDerivation {
|
|||||||
aeson base bytestring conduit conduit-extra containers exceptions
|
aeson base bytestring conduit conduit-extra containers exceptions
|
||||||
filepath mtl transformers unliftio yaml
|
filepath mtl transformers unliftio yaml
|
||||||
];
|
];
|
||||||
executableHaskellDepends = [ base optparse-applicative unliftio ];
|
executableHaskellDepends = [ base optparse-applicative ];
|
||||||
testHaskellDepends = [
|
testHaskellDepends = [
|
||||||
aeson base hedgehog hedgehog-corpus tasty tasty-hedgehog text
|
aeson base hedgehog hedgehog-corpus tasty tasty-hedgehog text
|
||||||
];
|
];
|
||||||
|
@ -8,7 +8,6 @@ in
|
|||||||
mkShell {
|
mkShell {
|
||||||
name = "shell-buuka";
|
name = "shell-buuka";
|
||||||
buildInputs = [
|
buildInputs = [
|
||||||
hlint
|
|
||||||
ghcid
|
ghcid
|
||||||
stylish-haskell
|
stylish-haskell
|
||||||
cabal2nix
|
cabal2nix
|
||||||
|
@ -5,7 +5,6 @@ module Data.Buuka
|
|||||||
, BuukaU(..)
|
, BuukaU(..)
|
||||||
, BuukaEntry(..)
|
, BuukaEntry(..)
|
||||||
, URL(..)
|
, URL(..)
|
||||||
, Buuka
|
|
||||||
|
|
||||||
, insert
|
, insert
|
||||||
)
|
)
|
||||||
@ -39,7 +38,6 @@ instance SafeJSON BuukaEntry where
|
|||||||
type Version BuukaEntry = 0
|
type Version BuukaEntry = 0
|
||||||
|
|
||||||
newtype Buuka = Buuka ( Map URL BuukaEntry )
|
newtype Buuka = Buuka ( Map URL BuukaEntry )
|
||||||
deriving stock (Show, Eq)
|
|
||||||
deriving newtype (Semigroup, Monoid, FromJSON, ToJSON)
|
deriving newtype (Semigroup, Monoid, FromJSON, ToJSON)
|
||||||
|
|
||||||
insert :: BuukaEntry -> Buuka -> Buuka
|
insert :: BuukaEntry -> Buuka -> Buuka
|
||||||
|
@ -2,13 +2,11 @@ module Main (main) where
|
|||||||
|
|
||||||
import Test.Tasty
|
import Test.Tasty
|
||||||
|
|
||||||
import qualified Test.Data.Buuka as Data.Buuka
|
|
||||||
import qualified Test.Database.Migrations as Database.Migrations
|
import qualified Test.Database.Migrations as Database.Migrations
|
||||||
|
|
||||||
tests :: TestTree
|
tests :: TestTree
|
||||||
tests = testGroup "buuka"
|
tests = testGroup "buuka"
|
||||||
[ Database.Migrations.tests
|
[ Database.Migrations.tests
|
||||||
, Data.Buuka.tests
|
|
||||||
]
|
]
|
||||||
|
|
||||||
main :: IO ()
|
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