language-ninja-0.1.0: tests/Tests/Orphans.hs
-- -*- 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 -Wno-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
--------------------------------------------------------------------------------