-- -*- coding: utf-8; mode: haskell; -*- -- File: tests/Tests.hs -- -- License: -- Copyright 2017 Awake Security -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License. -- You may obtain a copy of the License at -- -- http://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -- See the License for the specific language governing permissions and -- limitations under the License. {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- | -- Module : Main -- Copyright : Copyright 2017 Awake Security -- License : Apache-2.0 -- Maintainer : opensource@awakesecurity.com -- Stability : experimental -- -- This module contains orphan instances used in testing. module Tests.Orphans ( -- No exports other than instances. ) where import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS import qualified Data.List.NonEmpty as NE import qualified Data.Text as Text import qualified Data.Versions as Ver import qualified Filesystem.Path.CurrentOS as FP import Test.SmallCheck.Series ((<~>), (>>-), (\/)) import qualified Test.SmallCheck.Series as SC import Flow ((.>), (|>)) -------------------------------------------------------------------------------- instance ( Monad m, SC.Serial m k, SC.Serial m v, Hashable k ) => SC.Serial m (HM.HashMap k v) where series = pure HM.empty \/ (HM.singleton <$> SC.series <~> SC.series) -- \/ (HM.union <$> SC.series <~> SC.series) instance ( Monad m, SC.CoSerial m k, SC.CoSerial m v ) => SC.CoSerial m (HM.HashMap k v) where coseries = SC.coseries .> fmap (\f -> HM.toList .> f) -------------------------------------------------------------------------------- instance ( Monad m, SC.Serial m a, Hashable a ) => SC.Serial m (HS.HashSet a) where series = pure HS.empty \/ (HS.singleton <$> SC.series) -- \/ (HS.union <$> SC.series <~> SC.series) instance (Monad m, SC.CoSerial m a) => SC.CoSerial m (HS.HashSet a) where coseries = SC.coseries .> fmap (\f -> HS.toList .> f) -------------------------------------------------------------------------------- instance (Monad m, SC.Serial m a) => SC.Serial m (NE.NonEmpty a) where series = SC.series |> fmap (pure .> NE.fromList) -- series = SC.series |> fmap (SC.getNonEmpty .> NE.fromList) instance (Monad m, SC.CoSerial m a) => SC.CoSerial m (NE.NonEmpty a) where coseries = SC.coseries .> fmap (\f -> NE.toList .> f) -------------------------------------------------------------------------------- instance (Monad m) => SC.Serial m Text.Text where series = foldr1 (\/) (map pure testText) instance (Monad m) => SC.CoSerial m Text.Text where coseries rs = SC.alts0 rs >>- \y -> SC.alts2 rs >>- \f -> do pure (Text.uncons .> (\case Nothing -> y (Just (b, bs)) -> f (Text.singleton b) bs)) -------------------------------------------------------------------------------- instance (Monad m) => SC.Serial m FP.FilePath where series = foldr1 (\/) (map pure testFP) instance (Monad m) => SC.CoSerial m FP.FilePath where coseries = SC.coseries .> (fmap (\f -> FP.encodeString .> Text.pack .> f)) -------------------------------------------------------------------------------- instance (Monad m) => SC.Serial m Ver.Version where series = foldr1 (\/) (map pure testVersions) instance (Monad m, SC.CoSerial m Ver.VUnit) => SC.CoSerial m Ver.Version where coseries = SC.coseries .> fmap (\f -> toTuple .> f) where toTuple (Ver.Version {..}) = (_vEpoch, _vChunks, _vRel) instance (Monad m) => SC.CoSerial m Ver.VUnit where coseries = SC.coseries .> fmap (\f -> \case (Ver.Digits i) -> f (Right i) (Ver.Str s) -> f (Left s)) -------------------------------------------------------------------------------- testText :: [Text.Text] testText = ["", "foo", "42", " "] testFP :: [FP.FilePath] testFP = ["/foo/bar", ".", "..", "foo", "foo/", "/foo/", "/foo//bar"] testVersions :: [Ver.Version] testVersions = [ "0.1.0" , "0.2" , "0.2.0" , "0.2.0.0" , "0.25-2" , "0.9.9.9" , "1" , "1.0" , "1.0.0" , "1.0.0.0" , "1.0.0.1" , "1.0.0-alpha" , "1.0.0-alpha.1" , "1.0.0-alpha.beta" , "1.0.0-beta" , "1.0.0-beta.11" , "1.0.0-beta.2" , "1.0.0-rc.1" , "1:0.10.16-3" , "1.0rc0" , "1.0rc1" , "1.1" , "1:1.0" , "1:1.1" , "1:1.2.3-1" , "1.1rc1" , "1.2" , "1.2.2r1-1" , "1.2.3" , "1.2.3-1" , "1.2.3-alpha" , "1.2.3-alpha.2" , "1.2.3r1" , "1.2.3r1-1" , "1.2.4" , "1.2.4r1-1" , "1.2-5" , "1.58.0-3" , "2" , "20150826-1" , "21-2" , "2.3.4" , "3.4.5" , "44.0.2403.157-1" , "7.1p1-1" , "8.u51-1" ] |> map (Ver.version .> fromRight) where fromRight :: (Show a, Show b) => Either a b -> b fromRight (Left a) = error ("fromRight: " ++ show a) fromRight (Right b) = b --------------------------------------------------------------------------------