diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,15 +1,18 @@ -# 0.3 -* Added `showbArgPrec` (and corresponding `Show` and `Show1` instances) to `Text.Show.Text.Data.Semigroup` -* Added `Show1` instances for data types in `Text.Show.Text.Data.List.NonEmpty` and `Text.Show.Text.Data.Semigroup` -* Added `showbDoc` (and corresponding `Show` instance) to `Text.Show.Text.Language.Haskell.TH` -* Renamed `showbDoc` in `Text.Show.Text.Text.PrettyPrint` to `renderB` - -# 0.2 -* Exposed `showbKindPrec` and `showbPredPrec` with later versions of Template Haskell -* Added `renderStyleB` to `Text.Show.Text.Text.PrettyPrint` (for `time-1.5` and later) -* Added `showbTimeLocalePrec` to `Text.Show.Text.Data.Time` -* Added instances for the `binary`, `haskeline`, `hoopl`, `terminfo`, and `utf8-string` libraries -* Removed `transformers-four` flag - -# 0.1 +### 0.3.0.1 +* Fixed tests on Windows + +# 0.3 +* Added `showbArgPrec` (and corresponding `Show` and `Show1` instances) to `Text.Show.Text.Data.Semigroup` +* Added `Show1` instances for data types in `Text.Show.Text.Data.List.NonEmpty` and `Text.Show.Text.Data.Semigroup` +* Added `showbDoc` (and corresponding `Show` instance) to `Text.Show.Text.Language.Haskell.TH` +* Renamed `showbDoc` in `Text.Show.Text.Text.PrettyPrint` to `renderB` + +# 0.2 +* Exposed `showbKindPrec` and `showbPredPrec` with later versions of Template Haskell +* Added `renderStyleB` to `Text.Show.Text.Text.PrettyPrint` (for `time-1.5` and later) +* Added `showbTimeLocalePrec` to `Text.Show.Text.Data.Time` +* Added instances for the `binary`, `haskeline`, `hoopl`, `terminfo`, and `utf8-string` libraries +* Removed `transformers-four` flag + +# 0.1 * Initial commit diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,30 @@ -Copyright (c) 2014, Ryan Scott - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Ryan Scott nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright (c) 2014, Ryan Scott + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ryan Scott nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,28 +1,28 @@ -# `text-show-instances` [![Hackage version](https://img.shields.io/hackage/v/text-show-instances.svg?style=flat)](http://hackage.haskell.org/package/text-show-instances) [![Build Status](https://img.shields.io/travis/RyanGlScott/text-show-instances.svg?style=flat)](https://travis-ci.org/RyanGlScott/text-show-instances) - -`text-show-instances` is a supplemental library to [`text-show`](https://github.com/RyanGlScott/text-show) that provides additional `Show` instances for data types in common Haskell libraries and GHC dependencies that are not encompassed by `text-show`. Currently, `text-show-instances` covers these libraries: - -* [`binary`](http://hackage.haskell.org/package/binary) -* [`containers`](http://hackage.haskell.org/package/containers) -* [`directory`](http://hackage.haskell.org/package/directory) -* [`haskeline`](http://hackage.haskell.org/package/haskeline) -* [`hoopl`](http://hackage.haskell.org/package/hoopl) -* [`hpc`](http://hackage.haskell.org/package/hpc) -* [`old-locale`](http://hackage.haskell.org/package/old-locale) -* [`old-time`](http://hackage.haskell.org/package/old-time) -* [`pretty`](http://hackage.haskell.org/package/pretty) -* [`random`](http://hackage.haskell.org/package/random) -* [`semigroups`](http://hackage.haskell.org/package/semigroups) -* [`tagged`](http://hackage.haskell.org/package/tagged) -* [`template-haskell`](http://hackage.haskell.org/package/template-haskell) -* [`terminfo`](http://hackage.haskell.org/package/terminfo) -* [`time`](http://hackage.haskell.org/package/time) -* [`transformers`](http://hackage.haskell.org/package/transformers) -* [`unix`](http://hackage.haskell.org/package/unix) -* [`unordered-containers`](http://hackage.haskell.org/package/unordered-containers) -* [`utf8-string`](http://hackage.haskell.org/package/utf8-string) -* [`vector`](http://hackage.haskell.org/package/vector) -* [`Win32`](http://hackage.haskell.org/package/Win32) -* [`xhtml`](http://hackage.haskell.org/package/xhtml) - +# `text-show-instances` [![Hackage version](https://img.shields.io/hackage/v/text-show-instances.svg?style=flat)](http://hackage.haskell.org/package/text-show-instances) [![Build Status](https://img.shields.io/travis/RyanGlScott/text-show-instances.svg?style=flat)](https://travis-ci.org/RyanGlScott/text-show-instances) + +`text-show-instances` is a supplemental library to [`text-show`](https://github.com/RyanGlScott/text-show) that provides additional `Show` instances for data types in common Haskell libraries and GHC dependencies that are not encompassed by `text-show`. Currently, `text-show-instances` covers these libraries: + +* [`binary`](http://hackage.haskell.org/package/binary) +* [`containers`](http://hackage.haskell.org/package/containers) +* [`directory`](http://hackage.haskell.org/package/directory) +* [`haskeline`](http://hackage.haskell.org/package/haskeline) +* [`hoopl`](http://hackage.haskell.org/package/hoopl) +* [`hpc`](http://hackage.haskell.org/package/hpc) +* [`old-locale`](http://hackage.haskell.org/package/old-locale) +* [`old-time`](http://hackage.haskell.org/package/old-time) +* [`pretty`](http://hackage.haskell.org/package/pretty) +* [`random`](http://hackage.haskell.org/package/random) +* [`semigroups`](http://hackage.haskell.org/package/semigroups) +* [`tagged`](http://hackage.haskell.org/package/tagged) +* [`template-haskell`](http://hackage.haskell.org/package/template-haskell) +* [`terminfo`](http://hackage.haskell.org/package/terminfo) +* [`time`](http://hackage.haskell.org/package/time) +* [`transformers`](http://hackage.haskell.org/package/transformers) +* [`unix`](http://hackage.haskell.org/package/unix) +* [`unordered-containers`](http://hackage.haskell.org/package/unordered-containers) +* [`utf8-string`](http://hackage.haskell.org/package/utf8-string) +* [`vector`](http://hackage.haskell.org/package/vector) +* [`Win32`](http://hackage.haskell.org/package/Win32) +* [`xhtml`](http://hackage.haskell.org/package/xhtml) + One can use these instances by importing `Text.Show.Text.Instances`. Alternatively, there are monomorphic versions of the `showb` function available in the other submodules of `Text.Show.Text`. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/include/inline.h b/include/inline.h --- a/include/inline.h +++ b/include/inline.h @@ -1,13 +1,13 @@ -#ifndef INLINE_H -#define INLINE_H - -#define OPEN_PRAGMA {-# -#define CLOSE_PRAGMA #-} - -#if __GLASGOW_HASKELL__ >= 702 -#define INLINE_INST_FUN(F) OPEN_PRAGMA INLINE F CLOSE_PRAGMA -#else -#define INLINE_INST_FUN(F) -#endif - -#endif +#ifndef INLINE_H +#define INLINE_H + +#define OPEN_PRAGMA {-# +#define CLOSE_PRAGMA #-} + +#if __GLASGOW_HASKELL__ >= 702 +#define INLINE_INST_FUN(F) OPEN_PRAGMA INLINE F CLOSE_PRAGMA +#else +#define INLINE_INST_FUN(F) +#endif + +#endif diff --git a/src/Text/Show/Text/Compiler.hs b/src/Text/Show/Text/Compiler.hs --- a/src/Text/Show/Text/Compiler.hs +++ b/src/Text/Show/Text/Compiler.hs @@ -1,13 +1,13 @@ -{-| -Module: Text.Show.Text.Compiler -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Imports 'Show' instances for @Compiler@ modules. --} -module Text.Show.Text.Compiler () where - +{-| +Module: Text.Show.Text.Compiler +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Imports 'Show' instances for @Compiler@ modules. +-} +module Text.Show.Text.Compiler () where + import Text.Show.Text.Compiler.Hoopl () diff --git a/src/Text/Show/Text/Compiler/Hoopl.hs b/src/Text/Show/Text/Compiler/Hoopl.hs --- a/src/Text/Show/Text/Compiler/Hoopl.hs +++ b/src/Text/Show/Text/Compiler/Hoopl.hs @@ -1,197 +1,197 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Compiler.Hoopl -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @hoopl@ library. - -/Since: 0.2/ --} -module Text.Show.Text.Compiler.Hoopl ( - showbLabel - , showbLabelMapPrec - , showbLabelSetPrec - , showbPointed - , showbUnique - , showbUniqueMapPrec - , showbUniqueSetPrec - , showbDominatorNode - , showbDominatorTree - , showbDPath - ) where - -import Compiler.Hoopl (Label, LabelMap, LabelSet, Pointed(..), - Unique, UniqueMap, UniqueSet) -#if MIN_VERSION_hoopl(3,9,0) -import Compiler.Hoopl.Internals (lblToUnique) -#else -import Compiler.Hoopl.GHC (lblToUnique, uniqueToInt) -#endif -import Compiler.Hoopl.Passes.Dominator (DominatorNode(..), DominatorTree(..), DPath(..)) - -#if !(MIN_VERSION_base(4,8,0)) -import Data.Monoid (mconcat) -#endif - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showb, showbPrec), Show1(showbPrec1), Builder) -import Text.Show.Text.Data.Containers () -import Text.Show.Text.Data.Integral (showbIntPrec) -import Text.Show.Text.TH (deriveShowPragmas, defaultInlineShowbPrec) -import Text.Show.Text.Utils ((<>), s) - -#include "inline.h" - --- | Convert a 'Label' to a 'Builder'. --- --- /Since: 0.2/ -showbLabel :: Label -> Builder -showbLabel l = s 'L' <> showbUnique (lblToUnique l) -{-# INLINE showbLabel #-} - --- | Convert a 'LabelMap' to a 'Builder' with the given precedence. --- --- /Since: 0.2/ -showbLabelMapPrec :: Show v => Int -> LabelMap v -> Builder -showbLabelMapPrec = showbPrec -{-# INLINE showbLabelMapPrec #-} - --- | Convert a 'LabelSet' to a 'Builder' with the given precedence. --- --- /Since: 0.2/ -showbLabelSetPrec :: Int -> LabelSet -> Builder -showbLabelSetPrec = showbPrec -{-# INLINE showbLabelSetPrec #-} - --- | Convert a 'Pointed' value to a 'Builder'. --- --- /Since: 0.2/ -showbPointed :: Show a => Pointed t b a -> Builder -showbPointed Bot = "_|_" -showbPointed Top = s 'T' -showbPointed (PElem a) = showb a -{-# INLINE showbPointed #-} - --- | Convert a 'Unique' value to a 'Builder'. --- --- /Since: 0.2/ -showbUnique :: Unique -> Builder -#if MIN_VERSION_hoopl(3,9,0) -showbUnique = showbIntPrec 0 -#else -showbUnique = showbIntPrec 0 . uniqueToInt -#endif -{-# INLINE showbUnique #-} - --- | Convert a 'UniqueMap' to a 'Builder' with the given precedence. --- --- /Since: 0.2/ -showbUniqueMapPrec :: Show v => Int -> UniqueMap v -> Builder -showbUniqueMapPrec = showbPrec -{-# INLINE showbUniqueMapPrec #-} - --- | Convert a 'UniqueSet' to a 'Builder' with the given precedence. --- --- /Since: 0.2/ -showbUniqueSetPrec :: Int -> UniqueSet -> Builder -showbUniqueSetPrec = showbPrec -{-# INLINE showbUniqueSetPrec #-} - --- | Convert a 'DominatorNode' to a 'Builder'. --- --- /Since: 0.2/ -showbDominatorNode :: DominatorNode -> Builder -showbDominatorNode Entry = "entryNode" -showbDominatorNode (Labelled l) = showbLabel l -{-# INLINE showbDominatorNode #-} - --- | Convert a 'DominatorTree' to a 'Builder'. --- --- /Since: 0.2/ -showbDominatorTree :: DominatorTree -> Builder -showbDominatorTree t = mconcat $ "digraph {\n" : dot t ["}\n"] - where - dot :: DominatorTree -> [Builder] -> [Builder] - dot (Dominates root trees) = - (dotnode root :) . outedges trees . flip (foldl subtree) trees - where - outedges :: [DominatorTree] -> [Builder] -> [Builder] - outedges [] = id - outedges (Dominates n _ : ts) = - \bs -> " " - : showbDominatorNode root - : " -> " - : showbDominatorNode n - : s '\n' - : outedges ts bs - - dotnode :: DominatorNode -> Builder - dotnode Entry = " entryNode [shape=plaintext, label=\"entry\"]\n" - dotnode (Labelled l) = " " <> showbLabel l <> s '\n' - - subtree :: [Builder] -> DominatorTree -> [Builder] - subtree = flip dot - --- | Convert a 'DPath' to a 'Builder'. --- --- /Since: 0.2/ -showbDPath :: DPath -> Builder -showbDPath (DPath ls) = mconcat $ foldr (\l path ->showbLabel l <> " -> " : path) - ["entry"] - ls -{-# INLINE showbDPath #-} - -instance Show Label where - showb = showbLabel - INLINE_INST_FUN(showb) - -$(deriveShowPragmas defaultInlineShowbPrec ''LabelMap) - -instance Show1 LabelMap where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) - -$(deriveShowPragmas defaultInlineShowbPrec ''LabelSet) - -instance Show a => Show (Pointed t b a) where - showb = showbPointed - INLINE_INST_FUN(showb) - -instance Show1 (Pointed t b) where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) - -#if !(MIN_VERSION_hoopl(3,9,0)) -instance Show Unique where - showb = showbUnique - INLINE_INST_FUN(showb) -#endif - -$(deriveShowPragmas defaultInlineShowbPrec ''UniqueMap) - -instance Show1 UniqueMap where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) - -$(deriveShowPragmas defaultInlineShowbPrec ''UniqueSet) - -instance Show DominatorNode where - showb = showbDominatorNode - INLINE_INST_FUN(showb) - -instance Show DominatorTree where - showb = showbDominatorTree - INLINE_INST_FUN(showb) - -instance Show DPath where - showb = showbDPath - INLINE_INST_FUN(showb) +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Compiler.Hoopl +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @hoopl@ library. + +/Since: 0.2/ +-} +module Text.Show.Text.Compiler.Hoopl ( + showbLabel + , showbLabelMapPrec + , showbLabelSetPrec + , showbPointed + , showbUnique + , showbUniqueMapPrec + , showbUniqueSetPrec + , showbDominatorNode + , showbDominatorTree + , showbDPath + ) where + +import Compiler.Hoopl (Label, LabelMap, LabelSet, Pointed(..), + Unique, UniqueMap, UniqueSet) +#if MIN_VERSION_hoopl(3,9,0) +import Compiler.Hoopl.Internals (lblToUnique) +#else +import Compiler.Hoopl.GHC (lblToUnique, uniqueToInt) +#endif +import Compiler.Hoopl.Passes.Dominator (DominatorNode(..), DominatorTree(..), DPath(..)) + +#if !(MIN_VERSION_base(4,8,0)) +import Data.Monoid (mconcat) +#endif + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showb, showbPrec), Show1(showbPrec1), Builder) +import Text.Show.Text.Data.Containers () +import Text.Show.Text.Data.Integral (showbIntPrec) +import Text.Show.Text.TH (deriveShowPragmas, defaultInlineShowbPrec) +import Text.Show.Text.Utils ((<>), s) + +#include "inline.h" + +-- | Convert a 'Label' to a 'Builder'. +-- +-- /Since: 0.2/ +showbLabel :: Label -> Builder +showbLabel l = s 'L' <> showbUnique (lblToUnique l) +{-# INLINE showbLabel #-} + +-- | Convert a 'LabelMap' to a 'Builder' with the given precedence. +-- +-- /Since: 0.2/ +showbLabelMapPrec :: Show v => Int -> LabelMap v -> Builder +showbLabelMapPrec = showbPrec +{-# INLINE showbLabelMapPrec #-} + +-- | Convert a 'LabelSet' to a 'Builder' with the given precedence. +-- +-- /Since: 0.2/ +showbLabelSetPrec :: Int -> LabelSet -> Builder +showbLabelSetPrec = showbPrec +{-# INLINE showbLabelSetPrec #-} + +-- | Convert a 'Pointed' value to a 'Builder'. +-- +-- /Since: 0.2/ +showbPointed :: Show a => Pointed t b a -> Builder +showbPointed Bot = "_|_" +showbPointed Top = s 'T' +showbPointed (PElem a) = showb a +{-# INLINE showbPointed #-} + +-- | Convert a 'Unique' value to a 'Builder'. +-- +-- /Since: 0.2/ +showbUnique :: Unique -> Builder +#if MIN_VERSION_hoopl(3,9,0) +showbUnique = showbIntPrec 0 +#else +showbUnique = showbIntPrec 0 . uniqueToInt +#endif +{-# INLINE showbUnique #-} + +-- | Convert a 'UniqueMap' to a 'Builder' with the given precedence. +-- +-- /Since: 0.2/ +showbUniqueMapPrec :: Show v => Int -> UniqueMap v -> Builder +showbUniqueMapPrec = showbPrec +{-# INLINE showbUniqueMapPrec #-} + +-- | Convert a 'UniqueSet' to a 'Builder' with the given precedence. +-- +-- /Since: 0.2/ +showbUniqueSetPrec :: Int -> UniqueSet -> Builder +showbUniqueSetPrec = showbPrec +{-# INLINE showbUniqueSetPrec #-} + +-- | Convert a 'DominatorNode' to a 'Builder'. +-- +-- /Since: 0.2/ +showbDominatorNode :: DominatorNode -> Builder +showbDominatorNode Entry = "entryNode" +showbDominatorNode (Labelled l) = showbLabel l +{-# INLINE showbDominatorNode #-} + +-- | Convert a 'DominatorTree' to a 'Builder'. +-- +-- /Since: 0.2/ +showbDominatorTree :: DominatorTree -> Builder +showbDominatorTree t = mconcat $ "digraph {\n" : dot t ["}\n"] + where + dot :: DominatorTree -> [Builder] -> [Builder] + dot (Dominates root trees) = + (dotnode root :) . outedges trees . flip (foldl subtree) trees + where + outedges :: [DominatorTree] -> [Builder] -> [Builder] + outedges [] = id + outedges (Dominates n _ : ts) = + \bs -> " " + : showbDominatorNode root + : " -> " + : showbDominatorNode n + : s '\n' + : outedges ts bs + + dotnode :: DominatorNode -> Builder + dotnode Entry = " entryNode [shape=plaintext, label=\"entry\"]\n" + dotnode (Labelled l) = " " <> showbLabel l <> s '\n' + + subtree :: [Builder] -> DominatorTree -> [Builder] + subtree = flip dot + +-- | Convert a 'DPath' to a 'Builder'. +-- +-- /Since: 0.2/ +showbDPath :: DPath -> Builder +showbDPath (DPath ls) = mconcat $ foldr (\l path ->showbLabel l <> " -> " : path) + ["entry"] + ls +{-# INLINE showbDPath #-} + +instance Show Label where + showb = showbLabel + INLINE_INST_FUN(showb) + +$(deriveShowPragmas defaultInlineShowbPrec ''LabelMap) + +instance Show1 LabelMap where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) + +$(deriveShowPragmas defaultInlineShowbPrec ''LabelSet) + +instance Show a => Show (Pointed t b a) where + showb = showbPointed + INLINE_INST_FUN(showb) + +instance Show1 (Pointed t b) where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) + +#if !(MIN_VERSION_hoopl(3,9,0)) +instance Show Unique where + showb = showbUnique + INLINE_INST_FUN(showb) +#endif + +$(deriveShowPragmas defaultInlineShowbPrec ''UniqueMap) + +instance Show1 UniqueMap where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) + +$(deriveShowPragmas defaultInlineShowbPrec ''UniqueSet) + +instance Show DominatorNode where + showb = showbDominatorNode + INLINE_INST_FUN(showb) + +instance Show DominatorTree where + showb = showbDominatorTree + INLINE_INST_FUN(showb) + +instance Show DPath where + showb = showbDPath + INLINE_INST_FUN(showb) diff --git a/src/Text/Show/Text/Control.hs b/src/Text/Show/Text/Control.hs --- a/src/Text/Show/Text/Control.hs +++ b/src/Text/Show/Text/Control.hs @@ -1,14 +1,14 @@ -{-| -Module: Text.Show.Text.Control -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Imports 'Show' instances for @Control@ modules. --} -module Text.Show.Text.Control () where - -import Text.Show.Text.Control.Applicative.Trans () +{-| +Module: Text.Show.Text.Control +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Imports 'Show' instances for @Control@ modules. +-} +module Text.Show.Text.Control () where + +import Text.Show.Text.Control.Applicative.Trans () import Text.Show.Text.Control.Monad.Trans () diff --git a/src/Text/Show/Text/Control/Applicative/Trans.hs b/src/Text/Show/Text/Control/Applicative/Trans.hs --- a/src/Text/Show/Text/Control/Applicative/Trans.hs +++ b/src/Text/Show/Text/Control/Applicative/Trans.hs @@ -1,60 +1,60 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Control.Applicative.Trans -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for applicative functor transformers. - -/Since: 0.1/ --} -module Text.Show.Text.Control.Applicative.Trans ( - showbBackwardsPrec - , showbLiftPrec - ) where - -import Control.Applicative.Backwards (Backwards(..)) -import Control.Applicative.Lift (Lift(..)) - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder, - showbUnary, showbUnary1) - -#include "inline.h" - --- | Convert a 'Backwards' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbBackwardsPrec :: (Show1 f, Show a) => Int -> Backwards f a -> Builder -showbBackwardsPrec p (Backwards x) = showbUnary1 "Backwards" p x -{-# INLINE showbBackwardsPrec #-} - --- | Convert a 'Lift' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbLiftPrec :: (Show1 f, Show a) => Int -> Lift f a -> Builder -showbLiftPrec p (Pure x) = showbUnary "Pure" p x -showbLiftPrec p (Other y) = showbUnary1 "Other" p y -{-# INLINE showbLiftPrec #-} - -instance (Show1 f, Show a) => Show (Backwards f a) where - showbPrec = showbBackwardsPrec - INLINE_INST_FUN(showbPrec) - -instance Show1 f => Show1 (Backwards f) where - showbPrec1 = showbBackwardsPrec - INLINE_INST_FUN(showbPrec1) - -instance (Show1 f, Show a) => Show (Lift f a) where - showbPrec = showbLiftPrec - INLINE_INST_FUN(showbPrec) - -instance Show1 f => Show1 (Lift f) where - showbPrec1 = showbLiftPrec - INLINE_INST_FUN(showbPrec1) +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Control.Applicative.Trans +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for applicative functor transformers. + +/Since: 0.1/ +-} +module Text.Show.Text.Control.Applicative.Trans ( + showbBackwardsPrec + , showbLiftPrec + ) where + +import Control.Applicative.Backwards (Backwards(..)) +import Control.Applicative.Lift (Lift(..)) + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder, + showbUnary, showbUnary1) + +#include "inline.h" + +-- | Convert a 'Backwards' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbBackwardsPrec :: (Show1 f, Show a) => Int -> Backwards f a -> Builder +showbBackwardsPrec p (Backwards x) = showbUnary1 "Backwards" p x +{-# INLINE showbBackwardsPrec #-} + +-- | Convert a 'Lift' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbLiftPrec :: (Show1 f, Show a) => Int -> Lift f a -> Builder +showbLiftPrec p (Pure x) = showbUnary "Pure" p x +showbLiftPrec p (Other y) = showbUnary1 "Other" p y +{-# INLINE showbLiftPrec #-} + +instance (Show1 f, Show a) => Show (Backwards f a) where + showbPrec = showbBackwardsPrec + INLINE_INST_FUN(showbPrec) + +instance Show1 f => Show1 (Backwards f) where + showbPrec1 = showbBackwardsPrec + INLINE_INST_FUN(showbPrec1) + +instance (Show1 f, Show a) => Show (Lift f a) where + showbPrec = showbLiftPrec + INLINE_INST_FUN(showbPrec) + +instance Show1 f => Show1 (Lift f) where + showbPrec1 = showbLiftPrec + INLINE_INST_FUN(showbPrec1) diff --git a/src/Text/Show/Text/Control/Monad/Trans.hs b/src/Text/Show/Text/Control/Monad/Trans.hs --- a/src/Text/Show/Text/Control/Monad/Trans.hs +++ b/src/Text/Show/Text/Control/Monad/Trans.hs @@ -1,144 +1,144 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} -{-| -Module: Text.Show.Text.Control.Monad.Trans -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for monad transformers. - -/Since: 0.1/ --} -module Text.Show.Text.Control.Monad.Trans ( - showbErrorTPrec - , showbExceptTPrec - , showbIdentityTPrec - , showbListTPrec - , showbMaybeTPrec - , showbWriterTLazyPrec - , showbWriterTStrictPrec - ) where - -import Control.Monad.Trans.Error (ErrorT(..)) -import Control.Monad.Trans.Except (ExceptT(..)) -import Control.Monad.Trans.Identity (IdentityT(..)) -import Control.Monad.Trans.List (ListT(..)) -import Control.Monad.Trans.Maybe (MaybeT(..)) -import qualified Control.Monad.Trans.Writer.Lazy as WL (WriterT(..)) -import qualified Control.Monad.Trans.Writer.Strict as WS (WriterT(..)) - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), - Builder, showbUnary1) - -#include "inline.h" - --- | Convert an 'ErrorT' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbErrorTPrec :: (Show e, Show1 m, Show a) => Int -> ErrorT e m a -> Builder -showbErrorTPrec p (ErrorT m) = showbUnary1 "ErrorT" p m -{-# INLINE showbErrorTPrec #-} - --- | Convert an 'ExceptT' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbExceptTPrec :: (Show e, Show1 m, Show a) => Int -> ExceptT e m a -> Builder -showbExceptTPrec p (ExceptT m) = showbUnary1 "ExceptT" p m -{-# INLINE showbExceptTPrec #-} - --- | Convert an 'IdentityT' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbIdentityTPrec :: (Show1 f, Show a) => Int -> IdentityT f a -> Builder -showbIdentityTPrec p (IdentityT m) = showbUnary1 "IdentityT" p m -{-# INLINE showbIdentityTPrec #-} - --- | Convert a 'ListT' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbListTPrec :: (Show1 m, Show a) => Int -> ListT m a -> Builder -showbListTPrec p (ListT m) = showbUnary1 "ListT" p m -{-# INLINE showbListTPrec #-} - --- | Convert a 'MaybeT' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbMaybeTPrec :: (Show1 m, Show a) => Int -> MaybeT m a -> Builder -showbMaybeTPrec p (MaybeT m) = showbUnary1 "MaybeT" p m -{-# INLINE showbMaybeTPrec #-} - --- | Convert a lazy 'WL.WriterT' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbWriterTLazyPrec :: (Show w, Show1 m, Show a) => Int -> WL.WriterT w m a -> Builder -showbWriterTLazyPrec p (WL.WriterT m) = showbUnary1 "WriterT" p m -{-# INLINE showbWriterTLazyPrec #-} - --- | Convert a strict 'WS.WriterT' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbWriterTStrictPrec :: (Show w, Show1 m, Show a) => Int -> WS.WriterT w m a -> Builder -showbWriterTStrictPrec p (WS.WriterT m) = showbUnary1 "WriterT" p m -{-# INLINE showbWriterTStrictPrec #-} - -instance (Show e, Show1 m, Show a) => Show (ErrorT e m a) where - showbPrec = showbErrorTPrec - INLINE_INST_FUN(showbPrec) - -instance (Show e, Show1 m) => Show1 (ErrorT e m) where - showbPrec1 = showbErrorTPrec - INLINE_INST_FUN(showbPrec1) - -instance (Show e, Show1 m, Show a) => Show (ExceptT e m a) where - showbPrec = showbExceptTPrec - INLINE_INST_FUN(showbPrec) - -instance (Show e, Show1 m) => Show1 (ExceptT e m) where - showbPrec1 = showbExceptTPrec - INLINE_INST_FUN(showbPrec1) - -instance (Show1 f, Show a) => Show (IdentityT f a) where - showbPrec = showbIdentityTPrec - INLINE_INST_FUN(showbPrec) - -instance Show1 f => Show1 (IdentityT f) where - showbPrec1 = showbIdentityTPrec - INLINE_INST_FUN(showbPrec1) - -instance (Show1 m, Show a) => Show (ListT m a) where - showbPrec = showbListTPrec - INLINE_INST_FUN(showbPrec) - -instance Show1 m => Show1 (ListT m) where - showbPrec1 = showbListTPrec - INLINE_INST_FUN(showbPrec1) - -instance (Show1 m, Show a) => Show (MaybeT m a) where - showbPrec = showbMaybeTPrec - INLINE_INST_FUN(showbPrec) - -instance Show1 m => Show1 (MaybeT m) where - showbPrec1 = showbMaybeTPrec - INLINE_INST_FUN(showbPrec1) - -instance (Show w, Show1 m, Show a) => Show (WL.WriterT w m a) where - showbPrec = showbWriterTLazyPrec - INLINE_INST_FUN(showbPrec) - -instance (Show w, Show1 m) => Show1 (WL.WriterT w m) where - showbPrec1 = showbWriterTLazyPrec - INLINE_INST_FUN(showbPrec1) - -instance (Show w, Show1 m, Show a) => Show (WS.WriterT w m a) where - showbPrec = showbWriterTStrictPrec - INLINE_INST_FUN(showbPrec) - -instance (Show w, Show1 m) => Show1 (WS.WriterT w m) where - showbPrec1 = showbWriterTStrictPrec - INLINE_INST_FUN(showbPrec1) +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} +{-| +Module: Text.Show.Text.Control.Monad.Trans +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for monad transformers. + +/Since: 0.1/ +-} +module Text.Show.Text.Control.Monad.Trans ( + showbErrorTPrec + , showbExceptTPrec + , showbIdentityTPrec + , showbListTPrec + , showbMaybeTPrec + , showbWriterTLazyPrec + , showbWriterTStrictPrec + ) where + +import Control.Monad.Trans.Error (ErrorT(..)) +import Control.Monad.Trans.Except (ExceptT(..)) +import Control.Monad.Trans.Identity (IdentityT(..)) +import Control.Monad.Trans.List (ListT(..)) +import Control.Monad.Trans.Maybe (MaybeT(..)) +import qualified Control.Monad.Trans.Writer.Lazy as WL (WriterT(..)) +import qualified Control.Monad.Trans.Writer.Strict as WS (WriterT(..)) + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), + Builder, showbUnary1) + +#include "inline.h" + +-- | Convert an 'ErrorT' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbErrorTPrec :: (Show e, Show1 m, Show a) => Int -> ErrorT e m a -> Builder +showbErrorTPrec p (ErrorT m) = showbUnary1 "ErrorT" p m +{-# INLINE showbErrorTPrec #-} + +-- | Convert an 'ExceptT' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbExceptTPrec :: (Show e, Show1 m, Show a) => Int -> ExceptT e m a -> Builder +showbExceptTPrec p (ExceptT m) = showbUnary1 "ExceptT" p m +{-# INLINE showbExceptTPrec #-} + +-- | Convert an 'IdentityT' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbIdentityTPrec :: (Show1 f, Show a) => Int -> IdentityT f a -> Builder +showbIdentityTPrec p (IdentityT m) = showbUnary1 "IdentityT" p m +{-# INLINE showbIdentityTPrec #-} + +-- | Convert a 'ListT' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbListTPrec :: (Show1 m, Show a) => Int -> ListT m a -> Builder +showbListTPrec p (ListT m) = showbUnary1 "ListT" p m +{-# INLINE showbListTPrec #-} + +-- | Convert a 'MaybeT' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbMaybeTPrec :: (Show1 m, Show a) => Int -> MaybeT m a -> Builder +showbMaybeTPrec p (MaybeT m) = showbUnary1 "MaybeT" p m +{-# INLINE showbMaybeTPrec #-} + +-- | Convert a lazy 'WL.WriterT' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbWriterTLazyPrec :: (Show w, Show1 m, Show a) => Int -> WL.WriterT w m a -> Builder +showbWriterTLazyPrec p (WL.WriterT m) = showbUnary1 "WriterT" p m +{-# INLINE showbWriterTLazyPrec #-} + +-- | Convert a strict 'WS.WriterT' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbWriterTStrictPrec :: (Show w, Show1 m, Show a) => Int -> WS.WriterT w m a -> Builder +showbWriterTStrictPrec p (WS.WriterT m) = showbUnary1 "WriterT" p m +{-# INLINE showbWriterTStrictPrec #-} + +instance (Show e, Show1 m, Show a) => Show (ErrorT e m a) where + showbPrec = showbErrorTPrec + INLINE_INST_FUN(showbPrec) + +instance (Show e, Show1 m) => Show1 (ErrorT e m) where + showbPrec1 = showbErrorTPrec + INLINE_INST_FUN(showbPrec1) + +instance (Show e, Show1 m, Show a) => Show (ExceptT e m a) where + showbPrec = showbExceptTPrec + INLINE_INST_FUN(showbPrec) + +instance (Show e, Show1 m) => Show1 (ExceptT e m) where + showbPrec1 = showbExceptTPrec + INLINE_INST_FUN(showbPrec1) + +instance (Show1 f, Show a) => Show (IdentityT f a) where + showbPrec = showbIdentityTPrec + INLINE_INST_FUN(showbPrec) + +instance Show1 f => Show1 (IdentityT f) where + showbPrec1 = showbIdentityTPrec + INLINE_INST_FUN(showbPrec1) + +instance (Show1 m, Show a) => Show (ListT m a) where + showbPrec = showbListTPrec + INLINE_INST_FUN(showbPrec) + +instance Show1 m => Show1 (ListT m) where + showbPrec1 = showbListTPrec + INLINE_INST_FUN(showbPrec1) + +instance (Show1 m, Show a) => Show (MaybeT m a) where + showbPrec = showbMaybeTPrec + INLINE_INST_FUN(showbPrec) + +instance Show1 m => Show1 (MaybeT m) where + showbPrec1 = showbMaybeTPrec + INLINE_INST_FUN(showbPrec1) + +instance (Show w, Show1 m, Show a) => Show (WL.WriterT w m a) where + showbPrec = showbWriterTLazyPrec + INLINE_INST_FUN(showbPrec) + +instance (Show w, Show1 m) => Show1 (WL.WriterT w m) where + showbPrec1 = showbWriterTLazyPrec + INLINE_INST_FUN(showbPrec1) + +instance (Show w, Show1 m, Show a) => Show (WS.WriterT w m a) where + showbPrec = showbWriterTStrictPrec + INLINE_INST_FUN(showbPrec) + +instance (Show w, Show1 m) => Show1 (WS.WriterT w m) where + showbPrec1 = showbWriterTStrictPrec + INLINE_INST_FUN(showbPrec1) diff --git a/src/Text/Show/Text/Data.hs b/src/Text/Show/Text/Data.hs --- a/src/Text/Show/Text/Data.hs +++ b/src/Text/Show/Text/Data.hs @@ -1,22 +1,22 @@ -{-| -Module: Text.Show.Text.Data -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Imports 'Show' instances for @Data@ modules. --} -module Text.Show.Text.Data () where - -import Text.Show.Text.Data.Binary () -import Text.Show.Text.Data.Containers () -import Text.Show.Text.Data.Functor.Trans () -import Text.Show.Text.Data.List.NonEmpty () -import Text.Show.Text.Data.Semigroup () -import Text.Show.Text.Data.String.UTF8 () -import Text.Show.Text.Data.Tagged () -import Text.Show.Text.Data.Time () -import Text.Show.Text.Data.UnorderedContainers () -import Text.Show.Text.Data.Vector () +{-| +Module: Text.Show.Text.Data +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Imports 'Show' instances for @Data@ modules. +-} +module Text.Show.Text.Data () where + +import Text.Show.Text.Data.Binary () +import Text.Show.Text.Data.Containers () +import Text.Show.Text.Data.Functor.Trans () +import Text.Show.Text.Data.List.NonEmpty () +import Text.Show.Text.Data.Semigroup () +import Text.Show.Text.Data.String.UTF8 () +import Text.Show.Text.Data.Tagged () +import Text.Show.Text.Data.Time () +import Text.Show.Text.Data.UnorderedContainers () +import Text.Show.Text.Data.Vector () diff --git a/src/Text/Show/Text/Data/Binary.hs b/src/Text/Show/Text/Data/Binary.hs --- a/src/Text/Show/Text/Data/Binary.hs +++ b/src/Text/Show/Text/Data/Binary.hs @@ -1,42 +1,42 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Data.Binary -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' function for 'Decoder's. - -/Since: 0.2/ --} -module Text.Show.Text.Data.Binary (showbDecoder) where - -import Data.Binary.Get.Internal (Decoder(..)) - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showb, showbPrec), Show1(showbPrec1), Builder, fromString) -import Text.Show.Text.Utils ((<>)) - -#include "inline.h" - --- | Convert a 'Decoder' to a 'Builder'. --- --- /Since: 0.2/ -showbDecoder :: Show a => Decoder a -> Builder -showbDecoder (Fail _ msg) = "Fail: " <> fromString msg -showbDecoder (Partial _) = "Partial _" -showbDecoder (Done _ a) = "Done: " <> showb a -showbDecoder (BytesRead _ _) = "BytesRead" - -instance Show a => Show (Decoder a) where - showb = showbDecoder - INLINE_INST_FUN(showb) - -instance Show1 Decoder where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Data.Binary +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' function for 'Decoder's. + +/Since: 0.2/ +-} +module Text.Show.Text.Data.Binary (showbDecoder) where + +import Data.Binary.Get.Internal (Decoder(..)) + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showb, showbPrec), Show1(showbPrec1), Builder, fromString) +import Text.Show.Text.Utils ((<>)) + +#include "inline.h" + +-- | Convert a 'Decoder' to a 'Builder'. +-- +-- /Since: 0.2/ +showbDecoder :: Show a => Decoder a -> Builder +showbDecoder (Fail _ msg) = "Fail: " <> fromString msg +showbDecoder (Partial _) = "Partial _" +showbDecoder (Done _ a) = "Done: " <> showb a +showbDecoder (BytesRead _ _) = "BytesRead" + +instance Show a => Show (Decoder a) where + showb = showbDecoder + INLINE_INST_FUN(showb) + +instance Show1 Decoder where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) diff --git a/src/Text/Show/Text/Data/Containers.hs b/src/Text/Show/Text/Data/Containers.hs --- a/src/Text/Show/Text/Data/Containers.hs +++ b/src/Text/Show/Text/Data/Containers.hs @@ -1,157 +1,157 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Data.Containers -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @containers@ library. - -/Since: 0.1/ --} -module Text.Show.Text.Data.Containers ( - showbIntMapPrec - , showbIntSetPrec - , showbMapPrec - , showbSequencePrec - , showbViewLPrec - , showbViewRPrec - , showbSetPrec - , showbTreePrec - ) where - -import qualified Data.Foldable as F - -import qualified Data.IntMap as IM -import Data.IntMap (IntMap) -import qualified Data.IntSet as IS -import Data.IntSet (IntSet) -import qualified Data.Map as M -import Data.Map (Map) -import Data.Sequence (Seq, ViewL, ViewR) -import qualified Data.Set as Set -import Data.Set (Set) -import Data.Tree (Tree) - -import Prelude hiding (Show) - -import Text.Show.Text (Builder, Show(showbPrec), Show1(showbPrec1)) -import Text.Show.Text.Data.Integral () -import Text.Show.Text.Data.List () -import Text.Show.Text.Data.Tuple () -import Text.Show.Text.TH (deriveShowPragmas, defaultInlineShowbPrec) -import Text.Show.Text.Utils (showbUnaryList) - -#include "inline.h" - --- | Convert an 'IntMap' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbIntMapPrec :: Show v => Int -> IntMap v -> Builder -showbIntMapPrec p = showbUnaryList p . IM.toList -{-# INLINE showbIntMapPrec #-} - --- | Convert an 'IntSet' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbIntSetPrec :: Int -> IntSet -> Builder -showbIntSetPrec p = showbUnaryList p . IS.toList -{-# INLINE showbIntSetPrec #-} - --- | Convert a 'Map' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbMapPrec :: (Show k, Show v) => Int -> Map k v -> Builder -showbMapPrec p = showbUnaryList p . M.toList -{-# INLINE showbMapPrec #-} - --- | Convert a 'Sequence' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbSequencePrec :: Show a => Int -> Seq a -> Builder -showbSequencePrec p = showbUnaryList p . F.toList -{-# INLINE showbSequencePrec #-} - --- | Convert a 'ViewL' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbViewLPrec :: Show a => Int -> ViewL a -> Builder -showbViewLPrec = showbPrec -{-# INLINE showbViewLPrec #-} - --- | Convert a 'ViewR' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbViewRPrec :: Show a => Int -> ViewR a -> Builder -showbViewRPrec = showbPrec -{-# INLINE showbViewRPrec #-} - --- | Convert a 'Set' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbSetPrec :: Show a => Int -> Set a -> Builder -showbSetPrec p = showbUnaryList p . Set.toList -{-# INLINE showbSetPrec #-} - --- | Convert a 'Tree' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbTreePrec :: Show a => Int -> Tree a -> Builder -showbTreePrec = showbPrec -{-# INLINE showbTreePrec #-} - -instance Show v => Show (IntMap v) where - showbPrec = showbIntMapPrec - INLINE_INST_FUN(showbPrec) - -instance Show IntSet where - showbPrec = showbIntSetPrec - INLINE_INST_FUN(showbPrec) - -instance (Show k, Show v) => Show (Map k v) where - showbPrec = showbMapPrec - INLINE_INST_FUN(showbPrec) - -instance Show a => Show (Seq a) where - showbPrec = showbSequencePrec - INLINE_INST_FUN(showbPrec) - -instance Show a => Show (Set a) where - showbPrec = showbSetPrec - INLINE_INST_FUN(showbPrec) - -$(deriveShowPragmas defaultInlineShowbPrec ''ViewL) -$(deriveShowPragmas defaultInlineShowbPrec ''ViewR) -$(deriveShowPragmas defaultInlineShowbPrec ''Tree) - -instance Show1 IntMap where - showbPrec1 = showbIntMapPrec - INLINE_INST_FUN(showbPrec1) - -instance Show k => Show1 (Map k) where - showbPrec1 = showbMapPrec - INLINE_INST_FUN(showbPrec1) - -instance Show1 Seq where - showbPrec1 = showbSequencePrec - INLINE_INST_FUN(showbPrec1) - -instance Show1 ViewL where - showbPrec1 = showbViewLPrec - INLINE_INST_FUN(showbPrec1) - -instance Show1 ViewR where - showbPrec1 = showbViewRPrec - INLINE_INST_FUN(showbPrec1) - -instance Show1 Set where - showbPrec1 = showbSetPrec - INLINE_INST_FUN(showbPrec1) - -instance Show1 Tree where - showbPrec1 = showbTreePrec - INLINE_INST_FUN(showbPrec1) +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Data.Containers +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @containers@ library. + +/Since: 0.1/ +-} +module Text.Show.Text.Data.Containers ( + showbIntMapPrec + , showbIntSetPrec + , showbMapPrec + , showbSequencePrec + , showbViewLPrec + , showbViewRPrec + , showbSetPrec + , showbTreePrec + ) where + +import qualified Data.Foldable as F + +import qualified Data.IntMap as IM +import Data.IntMap (IntMap) +import qualified Data.IntSet as IS +import Data.IntSet (IntSet) +import qualified Data.Map as M +import Data.Map (Map) +import Data.Sequence (Seq, ViewL, ViewR) +import qualified Data.Set as Set +import Data.Set (Set) +import Data.Tree (Tree) + +import Prelude hiding (Show) + +import Text.Show.Text (Builder, Show(showbPrec), Show1(showbPrec1)) +import Text.Show.Text.Data.Integral () +import Text.Show.Text.Data.List () +import Text.Show.Text.Data.Tuple () +import Text.Show.Text.TH (deriveShowPragmas, defaultInlineShowbPrec) +import Text.Show.Text.Utils (showbUnaryList) + +#include "inline.h" + +-- | Convert an 'IntMap' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbIntMapPrec :: Show v => Int -> IntMap v -> Builder +showbIntMapPrec p = showbUnaryList p . IM.toList +{-# INLINE showbIntMapPrec #-} + +-- | Convert an 'IntSet' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbIntSetPrec :: Int -> IntSet -> Builder +showbIntSetPrec p = showbUnaryList p . IS.toList +{-# INLINE showbIntSetPrec #-} + +-- | Convert a 'Map' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbMapPrec :: (Show k, Show v) => Int -> Map k v -> Builder +showbMapPrec p = showbUnaryList p . M.toList +{-# INLINE showbMapPrec #-} + +-- | Convert a 'Sequence' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbSequencePrec :: Show a => Int -> Seq a -> Builder +showbSequencePrec p = showbUnaryList p . F.toList +{-# INLINE showbSequencePrec #-} + +-- | Convert a 'ViewL' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbViewLPrec :: Show a => Int -> ViewL a -> Builder +showbViewLPrec = showbPrec +{-# INLINE showbViewLPrec #-} + +-- | Convert a 'ViewR' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbViewRPrec :: Show a => Int -> ViewR a -> Builder +showbViewRPrec = showbPrec +{-# INLINE showbViewRPrec #-} + +-- | Convert a 'Set' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbSetPrec :: Show a => Int -> Set a -> Builder +showbSetPrec p = showbUnaryList p . Set.toList +{-# INLINE showbSetPrec #-} + +-- | Convert a 'Tree' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbTreePrec :: Show a => Int -> Tree a -> Builder +showbTreePrec = showbPrec +{-# INLINE showbTreePrec #-} + +instance Show v => Show (IntMap v) where + showbPrec = showbIntMapPrec + INLINE_INST_FUN(showbPrec) + +instance Show IntSet where + showbPrec = showbIntSetPrec + INLINE_INST_FUN(showbPrec) + +instance (Show k, Show v) => Show (Map k v) where + showbPrec = showbMapPrec + INLINE_INST_FUN(showbPrec) + +instance Show a => Show (Seq a) where + showbPrec = showbSequencePrec + INLINE_INST_FUN(showbPrec) + +instance Show a => Show (Set a) where + showbPrec = showbSetPrec + INLINE_INST_FUN(showbPrec) + +$(deriveShowPragmas defaultInlineShowbPrec ''ViewL) +$(deriveShowPragmas defaultInlineShowbPrec ''ViewR) +$(deriveShowPragmas defaultInlineShowbPrec ''Tree) + +instance Show1 IntMap where + showbPrec1 = showbIntMapPrec + INLINE_INST_FUN(showbPrec1) + +instance Show k => Show1 (Map k) where + showbPrec1 = showbMapPrec + INLINE_INST_FUN(showbPrec1) + +instance Show1 Seq where + showbPrec1 = showbSequencePrec + INLINE_INST_FUN(showbPrec1) + +instance Show1 ViewL where + showbPrec1 = showbViewLPrec + INLINE_INST_FUN(showbPrec1) + +instance Show1 ViewR where + showbPrec1 = showbViewRPrec + INLINE_INST_FUN(showbPrec1) + +instance Show1 Set where + showbPrec1 = showbSetPrec + INLINE_INST_FUN(showbPrec1) + +instance Show1 Tree where + showbPrec1 = showbTreePrec + INLINE_INST_FUN(showbPrec1) diff --git a/src/Text/Show/Text/Data/Functor/Trans.hs b/src/Text/Show/Text/Data/Functor/Trans.hs --- a/src/Text/Show/Text/Data/Functor/Trans.hs +++ b/src/Text/Show/Text/Data/Functor/Trans.hs @@ -1,120 +1,120 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Data.Functor.Trans -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for functor transformers. Note that an instance for -the 'Identity' transformer is found in @text-show@, since it is a part of -@base-4.8.0.0@ and later. - -/Since: 0.1/ --} -module Text.Show.Text.Data.Functor.Trans ( - showbComposePrec - , showbConstantPrec - , showbProductPrec - , showbReversePrec - , showbSumPrec - ) where - -import Data.Functor.Compose (Compose(..)) -import Data.Functor.Constant (Constant(..)) -import Data.Functor.Product (Product(..)) -import Data.Functor.Reverse (Reverse(..)) -import Data.Functor.Sum (Sum(..)) - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder, - showbUnary, showbUnary1, showbBinary1) - -#include "inline.h" - --- kludge to get type with the same instances as g a -newtype Apply g a = Apply (g a) - -instance (Show1 g, Show a) => Show (Apply g a) where - showbPrec p (Apply x) = showbPrec1 p x - INLINE_INST_FUN(showbPrec) - --- | Convert a 'Compose' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbComposePrec :: (Functor f, Show1 f, Show1 g, Show a) => Int -> Compose f g a -> Builder -showbComposePrec p (Compose x) = showbUnary1 "Compose" p $ fmap Apply x -{-# INLINE showbComposePrec #-} - --- | Convert a 'Constant' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbConstantPrec :: Show a => Int -> Constant a b -> Builder -showbConstantPrec p (Constant x) = showbUnary "Constant" p x -{-# INLINE showbConstantPrec #-} - --- | Convert a 'Product' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbProductPrec :: (Show1 f, Show1 g, Show a) => Int -> Product f g a -> Builder -showbProductPrec p (Pair x y) = showbBinary1 "Pair" p x y -{-# INLINE showbProductPrec #-} - --- | Convert a 'Reverse' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbReversePrec :: (Show1 f, Show a) => Int -> Reverse f a -> Builder -showbReversePrec p (Reverse x) = showbUnary1 "Reverse" p x -{-# INLINE showbReversePrec #-} - --- | Convert a 'Sum' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbSumPrec :: (Show1 f, Show1 g, Show a) => Int -> Sum f g a -> Builder -showbSumPrec p (InL x) = showbUnary1 "InL" p x -showbSumPrec p (InR y) = showbUnary1 "InR" p y -{-# INLINE showbSumPrec #-} - -instance (Functor f, Show1 f, Show1 g, Show a) => Show (Compose f g a) where - showbPrec = showbComposePrec - INLINE_INST_FUN(showbPrec) - -instance (Functor f, Show1 f, Show1 g) => Show1 (Compose f g) where - showbPrec1 = showbComposePrec - INLINE_INST_FUN(showbPrec1) - -instance Show a => Show (Constant a b) where - showbPrec = showbConstantPrec - INLINE_INST_FUN(showbPrec) - -instance Show a => Show1 (Constant a) where - showbPrec1 = showbConstantPrec - INLINE_INST_FUN(showbPrec1) - -instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where - showbPrec = showbProductPrec - INLINE_INST_FUN(showbPrec) - -instance (Show1 f, Show1 g) => Show1 (Product f g) where - showbPrec1 = showbProductPrec - INLINE_INST_FUN(showbPrec1) - -instance (Show1 f, Show a) => Show (Reverse f a) where - showbPrec = showbReversePrec - INLINE_INST_FUN(showbPrec) - -instance Show1 f => Show1 (Reverse f) where - showbPrec1 = showbReversePrec - INLINE_INST_FUN(showbPrec1) - -instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where - showbPrec = showbSumPrec - INLINE_INST_FUN(showbPrec) - -instance (Show1 f, Show1 g) => Show1 (Sum f g) where - showbPrec1 = showbSumPrec - INLINE_INST_FUN(showbPrec1) +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Data.Functor.Trans +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for functor transformers. Note that an instance for +the 'Identity' transformer is found in @text-show@, since it is a part of +@base-4.8.0.0@ and later. + +/Since: 0.1/ +-} +module Text.Show.Text.Data.Functor.Trans ( + showbComposePrec + , showbConstantPrec + , showbProductPrec + , showbReversePrec + , showbSumPrec + ) where + +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Constant (Constant(..)) +import Data.Functor.Product (Product(..)) +import Data.Functor.Reverse (Reverse(..)) +import Data.Functor.Sum (Sum(..)) + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder, + showbUnary, showbUnary1, showbBinary1) + +#include "inline.h" + +-- kludge to get type with the same instances as g a +newtype Apply g a = Apply (g a) + +instance (Show1 g, Show a) => Show (Apply g a) where + showbPrec p (Apply x) = showbPrec1 p x + INLINE_INST_FUN(showbPrec) + +-- | Convert a 'Compose' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbComposePrec :: (Functor f, Show1 f, Show1 g, Show a) => Int -> Compose f g a -> Builder +showbComposePrec p (Compose x) = showbUnary1 "Compose" p $ fmap Apply x +{-# INLINE showbComposePrec #-} + +-- | Convert a 'Constant' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbConstantPrec :: Show a => Int -> Constant a b -> Builder +showbConstantPrec p (Constant x) = showbUnary "Constant" p x +{-# INLINE showbConstantPrec #-} + +-- | Convert a 'Product' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbProductPrec :: (Show1 f, Show1 g, Show a) => Int -> Product f g a -> Builder +showbProductPrec p (Pair x y) = showbBinary1 "Pair" p x y +{-# INLINE showbProductPrec #-} + +-- | Convert a 'Reverse' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbReversePrec :: (Show1 f, Show a) => Int -> Reverse f a -> Builder +showbReversePrec p (Reverse x) = showbUnary1 "Reverse" p x +{-# INLINE showbReversePrec #-} + +-- | Convert a 'Sum' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbSumPrec :: (Show1 f, Show1 g, Show a) => Int -> Sum f g a -> Builder +showbSumPrec p (InL x) = showbUnary1 "InL" p x +showbSumPrec p (InR y) = showbUnary1 "InR" p y +{-# INLINE showbSumPrec #-} + +instance (Functor f, Show1 f, Show1 g, Show a) => Show (Compose f g a) where + showbPrec = showbComposePrec + INLINE_INST_FUN(showbPrec) + +instance (Functor f, Show1 f, Show1 g) => Show1 (Compose f g) where + showbPrec1 = showbComposePrec + INLINE_INST_FUN(showbPrec1) + +instance Show a => Show (Constant a b) where + showbPrec = showbConstantPrec + INLINE_INST_FUN(showbPrec) + +instance Show a => Show1 (Constant a) where + showbPrec1 = showbConstantPrec + INLINE_INST_FUN(showbPrec1) + +instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where + showbPrec = showbProductPrec + INLINE_INST_FUN(showbPrec) + +instance (Show1 f, Show1 g) => Show1 (Product f g) where + showbPrec1 = showbProductPrec + INLINE_INST_FUN(showbPrec1) + +instance (Show1 f, Show a) => Show (Reverse f a) where + showbPrec = showbReversePrec + INLINE_INST_FUN(showbPrec) + +instance Show1 f => Show1 (Reverse f) where + showbPrec1 = showbReversePrec + INLINE_INST_FUN(showbPrec1) + +instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where + showbPrec = showbSumPrec + INLINE_INST_FUN(showbPrec) + +instance (Show1 f, Show1 g) => Show1 (Sum f g) where + showbPrec1 = showbSumPrec + INLINE_INST_FUN(showbPrec1) diff --git a/src/Text/Show/Text/Data/List/NonEmpty.hs b/src/Text/Show/Text/Data/List/NonEmpty.hs --- a/src/Text/Show/Text/Data/List/NonEmpty.hs +++ b/src/Text/Show/Text/Data/List/NonEmpty.hs @@ -1,38 +1,38 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Data.List.NonEmpty -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' function for 'NonEmpty' lists. - -/Since: 0.1/ --} -module Text.Show.Text.Data.List.NonEmpty (showbNonEmptyPrec) where - -import Data.List.NonEmpty (NonEmpty) - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder) -import Text.Show.Text.TH (deriveShowPragmas, defaultInlineShowbPrec) - -#include "inline.h" - --- | Convert a 'NonEmpty' list to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbNonEmptyPrec :: Show a => Int -> NonEmpty a -> Builder -showbNonEmptyPrec = showbPrec -{-# INLINE showbNonEmptyPrec #-} - -$(deriveShowPragmas defaultInlineShowbPrec ''NonEmpty) - -instance Show1 NonEmpty where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Data.List.NonEmpty +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' function for 'NonEmpty' lists. + +/Since: 0.1/ +-} +module Text.Show.Text.Data.List.NonEmpty (showbNonEmptyPrec) where + +import Data.List.NonEmpty (NonEmpty) + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder) +import Text.Show.Text.TH (deriveShowPragmas, defaultInlineShowbPrec) + +#include "inline.h" + +-- | Convert a 'NonEmpty' list to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbNonEmptyPrec :: Show a => Int -> NonEmpty a -> Builder +showbNonEmptyPrec = showbPrec +{-# INLINE showbNonEmptyPrec #-} + +$(deriveShowPragmas defaultInlineShowbPrec ''NonEmpty) + +instance Show1 NonEmpty where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) diff --git a/src/Text/Show/Text/Data/Semigroup.hs b/src/Text/Show/Text/Data/Semigroup.hs --- a/src/Text/Show/Text/Data/Semigroup.hs +++ b/src/Text/Show/Text/Data/Semigroup.hs @@ -1,118 +1,118 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Data.Semigroup -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for @Semigroup@ data types. - -/Since: 0.1/ --} -module Text.Show.Text.Data.Semigroup ( - showbMinPrec - , showbMaxPrec - , showbFirstPrec - , showbLastPrec - , showbWrappedMonoidPrec - , showbOptionPrec - , showbArgPrec - ) where - -import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg) - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder) -import Text.Show.Text.TH (deriveShowPragmas, defaultInlineShowbPrec) - -#include "inline.h" - --- | Convert a 'Min' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbMinPrec :: Show a => Int -> Min a -> Builder -showbMinPrec = showbPrec -{-# INLINE showbMinPrec #-} - --- | Convert a 'Max' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbMaxPrec :: Show a => Int -> Max a -> Builder -showbMaxPrec = showbPrec -{-# INLINE showbMaxPrec #-} - --- | Convert a 'First' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbFirstPrec :: Show a => Int -> First a -> Builder -showbFirstPrec = showbPrec -{-# INLINE showbFirstPrec #-} - --- | Convert a 'Last' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbLastPrec :: Show a => Int -> Last a -> Builder -showbLastPrec = showbPrec -{-# INLINE showbLastPrec #-} - --- | Convert a 'WrappedMonoid' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbWrappedMonoidPrec :: Show m => Int -> WrappedMonoid m -> Builder -showbWrappedMonoidPrec = showbPrec -{-# INLINE showbWrappedMonoidPrec #-} - --- | Convert an 'Option' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbOptionPrec :: Show a => Int -> Option a -> Builder -showbOptionPrec = showbPrec -{-# INLINE showbOptionPrec #-} - --- | Convert an 'Arg' value to a 'Builder' with the given precedence. --- --- /Since: 0.3/ -showbArgPrec :: (Show a, Show b) => Int -> Arg a b -> Builder -showbArgPrec = showbPrec -{-# INLINE showbArgPrec #-} - -$(deriveShowPragmas defaultInlineShowbPrec ''Min) -$(deriveShowPragmas defaultInlineShowbPrec ''Max) -$(deriveShowPragmas defaultInlineShowbPrec ''First) -$(deriveShowPragmas defaultInlineShowbPrec ''Last) -$(deriveShowPragmas defaultInlineShowbPrec ''WrappedMonoid) -$(deriveShowPragmas defaultInlineShowbPrec ''Option) -$(deriveShowPragmas defaultInlineShowbPrec ''Arg) - -instance Show1 Min where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) - -instance Show1 Max where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) - -instance Show1 First where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) - -instance Show1 Last where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) - -instance Show1 WrappedMonoid where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) - -instance Show1 Option where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) - -instance Show a => Show1 (Arg a) where - showbPrec1 = showbPrec - INLINE_INST_FUN(showbPrec1) +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Data.Semigroup +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for @Semigroup@ data types. + +/Since: 0.1/ +-} +module Text.Show.Text.Data.Semigroup ( + showbMinPrec + , showbMaxPrec + , showbFirstPrec + , showbLastPrec + , showbWrappedMonoidPrec + , showbOptionPrec + , showbArgPrec + ) where + +import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg) + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder) +import Text.Show.Text.TH (deriveShowPragmas, defaultInlineShowbPrec) + +#include "inline.h" + +-- | Convert a 'Min' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbMinPrec :: Show a => Int -> Min a -> Builder +showbMinPrec = showbPrec +{-# INLINE showbMinPrec #-} + +-- | Convert a 'Max' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbMaxPrec :: Show a => Int -> Max a -> Builder +showbMaxPrec = showbPrec +{-# INLINE showbMaxPrec #-} + +-- | Convert a 'First' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbFirstPrec :: Show a => Int -> First a -> Builder +showbFirstPrec = showbPrec +{-# INLINE showbFirstPrec #-} + +-- | Convert a 'Last' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbLastPrec :: Show a => Int -> Last a -> Builder +showbLastPrec = showbPrec +{-# INLINE showbLastPrec #-} + +-- | Convert a 'WrappedMonoid' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbWrappedMonoidPrec :: Show m => Int -> WrappedMonoid m -> Builder +showbWrappedMonoidPrec = showbPrec +{-# INLINE showbWrappedMonoidPrec #-} + +-- | Convert an 'Option' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbOptionPrec :: Show a => Int -> Option a -> Builder +showbOptionPrec = showbPrec +{-# INLINE showbOptionPrec #-} + +-- | Convert an 'Arg' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.3/ +showbArgPrec :: (Show a, Show b) => Int -> Arg a b -> Builder +showbArgPrec = showbPrec +{-# INLINE showbArgPrec #-} + +$(deriveShowPragmas defaultInlineShowbPrec ''Min) +$(deriveShowPragmas defaultInlineShowbPrec ''Max) +$(deriveShowPragmas defaultInlineShowbPrec ''First) +$(deriveShowPragmas defaultInlineShowbPrec ''Last) +$(deriveShowPragmas defaultInlineShowbPrec ''WrappedMonoid) +$(deriveShowPragmas defaultInlineShowbPrec ''Option) +$(deriveShowPragmas defaultInlineShowbPrec ''Arg) + +instance Show1 Min where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) + +instance Show1 Max where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) + +instance Show1 First where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) + +instance Show1 Last where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) + +instance Show1 WrappedMonoid where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) + +instance Show1 Option where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) + +instance Show a => Show1 (Arg a) where + showbPrec1 = showbPrec + INLINE_INST_FUN(showbPrec1) diff --git a/src/Text/Show/Text/Data/String/UTF8.hs b/src/Text/Show/Text/Data/String/UTF8.hs --- a/src/Text/Show/Text/Data/String/UTF8.hs +++ b/src/Text/Show/Text/Data/String/UTF8.hs @@ -1,64 +1,64 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Data.String.UTF8 -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' function for 'UTF8' strings. - -/Since: 0.2/ --} -module Text.Show.Text.Data.String.UTF8 (showbUTF8, toBuilder, toBuilderGeneric) where - -import qualified Codec.Binary.UTF8.Generic as G (foldr) -import Codec.Binary.UTF8.Generic (UTF8Bytes) - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BL -#if !(MIN_VERSION_base(4,8,0)) -import Data.Monoid (mempty) -#endif -import Data.String.UTF8 (UTF8, toRep) -import Data.Word (Word8) - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showb), Builder) -import Text.Show.Text.Data.Text (showbBuilder) -import Text.Show.Text.Utils ((<>), s) - -#include "inline.h" - --- | Convert a 'UTF8' string to a 'Builder'. --- --- /Since: 0.2/ -showbUTF8 :: UTF8Bytes string index => UTF8 string -> Builder -showbUTF8 = showbBuilder . toBuilder -{-# INLINE showbUTF8 #-} - --- | Convert a 'UTF8'-encoded string to a 'Builder'. --- Invalid characters are replaced with '\xFFFD'. --- --- /Since: 0.2/ -toBuilder :: UTF8Bytes string index => UTF8 string -> Builder -toBuilder = toBuilderGeneric . toRep -{-# INLINE toBuilder #-} - --- | Convert a 'UTF8'-encoded bytestring to a 'Builder'. --- Invalid characters are replaced with '\xFFFD'. --- --- /Since: 0.2/ -toBuilderGeneric :: UTF8Bytes bytestring index => bytestring -> Builder -toBuilderGeneric = G.foldr ((<>) . s) mempty -{-# SPECIALIZE toBuilderGeneric :: BS.ByteString -> Builder #-} -{-# SPECIALIZE toBuilderGeneric :: BL.ByteString -> Builder #-} -{-# SPECIALIZE toBuilderGeneric :: [Word8] -> Builder #-} - -instance UTF8Bytes string index => Show (UTF8 string) where - showb = showbUTF8 - INLINE_INST_FUN(showb) +{-# LANGUAGE CPP #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Data.String.UTF8 +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' function for 'UTF8' strings. + +/Since: 0.2/ +-} +module Text.Show.Text.Data.String.UTF8 (showbUTF8, toBuilder, toBuilderGeneric) where + +import qualified Codec.Binary.UTF8.Generic as G (foldr) +import Codec.Binary.UTF8.Generic (UTF8Bytes) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +#if !(MIN_VERSION_base(4,8,0)) +import Data.Monoid (mempty) +#endif +import Data.String.UTF8 (UTF8, toRep) +import Data.Word (Word8) + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showb), Builder) +import Text.Show.Text.Data.Text (showbBuilder) +import Text.Show.Text.Utils ((<>), s) + +#include "inline.h" + +-- | Convert a 'UTF8' string to a 'Builder'. +-- +-- /Since: 0.2/ +showbUTF8 :: UTF8Bytes string index => UTF8 string -> Builder +showbUTF8 = showbBuilder . toBuilder +{-# INLINE showbUTF8 #-} + +-- | Convert a 'UTF8'-encoded string to a 'Builder'. +-- Invalid characters are replaced with '\xFFFD'. +-- +-- /Since: 0.2/ +toBuilder :: UTF8Bytes string index => UTF8 string -> Builder +toBuilder = toBuilderGeneric . toRep +{-# INLINE toBuilder #-} + +-- | Convert a 'UTF8'-encoded bytestring to a 'Builder'. +-- Invalid characters are replaced with '\xFFFD'. +-- +-- /Since: 0.2/ +toBuilderGeneric :: UTF8Bytes bytestring index => bytestring -> Builder +toBuilderGeneric = G.foldr ((<>) . s) mempty +{-# SPECIALIZE toBuilderGeneric :: BS.ByteString -> Builder #-} +{-# SPECIALIZE toBuilderGeneric :: BL.ByteString -> Builder #-} +{-# SPECIALIZE toBuilderGeneric :: [Word8] -> Builder #-} + +instance UTF8Bytes string index => Show (UTF8 string) where + showb = showbUTF8 + INLINE_INST_FUN(showb) diff --git a/src/Text/Show/Text/Data/Tagged.hs b/src/Text/Show/Text/Data/Tagged.hs --- a/src/Text/Show/Text/Data/Tagged.hs +++ b/src/Text/Show/Text/Data/Tagged.hs @@ -1,38 +1,38 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Data.Tagged -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' function for 'Tagged' values. - -/Since: 0.1/ --} -module Text.Show.Text.Data.Tagged (showbTaggedPrec) where - -import Data.Tagged (Tagged(..)) -import Prelude hiding (Show) -import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), - Builder, showbUnary) - -#include "inline.h" - --- | Convert a 'Tagged' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbTaggedPrec :: Show b => Int -> Tagged s b -> Builder -showbTaggedPrec p (Tagged b) = showbUnary "Tagged" p b -{-# INLINE showbTaggedPrec #-} - -instance Show b => Show (Tagged s b) where - showbPrec = showbTaggedPrec - INLINE_INST_FUN(showbPrec) - -instance Show1 (Tagged s) where - showbPrec1 = showbTaggedPrec - INLINE_INST_FUN(showbPrec1) +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Data.Tagged +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' function for 'Tagged' values. + +/Since: 0.1/ +-} +module Text.Show.Text.Data.Tagged (showbTaggedPrec) where + +import Data.Tagged (Tagged(..)) +import Prelude hiding (Show) +import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), + Builder, showbUnary) + +#include "inline.h" + +-- | Convert a 'Tagged' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbTaggedPrec :: Show b => Int -> Tagged s b -> Builder +showbTaggedPrec p (Tagged b) = showbUnary "Tagged" p b +{-# INLINE showbTaggedPrec #-} + +instance Show b => Show (Tagged s b) where + showbPrec = showbTaggedPrec + INLINE_INST_FUN(showbPrec) + +instance Show1 (Tagged s) where + showbPrec1 = showbTaggedPrec + INLINE_INST_FUN(showbPrec1) diff --git a/src/Text/Show/Text/Data/Time.hs b/src/Text/Show/Text/Data/Time.hs --- a/src/Text/Show/Text/Data/Time.hs +++ b/src/Text/Show/Text/Data/Time.hs @@ -1,233 +1,233 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -#if MIN_VERSION_time(1,5,0) -{-# LANGUAGE TemplateHaskell #-} -#endif -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Data.Time -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @time@ library. - -/Since: 0.1/ --} -module Text.Show.Text.Data.Time ( - showbDay - , showbDiffTime - , showbUTCTime - , showbNominalDiffTime - , showbAbsoluteTime - , showbTimeZone - , showbTimeOfDay - , showbLocalTime - , showbZonedTime -#if MIN_VERSION_time(1,5,0) - , showbTimeLocalePrec -#endif - ) where - -import Data.Fixed (Pico) -import Data.Semigroup (timesN) -import Data.Time.Calendar (Day, toGregorian) -import Data.Time.Clock (DiffTime, UTCTime, NominalDiffTime) -import Data.Time.Clock.TAI (AbsoluteTime, taiToUTCTime) -import Data.Time.Format (NumericPadOption) -import Data.Time.LocalTime (TimeZone(..), TimeOfDay(..), LocalTime(..), ZonedTime(..), - utc, utcToLocalTime, utcToZonedTime) - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showb), Builder, FromStringShow(..), - fromString, lengthB, showbSpace) -import Text.Show.Text.Data.Fixed (showbFixed) -import Text.Show.Text.Data.Integral () -import Text.Show.Text.Utils ((<>), s) - -#if MIN_VERSION_time(1,5,0) -import Data.Time.Format (TimeLocale) - -import Text.Show.Text (showbPrec) -import Text.Show.Text.TH (deriveShow) -#endif - -#include "inline.h" - --- | Convert a 'Day' into a 'Builder'. --- --- /Since: 0.1/ -showbDay :: Day -> Builder -showbDay = showbGregorian -{-# INLINE showbDay #-} - --- | Convert a 'DiffTime' into a 'Builder'. --- --- /Since: 0.1/ -showbDiffTime :: DiffTime -> Builder -showbDiffTime = showb . FromStringShow -{-# INLINE showbDiffTime #-} - --- | Convert a 'UTCTime' into a 'Builder'. --- --- /Since: 0.1/ -showbUTCTime :: UTCTime -> Builder -showbUTCTime = showb . utcToZonedTime utc -{-# INLINE showbUTCTime #-} - --- | Convert a 'NominalDiffTime' into a 'Builder'. --- --- /Since: 0.1/ -showbNominalDiffTime :: NominalDiffTime -> Builder -showbNominalDiffTime = showb . FromStringShow -{-# INLINE showbNominalDiffTime #-} - --- | Convert a 'AbsoluteTime' into a 'Builder'. --- --- /Since: 0.1/ -showbAbsoluteTime :: AbsoluteTime -> Builder -showbAbsoluteTime t = showbLocalTime (utcToLocalTime utc $ taiToUTCTime (const 0) t) - <> " TAI" -- ugly, but standard apparently -{-# INLINE showbAbsoluteTime #-} - --- | Convert a 'TimeZone' into a 'Builder'. --- --- /Since: 0.1/ -showbTimeZone :: TimeZone -> Builder -showbTimeZone zone@(TimeZone _ _ "") = timeZoneOffsetBuilder zone -showbTimeZone (TimeZone _ _ name) = fromString name -{-# INLINE showbTimeZone #-} - --- | Convert a 'TimeOfDay' into a 'Builder'. --- --- /Since: 0.1/ -showbTimeOfDay :: TimeOfDay -> Builder -showbTimeOfDay (TimeOfDay h m sec) = showb2 zeroOpt h - <> s ':' - <> showb2 zeroOpt m - <> s ':' - <> showb2Fixed zeroOpt sec -{-# INLINE showbTimeOfDay #-} - --- | Convert a 'LocalTime' into a 'Builder'. --- --- /Since: 0.1/ -showbLocalTime :: LocalTime -> Builder -showbLocalTime (LocalTime d t) = showbGregorian d <> showbSpace <> showb t -{-# INLINE showbLocalTime #-} - --- | Convert a 'ZonedTime' into a 'Builder'. --- --- /Since: 0.1/ -showbZonedTime :: ZonedTime -> Builder -showbZonedTime (ZonedTime t zone) = showb t <> showbSpace <> showb zone -{-# INLINE showbZonedTime #-} - -pad1 :: NumericPadOption -> Builder -> Builder -pad1 (Just c) b = s c <> b -pad1 _ b = b -{-# INLINE pad1 #-} - -padN :: Int -> Char -> Builder -> Builder -padN i _ b | i <= 0 = b -padN i c b = timesN (fromIntegral i) (s c) <> b -{-# INLINE padN #-} - -showb2 :: (Num t, Ord t, Show t) => NumericPadOption -> t -> Builder -showb2 = showbPaddedMin 2 -{-# INLINE showb2 #-} - -showb2Fixed :: NumericPadOption -> Pico -> Builder -showb2Fixed opt x | x < 10 = pad1 opt $ showbFixed True x -showb2Fixed _ x = showbFixed True x -{-# INLINE showb2Fixed #-} - -showb4 :: (Num t, Ord t, Show t) => NumericPadOption -> t -> Builder -showb4 = showbPaddedMin 4 -{-# INLINE showb4 #-} - -showbGregorian :: Day -> Builder -showbGregorian date = showb4 zeroOpt y - <> s '-' - <> showb2 zeroOpt m - <> s '-' - <> showb2 zeroOpt d - where - (y,m,d) = toGregorian date - -showbPaddedMin :: (Num t, Ord t, Show t) => Int -> NumericPadOption -> t -> Builder -showbPaddedMin _ Nothing i = showb i -showbPaddedMin pl opt i | i < 0 = s '-' <> showbPaddedMin pl opt (negate i) -showbPaddedMin pl (Just c) i = - let b = showb i - in padN (pl - fromIntegral (lengthB b)) c b - -showbT :: NumericPadOption -> Int -> Builder -showbT opt t = showb4 opt ((div t 60) * 100 + (mod t 60)) -{-# INLINE showbT #-} - -timeZoneOffsetBuilder' :: NumericPadOption -> TimeZone -> Builder -timeZoneOffsetBuilder' opt (TimeZone t _ _) | t < 0 = s '-' <> showbT opt (negate t) -timeZoneOffsetBuilder' opt (TimeZone t _ _) = s '+' <> showbT opt t -{-# INLINE timeZoneOffsetBuilder' #-} - -timeZoneOffsetBuilder :: TimeZone -> Builder -timeZoneOffsetBuilder = timeZoneOffsetBuilder' $ Just '0' -{-# INLINE timeZoneOffsetBuilder #-} - -zeroOpt :: NumericPadOption -zeroOpt = Just '0' -{-# INLINE zeroOpt #-} - -#if MIN_VERSION_time(1,5,0) --- | Convert a 'TimeLocale' to a 'Builder' with the given precedence. This function is --- available with @time-1.5@ or later. --- --- /Since: 0.2/ -showbTimeLocalePrec :: Int -> TimeLocale -> Builder -showbTimeLocalePrec = showbPrec -{-# INLINE showbTimeLocalePrec #-} -#endif - -instance Show Day where - showb = showbDay - INLINE_INST_FUN(showb) - -instance Show DiffTime where - showb = showbDiffTime - INLINE_INST_FUN(showb) - -instance Show UTCTime where - showb = showbUTCTime - INLINE_INST_FUN(showb) - -instance Show NominalDiffTime where - showb = showbNominalDiffTime - INLINE_INST_FUN(showb) - -instance Show AbsoluteTime where - showb = showbAbsoluteTime - INLINE_INST_FUN(showb) - -instance Show TimeZone where - showb = showbTimeZone - INLINE_INST_FUN(showb) - -instance Show TimeOfDay where - showb = showbTimeOfDay - INLINE_INST_FUN(showb) - -instance Show LocalTime where - showb = showbLocalTime - INLINE_INST_FUN(showb) - -instance Show ZonedTime where - showb = showbZonedTime - INLINE_INST_FUN(showb) - -#if MIN_VERSION_time(1,5,0) -$(deriveShow ''TimeLocale) -#endif +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +#if MIN_VERSION_time(1,5,0) +{-# LANGUAGE TemplateHaskell #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Data.Time +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @time@ library. + +/Since: 0.1/ +-} +module Text.Show.Text.Data.Time ( + showbDay + , showbDiffTime + , showbUTCTime + , showbNominalDiffTime + , showbAbsoluteTime + , showbTimeZone + , showbTimeOfDay + , showbLocalTime + , showbZonedTime +#if MIN_VERSION_time(1,5,0) + , showbTimeLocalePrec +#endif + ) where + +import Data.Fixed (Pico) +import Data.Semigroup (timesN) +import Data.Time.Calendar (Day, toGregorian) +import Data.Time.Clock (DiffTime, UTCTime, NominalDiffTime) +import Data.Time.Clock.TAI (AbsoluteTime, taiToUTCTime) +import Data.Time.Format (NumericPadOption) +import Data.Time.LocalTime (TimeZone(..), TimeOfDay(..), LocalTime(..), ZonedTime(..), + utc, utcToLocalTime, utcToZonedTime) + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showb), Builder, FromStringShow(..), + fromString, lengthB, showbSpace) +import Text.Show.Text.Data.Fixed (showbFixed) +import Text.Show.Text.Data.Integral () +import Text.Show.Text.Utils ((<>), s) + +#if MIN_VERSION_time(1,5,0) +import Data.Time.Format (TimeLocale) + +import Text.Show.Text (showbPrec) +import Text.Show.Text.TH (deriveShow) +#endif + +#include "inline.h" + +-- | Convert a 'Day' into a 'Builder'. +-- +-- /Since: 0.1/ +showbDay :: Day -> Builder +showbDay = showbGregorian +{-# INLINE showbDay #-} + +-- | Convert a 'DiffTime' into a 'Builder'. +-- +-- /Since: 0.1/ +showbDiffTime :: DiffTime -> Builder +showbDiffTime = showb . FromStringShow +{-# INLINE showbDiffTime #-} + +-- | Convert a 'UTCTime' into a 'Builder'. +-- +-- /Since: 0.1/ +showbUTCTime :: UTCTime -> Builder +showbUTCTime = showb . utcToZonedTime utc +{-# INLINE showbUTCTime #-} + +-- | Convert a 'NominalDiffTime' into a 'Builder'. +-- +-- /Since: 0.1/ +showbNominalDiffTime :: NominalDiffTime -> Builder +showbNominalDiffTime = showb . FromStringShow +{-# INLINE showbNominalDiffTime #-} + +-- | Convert a 'AbsoluteTime' into a 'Builder'. +-- +-- /Since: 0.1/ +showbAbsoluteTime :: AbsoluteTime -> Builder +showbAbsoluteTime t = showbLocalTime (utcToLocalTime utc $ taiToUTCTime (const 0) t) + <> " TAI" -- ugly, but standard apparently +{-# INLINE showbAbsoluteTime #-} + +-- | Convert a 'TimeZone' into a 'Builder'. +-- +-- /Since: 0.1/ +showbTimeZone :: TimeZone -> Builder +showbTimeZone zone@(TimeZone _ _ "") = timeZoneOffsetBuilder zone +showbTimeZone (TimeZone _ _ name) = fromString name +{-# INLINE showbTimeZone #-} + +-- | Convert a 'TimeOfDay' into a 'Builder'. +-- +-- /Since: 0.1/ +showbTimeOfDay :: TimeOfDay -> Builder +showbTimeOfDay (TimeOfDay h m sec) = showb2 zeroOpt h + <> s ':' + <> showb2 zeroOpt m + <> s ':' + <> showb2Fixed zeroOpt sec +{-# INLINE showbTimeOfDay #-} + +-- | Convert a 'LocalTime' into a 'Builder'. +-- +-- /Since: 0.1/ +showbLocalTime :: LocalTime -> Builder +showbLocalTime (LocalTime d t) = showbGregorian d <> showbSpace <> showb t +{-# INLINE showbLocalTime #-} + +-- | Convert a 'ZonedTime' into a 'Builder'. +-- +-- /Since: 0.1/ +showbZonedTime :: ZonedTime -> Builder +showbZonedTime (ZonedTime t zone) = showb t <> showbSpace <> showb zone +{-# INLINE showbZonedTime #-} + +pad1 :: NumericPadOption -> Builder -> Builder +pad1 (Just c) b = s c <> b +pad1 _ b = b +{-# INLINE pad1 #-} + +padN :: Int -> Char -> Builder -> Builder +padN i _ b | i <= 0 = b +padN i c b = timesN (fromIntegral i) (s c) <> b +{-# INLINE padN #-} + +showb2 :: (Num t, Ord t, Show t) => NumericPadOption -> t -> Builder +showb2 = showbPaddedMin 2 +{-# INLINE showb2 #-} + +showb2Fixed :: NumericPadOption -> Pico -> Builder +showb2Fixed opt x | x < 10 = pad1 opt $ showbFixed True x +showb2Fixed _ x = showbFixed True x +{-# INLINE showb2Fixed #-} + +showb4 :: (Num t, Ord t, Show t) => NumericPadOption -> t -> Builder +showb4 = showbPaddedMin 4 +{-# INLINE showb4 #-} + +showbGregorian :: Day -> Builder +showbGregorian date = showb4 zeroOpt y + <> s '-' + <> showb2 zeroOpt m + <> s '-' + <> showb2 zeroOpt d + where + (y,m,d) = toGregorian date + +showbPaddedMin :: (Num t, Ord t, Show t) => Int -> NumericPadOption -> t -> Builder +showbPaddedMin _ Nothing i = showb i +showbPaddedMin pl opt i | i < 0 = s '-' <> showbPaddedMin pl opt (negate i) +showbPaddedMin pl (Just c) i = + let b = showb i + in padN (pl - fromIntegral (lengthB b)) c b + +showbT :: NumericPadOption -> Int -> Builder +showbT opt t = showb4 opt ((div t 60) * 100 + (mod t 60)) +{-# INLINE showbT #-} + +timeZoneOffsetBuilder' :: NumericPadOption -> TimeZone -> Builder +timeZoneOffsetBuilder' opt (TimeZone t _ _) | t < 0 = s '-' <> showbT opt (negate t) +timeZoneOffsetBuilder' opt (TimeZone t _ _) = s '+' <> showbT opt t +{-# INLINE timeZoneOffsetBuilder' #-} + +timeZoneOffsetBuilder :: TimeZone -> Builder +timeZoneOffsetBuilder = timeZoneOffsetBuilder' $ Just '0' +{-# INLINE timeZoneOffsetBuilder #-} + +zeroOpt :: NumericPadOption +zeroOpt = Just '0' +{-# INLINE zeroOpt #-} + +#if MIN_VERSION_time(1,5,0) +-- | Convert a 'TimeLocale' to a 'Builder' with the given precedence. This function is +-- available with @time-1.5@ or later. +-- +-- /Since: 0.2/ +showbTimeLocalePrec :: Int -> TimeLocale -> Builder +showbTimeLocalePrec = showbPrec +{-# INLINE showbTimeLocalePrec #-} +#endif + +instance Show Day where + showb = showbDay + INLINE_INST_FUN(showb) + +instance Show DiffTime where + showb = showbDiffTime + INLINE_INST_FUN(showb) + +instance Show UTCTime where + showb = showbUTCTime + INLINE_INST_FUN(showb) + +instance Show NominalDiffTime where + showb = showbNominalDiffTime + INLINE_INST_FUN(showb) + +instance Show AbsoluteTime where + showb = showbAbsoluteTime + INLINE_INST_FUN(showb) + +instance Show TimeZone where + showb = showbTimeZone + INLINE_INST_FUN(showb) + +instance Show TimeOfDay where + showb = showbTimeOfDay + INLINE_INST_FUN(showb) + +instance Show LocalTime where + showb = showbLocalTime + INLINE_INST_FUN(showb) + +instance Show ZonedTime where + showb = showbZonedTime + INLINE_INST_FUN(showb) + +#if MIN_VERSION_time(1,5,0) +$(deriveShow ''TimeLocale) +#endif diff --git a/src/Text/Show/Text/Data/UnorderedContainers.hs b/src/Text/Show/Text/Data/UnorderedContainers.hs --- a/src/Text/Show/Text/Data/UnorderedContainers.hs +++ b/src/Text/Show/Text/Data/UnorderedContainers.hs @@ -1,57 +1,57 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Data.UnorderedContainers -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for 'HashMap's and 'HashSet's. - -/Since: 0.1/ --} -module Text.Show.Text.Data.UnorderedContainers (showbHashMapPrec, showbHashSetPrec) where - -import qualified Data.HashMap.Lazy as HM (toList) -import Data.HashMap.Lazy (HashMap) -import qualified Data.HashSet as HS (toList) -import Data.HashSet (HashSet) - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder) -import Text.Show.Text.Utils (showbUnaryList) - -#include "inline.h" - --- | Convert a 'HashMap' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbHashMapPrec :: (Show k, Show v) => Int -> HashMap k v -> Builder -showbHashMapPrec p = showbUnaryList p . HM.toList -{-# INLINE showbHashMapPrec #-} - --- | Convert a 'HashSet' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbHashSetPrec :: Show a => Int -> HashSet a -> Builder -showbHashSetPrec p = showbUnaryList p . HS.toList -{-# INLINE showbHashSetPrec #-} - -instance (Show k, Show v) => Show (HashMap k v) where - showbPrec = showbHashMapPrec - INLINE_INST_FUN(showbPrec) - -instance Show a => Show (HashSet a) where - showbPrec = showbHashSetPrec - INLINE_INST_FUN(showbPrec) - -instance Show k => Show1 (HashMap k) where - showbPrec1 = showbHashMapPrec - INLINE_INST_FUN(showbPrec1) - -instance Show1 HashSet where - showbPrec1 = showbHashSetPrec +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Data.UnorderedContainers +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for 'HashMap's and 'HashSet's. + +/Since: 0.1/ +-} +module Text.Show.Text.Data.UnorderedContainers (showbHashMapPrec, showbHashSetPrec) where + +import qualified Data.HashMap.Lazy as HM (toList) +import Data.HashMap.Lazy (HashMap) +import qualified Data.HashSet as HS (toList) +import Data.HashSet (HashSet) + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder) +import Text.Show.Text.Utils (showbUnaryList) + +#include "inline.h" + +-- | Convert a 'HashMap' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbHashMapPrec :: (Show k, Show v) => Int -> HashMap k v -> Builder +showbHashMapPrec p = showbUnaryList p . HM.toList +{-# INLINE showbHashMapPrec #-} + +-- | Convert a 'HashSet' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbHashSetPrec :: Show a => Int -> HashSet a -> Builder +showbHashSetPrec p = showbUnaryList p . HS.toList +{-# INLINE showbHashSetPrec #-} + +instance (Show k, Show v) => Show (HashMap k v) where + showbPrec = showbHashMapPrec + INLINE_INST_FUN(showbPrec) + +instance Show a => Show (HashSet a) where + showbPrec = showbHashSetPrec + INLINE_INST_FUN(showbPrec) + +instance Show k => Show1 (HashMap k) where + showbPrec1 = showbHashMapPrec + INLINE_INST_FUN(showbPrec1) + +instance Show1 HashSet where + showbPrec1 = showbHashSetPrec INLINE_INST_FUN(showbPrec1) diff --git a/src/Text/Show/Text/Data/Vector.hs b/src/Text/Show/Text/Data/Vector.hs --- a/src/Text/Show/Text/Data/Vector.hs +++ b/src/Text/Show/Text/Data/Vector.hs @@ -1,107 +1,107 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Data.Vector -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for @Vector@ types. - -/Since: 0.1/ --} -module Text.Show.Text.Data.Vector ( - showbVectorPrec - , showbVectorGenericPrec - , showbVectorPrimitivePrec - , showbVectorStorablePrec - , showbVectorUnboxedPrec - , showbSizePrec - ) where - -import qualified Data.Vector as B (Vector) -import Data.Vector.Fusion.Stream.Size (Size) -import qualified Data.Vector.Generic as G (Vector) -import Data.Vector.Generic (toList) -import qualified Data.Vector.Primitive as P (Vector) -import Data.Vector.Primitive (Prim) -import qualified Data.Vector.Storable as S (Vector) -import qualified Data.Vector.Unboxed as U (Vector) -import Data.Vector.Unboxed (Unbox) - -import Foreign.Storable (Storable) - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder) -import Text.Show.Text.TH (deriveShow) -import Text.Show.Text.Utils (showbUnaryList) - -#include "inline.h" - --- | Convert a boxed 'B.Vector' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbVectorPrec :: Show a => Int -> B.Vector a -> Builder -showbVectorPrec = showbVectorGenericPrec -{-# INLINE showbVectorPrec #-} - --- | Convert a generic 'G.Vector' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbVectorGenericPrec :: (G.Vector v a, Show a) => Int -> v a -> Builder -showbVectorGenericPrec p = showbUnaryList p . toList -{-# INLINE showbVectorGenericPrec #-} - --- | Convert a primitive 'P.Vector' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbVectorPrimitivePrec :: (Show a, Prim a) => Int -> P.Vector a -> Builder -showbVectorPrimitivePrec = showbVectorGenericPrec -{-# INLINE showbVectorPrimitivePrec #-} - --- | Convert a storable 'S.Vector' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbVectorStorablePrec :: (Show a, Storable a) => Int -> S.Vector a -> Builder -showbVectorStorablePrec = showbVectorGenericPrec -{-# INLINE showbVectorStorablePrec #-} - --- | Convert an unboxed 'U.Vector' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbVectorUnboxedPrec :: (Show a, Unbox a) => Int -> U.Vector a -> Builder -showbVectorUnboxedPrec = showbVectorGenericPrec -{-# INLINE showbVectorUnboxedPrec #-} - --- | Convert a 'Size' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbSizePrec :: Int -> Size -> Builder -showbSizePrec = showbPrec -{-# INLINE showbSizePrec #-} - -instance Show a => Show (B.Vector a) where - showbPrec = showbVectorPrec - INLINE_INST_FUN(showbPrec) - -instance (Show a, Prim a) => Show (P.Vector a) where - showbPrec = showbVectorPrimitivePrec - INLINE_INST_FUN(showbPrec) - -instance (Show a, Storable a) => Show (S.Vector a) where - showbPrec = showbVectorStorablePrec - INLINE_INST_FUN(showbPrec) - -instance (Show a, Unbox a) => Show (U.Vector a) where - showbPrec = showbVectorUnboxedPrec - INLINE_INST_FUN(showbPrec) - -instance Show1 B.Vector where - showbPrec1 = showbVectorPrec - INLINE_INST_FUN(showbPrec1) - -$(deriveShow ''Size) +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Data.Vector +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for @Vector@ types. + +/Since: 0.1/ +-} +module Text.Show.Text.Data.Vector ( + showbVectorPrec + , showbVectorGenericPrec + , showbVectorPrimitivePrec + , showbVectorStorablePrec + , showbVectorUnboxedPrec + , showbSizePrec + ) where + +import qualified Data.Vector as B (Vector) +import Data.Vector.Fusion.Stream.Size (Size) +import qualified Data.Vector.Generic as G (Vector) +import Data.Vector.Generic (toList) +import qualified Data.Vector.Primitive as P (Vector) +import Data.Vector.Primitive (Prim) +import qualified Data.Vector.Storable as S (Vector) +import qualified Data.Vector.Unboxed as U (Vector) +import Data.Vector.Unboxed (Unbox) + +import Foreign.Storable (Storable) + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showbPrec), Show1(showbPrec1), Builder) +import Text.Show.Text.TH (deriveShow) +import Text.Show.Text.Utils (showbUnaryList) + +#include "inline.h" + +-- | Convert a boxed 'B.Vector' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbVectorPrec :: Show a => Int -> B.Vector a -> Builder +showbVectorPrec = showbVectorGenericPrec +{-# INLINE showbVectorPrec #-} + +-- | Convert a generic 'G.Vector' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbVectorGenericPrec :: (G.Vector v a, Show a) => Int -> v a -> Builder +showbVectorGenericPrec p = showbUnaryList p . toList +{-# INLINE showbVectorGenericPrec #-} + +-- | Convert a primitive 'P.Vector' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbVectorPrimitivePrec :: (Show a, Prim a) => Int -> P.Vector a -> Builder +showbVectorPrimitivePrec = showbVectorGenericPrec +{-# INLINE showbVectorPrimitivePrec #-} + +-- | Convert a storable 'S.Vector' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbVectorStorablePrec :: (Show a, Storable a) => Int -> S.Vector a -> Builder +showbVectorStorablePrec = showbVectorGenericPrec +{-# INLINE showbVectorStorablePrec #-} + +-- | Convert an unboxed 'U.Vector' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbVectorUnboxedPrec :: (Show a, Unbox a) => Int -> U.Vector a -> Builder +showbVectorUnboxedPrec = showbVectorGenericPrec +{-# INLINE showbVectorUnboxedPrec #-} + +-- | Convert a 'Size' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbSizePrec :: Int -> Size -> Builder +showbSizePrec = showbPrec +{-# INLINE showbSizePrec #-} + +instance Show a => Show (B.Vector a) where + showbPrec = showbVectorPrec + INLINE_INST_FUN(showbPrec) + +instance (Show a, Prim a) => Show (P.Vector a) where + showbPrec = showbVectorPrimitivePrec + INLINE_INST_FUN(showbPrec) + +instance (Show a, Storable a) => Show (S.Vector a) where + showbPrec = showbVectorStorablePrec + INLINE_INST_FUN(showbPrec) + +instance (Show a, Unbox a) => Show (U.Vector a) where + showbPrec = showbVectorUnboxedPrec + INLINE_INST_FUN(showbPrec) + +instance Show1 B.Vector where + showbPrec1 = showbVectorPrec + INLINE_INST_FUN(showbPrec1) + +$(deriveShow ''Size) diff --git a/src/Text/Show/Text/Instances.hs b/src/Text/Show/Text/Instances.hs --- a/src/Text/Show/Text/Instances.hs +++ b/src/Text/Show/Text/Instances.hs @@ -1,20 +1,20 @@ -{-| -Module: Text.Show.Text.Instances -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Additional @Show@ instances not provided by @text-show@. - -/Since: 0.1/ --} -module Text.Show.Text.Instances () where - -import Text.Show.Text.Compiler () -import Text.Show.Text.Data () -import Text.Show.Text.Language () -import Text.Show.Text.System () -import Text.Show.Text.Text () +{-| +Module: Text.Show.Text.Instances +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Additional @Show@ instances not provided by @text-show@. + +/Since: 0.1/ +-} +module Text.Show.Text.Instances () where + +import Text.Show.Text.Compiler () +import Text.Show.Text.Data () +import Text.Show.Text.Language () +import Text.Show.Text.System () +import Text.Show.Text.Text () import Text.Show.Text.Trace () diff --git a/src/Text/Show/Text/Language.hs b/src/Text/Show/Text/Language.hs --- a/src/Text/Show/Text/Language.hs +++ b/src/Text/Show/Text/Language.hs @@ -1,13 +1,13 @@ -{-| -Module: Text.Show.Text.Language -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Imports 'Show' instances for @Language@ modules. --} -module Text.Show.Text.Language () where - +{-| +Module: Text.Show.Text.Language +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Imports 'Show' instances for @Language@ modules. +-} +module Text.Show.Text.Language () where + import Text.Show.Text.Language.Haskell.TH () diff --git a/src/Text/Show/Text/Language/Haskell/TH.hs b/src/Text/Show/Text/Language/Haskell/TH.hs --- a/src/Text/Show/Text/Language/Haskell/TH.hs +++ b/src/Text/Show/Text/Language/Haskell/TH.hs @@ -1,517 +1,517 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeSynonymInstances #-} -#if !(MIN_VERSION_template_haskell(2,10,0)) -{-# LANGUAGE MagicHash #-} -#endif -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Language.Haskell.TH -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @template-haskell@ library. - -/Since: 0.1/ --} -module Text.Show.Text.Language.Haskell.TH ( -#if MIN_VERSION_template_haskell(2,9,0) - showbAnnLookupPrec - , showbAnnTargetPrec, -#endif - showbBodyPrec - , showbCallconv -#if MIN_VERSION_template_haskell(2,5,0) && !(MIN_VERSION_template_haskell(2,7,0)) - , showbClassInstancePrec -#endif - , showbClausePrec - , showbConPrec - , showbDecPrec - , showbExpPrec - , showbFamFlavour - , showbFixityPrec - , showbFixityDirection - , showbForeignPrec - , showbFunDepPrec - , showbGuardPrec - , showbInfoPrec -#if MIN_VERSION_template_haskell(2,8,0) - , showbInline -#else - , showbInlineSpecPrec -#endif - , showbKindPrec - , showbLitPrec - , showbLocPrec - , showbMatchPrec - , showbModNamePrec -#if MIN_VERSION_template_haskell(2,9,0) - , showbModulePrec - , showbModuleInfoPrec -#endif - , showbName - , showbName' - , showbOccNamePrec - , showbPatPrec -#if MIN_VERSION_template_haskell(2,8,0) - , showbPhasesPrec -#endif - , showbPkgNamePrec - , showbPragmaPrec - , showbPredPrec - , showbRangePrec -#if MIN_VERSION_template_haskell(2,9,0) - , showbRole -#endif -#if MIN_VERSION_template_haskell(2,8,0) - , showbRuleBndrPrec - , showbRuleMatch -#endif - , showbSafety - , showbStmtPrec - , showbStrict -#if MIN_VERSION_template_haskell(2,8,0) - , showbTyLitPrec -#endif - , showbTypePrec - , showbTyVarBndrPrec -#if MIN_VERSION_template_haskell(2,9,0) - , showbTySynEqnPrec -#endif - , showbDoc - ) where - -import Data.Char (isAlpha) -import Data.Maybe (fromJust) -import qualified Data.Text.Lazy as TL (Text, dropWhile, null, tail) -import Data.Text.Lazy (uncons) - -#if !(MIN_VERSION_template_haskell(2,10,0)) -import GHC.Exts (Int(I#)) -#endif - -import Language.Haskell.TH.PprLib (Doc, to_HPJ_Doc) -import Language.Haskell.TH.Syntax - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showb, showbPrec), Builder, - fromString, toLazyText) -import Text.Show.Text.Data.Integral (showbIntPrec) -import Text.Show.Text.Text.PrettyPrint (renderB) -import Text.Show.Text.TH (deriveShow) -import Text.Show.Text.Utils ((<>), s) - --- | Convert a 'Body' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbBodyPrec :: Int -> Body -> Builder -showbBodyPrec = showbPrec - --- | Convert a 'Callconv' to a 'Builder'. --- --- /Since: 0.1/ -showbCallconv :: Callconv -> Builder -showbCallconv = showb - --- | Convert a 'Clause' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbClausePrec :: Int -> Clause -> Builder -showbClausePrec = showbPrec - --- | Convert a 'Con' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbConPrec :: Int -> Con -> Builder -showbConPrec = showbPrec - --- | Convert a 'Dec' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbDecPrec :: Int -> Dec -> Builder -showbDecPrec = showbPrec - --- | Convert an 'Exp' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbExpPrec :: Int -> Exp -> Builder -showbExpPrec = showbPrec - --- | Convert a 'FamFlavour' to a 'Builder'. --- --- /Since: 0.1/ -showbFamFlavour :: FamFlavour -> Builder -showbFamFlavour = showb - --- | Convert a 'Fixity' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbFixityPrec :: Int -> Fixity -> Builder -showbFixityPrec = showbPrec - --- | Convert a 'FixityDirection' to a 'Builder'. --- --- /Since: 0.1/ -showbFixityDirection :: FixityDirection -> Builder -showbFixityDirection = showb - --- | Convert a 'Foreign' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbForeignPrec :: Int -> Foreign -> Builder -showbForeignPrec = showbPrec - --- | Convert a 'FunDep' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbFunDepPrec :: Int -> FunDep -> Builder -showbFunDepPrec = showbPrec - --- | Convert a 'Guard' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbGuardPrec :: Int -> Guard -> Builder -showbGuardPrec = showbPrec - --- | Convert an 'Info' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbInfoPrec :: Int -> Info -> Builder -showbInfoPrec = showbPrec - --- | Convert a 'Kind' to a 'Builder' with the given precedence. --- --- /Since: 0.2/ -showbKindPrec :: Int -> Kind -> Builder -#if MIN_VERSION_template_haskell(2,8,0) -showbKindPrec = showbTypePrec -#else -showbKindPrec = showbPrec -#endif - --- | Convert a 'Lit' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbLitPrec :: Int -> Dec -> Builder -showbLitPrec = showbPrec - --- | Convert a 'Loc' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbLocPrec :: Int -> Loc -> Builder -showbLocPrec = showbPrec - --- | Convert a 'Match' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbMatchPrec :: Int -> Match -> Builder -showbMatchPrec = showbPrec - --- | Convert a 'ModName' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbModNamePrec :: Int -> ModName -> Builder -showbModNamePrec = showbPrec - --- | Convert a 'Name' to a 'Builder'. --- --- /Since: 0.1/ -showbName :: Name -> Builder -showbName = showbName' Alone - --- | Convert a 'Name' to a 'Builder' with the given 'NameIs' settings. --- --- /Since: 0.1/ -showbName' :: NameIs -> Name -> Builder -showbName' ni nm = case ni of - Alone -> nms - Applied - | pnam -> nms - | otherwise -> s '(' <> nms <> s ')' - Infix - | pnam -> s '`' <> nms <> s '`' - | otherwise -> nms - where - -- For now, we make the NameQ and NameG print the same, even though - -- NameQ is a qualified name (so what it means depends on what the - -- current scope is), and NameG is an original name (so its meaning - -- should be independent of what's in scope. - -- We may well want to distinguish them in the end. - -- Ditto NameU and NameL - nms :: Builder - nms = case nm of - Name occ NameS -> occB occ - Name occ (NameQ m) -> modB m <> s '.' <> occB occ - Name occ (NameG _ _ m) -> modB m <> s '.' <> occB occ - Name occ (NameU u) -> occB occ <> s '_' <> showbIntPrec 0 (mkInt u) - Name occ (NameL u) -> occB occ <> s '_' <> showbIntPrec 0 (mkInt u) - -#if MIN_VERSION_template_haskell(2,10,0) - mkInt = id -#else - mkInt i# = I# i# -#endif - - occB :: OccName -> Builder - occB = fromString . occString - - modB :: ModName -> Builder - modB = fromString . modString - - pnam :: Bool - pnam = classify $ toLazyText nms - - -- True if we are function style, e.g. f, [], (,) - -- False if we are operator style, e.g. +, :+ - classify :: TL.Text -> Bool - classify t - | TL.null t = False -- shouldn't happen; . operator is handled below - | otherwise = case fromJust $ uncons t of - (x, xs) -> if isAlpha x || (x `elem` "_[]()") - then let t' = TL.dropWhile (/= '.') xs - in if TL.null t' - then True - else classify $ TL.tail t' - else False - - --- | Convert an 'OccName' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbOccNamePrec :: Int -> OccName -> Builder -showbOccNamePrec = showbPrec - --- | Convert a 'Pat' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbPatPrec :: Int -> Pat -> Builder -showbPatPrec = showbPrec - --- | Convert a 'PkgName' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbPkgNamePrec :: Int -> PkgName -> Builder -showbPkgNamePrec = showbPrec - --- | Convert a 'Pragma' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbPragmaPrec :: Int -> Pragma -> Builder -showbPragmaPrec = showbPrec - --- | Convert a 'Pred' to a 'Builder' with the given precedence. --- --- /Since: 0.2/ -showbPredPrec :: Int -> Pred -> Builder -#if MIN_VERSION_template_haskell(2,10,0) -showbPredPrec = showbTypePrec -#else -showbPredPrec = showbPrec -#endif - --- | Convert a 'Range' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbRangePrec :: Int -> Range -> Builder -showbRangePrec = showbPrec - --- | Convert a 'Safety' to a 'Builder'. --- --- /Since: 0.1/ -showbSafety :: Safety -> Builder -showbSafety = showb - --- | Convert a 'Stmt' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbStmtPrec :: Int -> Stmt -> Builder -showbStmtPrec = showbPrec - --- | Convert a 'Strict' to a 'Builder'. --- --- /Since: 0.1/ -showbStrict :: Strict -> Builder -showbStrict = showb - --- | Convert a 'Type' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbTypePrec :: Int -> Type -> Builder -showbTypePrec = showbPrec - --- | Convert a 'TyVarBndr' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbTyVarBndrPrec :: Int -> TyVarBndr -> Builder -showbTyVarBndrPrec = showbPrec - --- | Convert a 'Doc' to a 'Builder'. --- --- /Since: 0.3/ -showbDoc :: Doc -> Builder -showbDoc = renderB . to_HPJ_Doc - -#if MIN_VERSION_template_haskell(2,5,0) && !(MIN_VERSION_template_haskell(2,7,0)) --- | Convert a 'ClassInstance' to a 'Builder' with the given precedence. --- This function is only available with @template-haskell@ 2.5.0.0 or 2.6.0.0. --- --- /Since: 0.1/ -showbClassInstancePrec :: Int -> ClassInstance -> Builder -showbClassInstancePrec = showbPrec -#endif - -#if MIN_VERSION_template_haskell(2,8,0) --- | Convert an 'Inline' to a 'Builder'. --- This function is only available with @template-haskell-2.8.0.0@ or later. --- --- /Since: 0.1/ -showbInline :: Inline -> Builder -showbInline = showb - --- | Convert a 'Phases' to a 'Builder' with the given precedence. --- This function is only available with @template-haskell-2.8.0.0@ or later. --- --- /Since: 0.1/ -showbPhasesPrec :: Int -> Phases -> Builder -showbPhasesPrec = showbPrec - --- | Convert a 'RuleMatch' to a 'Builder'. --- This function is only available with @template-haskell-2.8.0.0@ or later. --- --- /Since: 0.1/ -showbRuleMatch :: RuleMatch -> Builder -showbRuleMatch = showb - --- | Convert a 'RuleBndr' to a 'Builder' with the given precedence. --- This function is only available with @template-haskell-2.8.0.0@ or later. --- --- /Since: 0.1/ -showbRuleBndrPrec :: Int -> RuleBndr -> Builder -showbRuleBndrPrec = showbPrec - --- | Convert a 'TyLit' to a 'Builder' with the given precedence. --- This function is only available with @template-haskell-2.8.0.0@ or later. --- --- /Since: 0.1/ -showbTyLitPrec :: Int -> TyLit -> Builder -showbTyLitPrec = showbPrec -#else --- | Convert an 'InlineSpec' to a 'Builder' with the given precedence. --- This function is only available with @template-haskell-2.7.0.0@ or earlier. --- --- /Since: 0.1/ -showbInlineSpecPrec :: Int -> InlineSpec -> Builder -showbInlineSpecPrec = showbPrec -#endif - -#if MIN_VERSION_template_haskell(2,9,0) --- | Convert an 'AnnLookup' to a 'Builder' with the given precedence. --- This function is only available with @template-haskell-2.9.0.0@ or later. --- --- /Since: 0.1/ -showbAnnLookupPrec :: Int -> AnnLookup -> Builder -showbAnnLookupPrec = showbPrec - --- | Convert an 'AnnTarget' to a 'Builder' with the given precedence. --- This function is only available with @template-haskell-2.9.0.0@ or later. --- --- /Since: 0.1/ -showbAnnTargetPrec :: Int -> AnnTarget -> Builder -showbAnnTargetPrec = showbPrec - --- | Convert a 'Module' to a 'Builder' with the given precedence. --- This function is only available with @template-haskell-2.9.0.0@ or later. --- --- /Since: 0.1/ -showbModulePrec :: Int -> Module -> Builder -showbModulePrec = showbPrec - --- | Convert a 'ModuleInfo' to a 'Builder' with the given precedence. --- This function is only available with @template-haskell-2.9.0.0@ or later. --- --- /Since: 0.1/ -showbModuleInfoPrec :: Int -> ModuleInfo -> Builder -showbModuleInfoPrec = showbPrec - --- | Convert a 'Role' to a 'Builder'. --- This function is only available with @template-haskell-2.9.0.0@ or later. --- --- /Since: 0.1/ -showbRole :: Role -> Builder -showbRole = showb - --- | Convert a 'TySynEqn' to a 'Builder' with the given precedence. --- This function is only available with @template-haskell-2.9.0.0@ or later. --- --- /Since: 0.1/ -showbTySynEqnPrec :: Int -> TySynEqn -> Builder -showbTySynEqnPrec = showbPrec -#endif - -$(deriveShow ''Body) -$(deriveShow ''Callconv) -$(deriveShow ''Clause) -$(deriveShow ''Con) -$(deriveShow ''Dec) -$(deriveShow ''Exp) -$(deriveShow ''FamFlavour) -$(deriveShow ''Fixity) -$(deriveShow ''FixityDirection) -$(deriveShow ''Foreign) -$(deriveShow ''FunDep) -$(deriveShow ''Guard) -$(deriveShow ''Info) -$(deriveShow ''Lit) -$(deriveShow ''Loc) -$(deriveShow ''Match) -$(deriveShow ''ModName) - -instance Show Name where - showb = showbName - -$(deriveShow ''OccName) -$(deriveShow ''Pat) -$(deriveShow ''PkgName) -$(deriveShow ''Pragma) -$(deriveShow ''Range) -$(deriveShow ''Safety) -$(deriveShow ''Stmt) -$(deriveShow ''Strict) -$(deriveShow ''Type) -$(deriveShow ''TyVarBndr) - -instance Show Doc where - showb = showbDoc - -#if MIN_VERSION_template_haskell(2,5,0) && !(MIN_VERSION_template_haskell(2,7,0)) -$(deriveShow ''ClassInstance) -#endif - -#if MIN_VERSION_template_haskell(2,8,0) -$(deriveShow ''Inline) -$(deriveShow ''Phases) -$(deriveShow ''RuleBndr) -$(deriveShow ''RuleMatch) -$(deriveShow ''TyLit) -#else -$(deriveShow ''InlineSpec) -$(deriveShow ''Kind) -#endif - -#if MIN_VERSION_template_haskell(2,9,0) -$(deriveShow ''AnnLookup) -$(deriveShow ''AnnTarget) -$(deriveShow ''Module) -$(deriveShow ''ModuleInfo) -$(deriveShow ''Role) -$(deriveShow ''TySynEqn) -#endif - -#if !(MIN_VERSION_template_haskell(2,10,0)) -$(deriveShow ''Pred) -#endif +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeSynonymInstances #-} +#if !(MIN_VERSION_template_haskell(2,10,0)) +{-# LANGUAGE MagicHash #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Language.Haskell.TH +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @template-haskell@ library. + +/Since: 0.1/ +-} +module Text.Show.Text.Language.Haskell.TH ( +#if MIN_VERSION_template_haskell(2,9,0) + showbAnnLookupPrec + , showbAnnTargetPrec, +#endif + showbBodyPrec + , showbCallconv +#if MIN_VERSION_template_haskell(2,5,0) && !(MIN_VERSION_template_haskell(2,7,0)) + , showbClassInstancePrec +#endif + , showbClausePrec + , showbConPrec + , showbDecPrec + , showbExpPrec + , showbFamFlavour + , showbFixityPrec + , showbFixityDirection + , showbForeignPrec + , showbFunDepPrec + , showbGuardPrec + , showbInfoPrec +#if MIN_VERSION_template_haskell(2,8,0) + , showbInline +#else + , showbInlineSpecPrec +#endif + , showbKindPrec + , showbLitPrec + , showbLocPrec + , showbMatchPrec + , showbModNamePrec +#if MIN_VERSION_template_haskell(2,9,0) + , showbModulePrec + , showbModuleInfoPrec +#endif + , showbName + , showbName' + , showbOccNamePrec + , showbPatPrec +#if MIN_VERSION_template_haskell(2,8,0) + , showbPhasesPrec +#endif + , showbPkgNamePrec + , showbPragmaPrec + , showbPredPrec + , showbRangePrec +#if MIN_VERSION_template_haskell(2,9,0) + , showbRole +#endif +#if MIN_VERSION_template_haskell(2,8,0) + , showbRuleBndrPrec + , showbRuleMatch +#endif + , showbSafety + , showbStmtPrec + , showbStrict +#if MIN_VERSION_template_haskell(2,8,0) + , showbTyLitPrec +#endif + , showbTypePrec + , showbTyVarBndrPrec +#if MIN_VERSION_template_haskell(2,9,0) + , showbTySynEqnPrec +#endif + , showbDoc + ) where + +import Data.Char (isAlpha) +import Data.Maybe (fromJust) +import qualified Data.Text.Lazy as TL (Text, dropWhile, null, tail) +import Data.Text.Lazy (uncons) + +#if !(MIN_VERSION_template_haskell(2,10,0)) +import GHC.Exts (Int(I#)) +#endif + +import Language.Haskell.TH.PprLib (Doc, to_HPJ_Doc) +import Language.Haskell.TH.Syntax + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showb, showbPrec), Builder, + fromString, toLazyText) +import Text.Show.Text.Data.Integral (showbIntPrec) +import Text.Show.Text.Text.PrettyPrint (renderB) +import Text.Show.Text.TH (deriveShow) +import Text.Show.Text.Utils ((<>), s) + +-- | Convert a 'Body' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbBodyPrec :: Int -> Body -> Builder +showbBodyPrec = showbPrec + +-- | Convert a 'Callconv' to a 'Builder'. +-- +-- /Since: 0.1/ +showbCallconv :: Callconv -> Builder +showbCallconv = showb + +-- | Convert a 'Clause' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbClausePrec :: Int -> Clause -> Builder +showbClausePrec = showbPrec + +-- | Convert a 'Con' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbConPrec :: Int -> Con -> Builder +showbConPrec = showbPrec + +-- | Convert a 'Dec' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbDecPrec :: Int -> Dec -> Builder +showbDecPrec = showbPrec + +-- | Convert an 'Exp' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbExpPrec :: Int -> Exp -> Builder +showbExpPrec = showbPrec + +-- | Convert a 'FamFlavour' to a 'Builder'. +-- +-- /Since: 0.1/ +showbFamFlavour :: FamFlavour -> Builder +showbFamFlavour = showb + +-- | Convert a 'Fixity' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbFixityPrec :: Int -> Fixity -> Builder +showbFixityPrec = showbPrec + +-- | Convert a 'FixityDirection' to a 'Builder'. +-- +-- /Since: 0.1/ +showbFixityDirection :: FixityDirection -> Builder +showbFixityDirection = showb + +-- | Convert a 'Foreign' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbForeignPrec :: Int -> Foreign -> Builder +showbForeignPrec = showbPrec + +-- | Convert a 'FunDep' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbFunDepPrec :: Int -> FunDep -> Builder +showbFunDepPrec = showbPrec + +-- | Convert a 'Guard' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbGuardPrec :: Int -> Guard -> Builder +showbGuardPrec = showbPrec + +-- | Convert an 'Info' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbInfoPrec :: Int -> Info -> Builder +showbInfoPrec = showbPrec + +-- | Convert a 'Kind' to a 'Builder' with the given precedence. +-- +-- /Since: 0.2/ +showbKindPrec :: Int -> Kind -> Builder +#if MIN_VERSION_template_haskell(2,8,0) +showbKindPrec = showbTypePrec +#else +showbKindPrec = showbPrec +#endif + +-- | Convert a 'Lit' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbLitPrec :: Int -> Dec -> Builder +showbLitPrec = showbPrec + +-- | Convert a 'Loc' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbLocPrec :: Int -> Loc -> Builder +showbLocPrec = showbPrec + +-- | Convert a 'Match' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbMatchPrec :: Int -> Match -> Builder +showbMatchPrec = showbPrec + +-- | Convert a 'ModName' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbModNamePrec :: Int -> ModName -> Builder +showbModNamePrec = showbPrec + +-- | Convert a 'Name' to a 'Builder'. +-- +-- /Since: 0.1/ +showbName :: Name -> Builder +showbName = showbName' Alone + +-- | Convert a 'Name' to a 'Builder' with the given 'NameIs' settings. +-- +-- /Since: 0.1/ +showbName' :: NameIs -> Name -> Builder +showbName' ni nm = case ni of + Alone -> nms + Applied + | pnam -> nms + | otherwise -> s '(' <> nms <> s ')' + Infix + | pnam -> s '`' <> nms <> s '`' + | otherwise -> nms + where + -- For now, we make the NameQ and NameG print the same, even though + -- NameQ is a qualified name (so what it means depends on what the + -- current scope is), and NameG is an original name (so its meaning + -- should be independent of what's in scope. + -- We may well want to distinguish them in the end. + -- Ditto NameU and NameL + nms :: Builder + nms = case nm of + Name occ NameS -> occB occ + Name occ (NameQ m) -> modB m <> s '.' <> occB occ + Name occ (NameG _ _ m) -> modB m <> s '.' <> occB occ + Name occ (NameU u) -> occB occ <> s '_' <> showbIntPrec 0 (mkInt u) + Name occ (NameL u) -> occB occ <> s '_' <> showbIntPrec 0 (mkInt u) + +#if MIN_VERSION_template_haskell(2,10,0) + mkInt = id +#else + mkInt i# = I# i# +#endif + + occB :: OccName -> Builder + occB = fromString . occString + + modB :: ModName -> Builder + modB = fromString . modString + + pnam :: Bool + pnam = classify $ toLazyText nms + + -- True if we are function style, e.g. f, [], (,) + -- False if we are operator style, e.g. +, :+ + classify :: TL.Text -> Bool + classify t + | TL.null t = False -- shouldn't happen; . operator is handled below + | otherwise = case fromJust $ uncons t of + (x, xs) -> if isAlpha x || (x `elem` "_[]()") + then let t' = TL.dropWhile (/= '.') xs + in if TL.null t' + then True + else classify $ TL.tail t' + else False + + +-- | Convert an 'OccName' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbOccNamePrec :: Int -> OccName -> Builder +showbOccNamePrec = showbPrec + +-- | Convert a 'Pat' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbPatPrec :: Int -> Pat -> Builder +showbPatPrec = showbPrec + +-- | Convert a 'PkgName' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbPkgNamePrec :: Int -> PkgName -> Builder +showbPkgNamePrec = showbPrec + +-- | Convert a 'Pragma' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbPragmaPrec :: Int -> Pragma -> Builder +showbPragmaPrec = showbPrec + +-- | Convert a 'Pred' to a 'Builder' with the given precedence. +-- +-- /Since: 0.2/ +showbPredPrec :: Int -> Pred -> Builder +#if MIN_VERSION_template_haskell(2,10,0) +showbPredPrec = showbTypePrec +#else +showbPredPrec = showbPrec +#endif + +-- | Convert a 'Range' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbRangePrec :: Int -> Range -> Builder +showbRangePrec = showbPrec + +-- | Convert a 'Safety' to a 'Builder'. +-- +-- /Since: 0.1/ +showbSafety :: Safety -> Builder +showbSafety = showb + +-- | Convert a 'Stmt' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbStmtPrec :: Int -> Stmt -> Builder +showbStmtPrec = showbPrec + +-- | Convert a 'Strict' to a 'Builder'. +-- +-- /Since: 0.1/ +showbStrict :: Strict -> Builder +showbStrict = showb + +-- | Convert a 'Type' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbTypePrec :: Int -> Type -> Builder +showbTypePrec = showbPrec + +-- | Convert a 'TyVarBndr' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbTyVarBndrPrec :: Int -> TyVarBndr -> Builder +showbTyVarBndrPrec = showbPrec + +-- | Convert a 'Doc' to a 'Builder'. +-- +-- /Since: 0.3/ +showbDoc :: Doc -> Builder +showbDoc = renderB . to_HPJ_Doc + +#if MIN_VERSION_template_haskell(2,5,0) && !(MIN_VERSION_template_haskell(2,7,0)) +-- | Convert a 'ClassInstance' to a 'Builder' with the given precedence. +-- This function is only available with @template-haskell@ 2.5.0.0 or 2.6.0.0. +-- +-- /Since: 0.1/ +showbClassInstancePrec :: Int -> ClassInstance -> Builder +showbClassInstancePrec = showbPrec +#endif + +#if MIN_VERSION_template_haskell(2,8,0) +-- | Convert an 'Inline' to a 'Builder'. +-- This function is only available with @template-haskell-2.8.0.0@ or later. +-- +-- /Since: 0.1/ +showbInline :: Inline -> Builder +showbInline = showb + +-- | Convert a 'Phases' to a 'Builder' with the given precedence. +-- This function is only available with @template-haskell-2.8.0.0@ or later. +-- +-- /Since: 0.1/ +showbPhasesPrec :: Int -> Phases -> Builder +showbPhasesPrec = showbPrec + +-- | Convert a 'RuleMatch' to a 'Builder'. +-- This function is only available with @template-haskell-2.8.0.0@ or later. +-- +-- /Since: 0.1/ +showbRuleMatch :: RuleMatch -> Builder +showbRuleMatch = showb + +-- | Convert a 'RuleBndr' to a 'Builder' with the given precedence. +-- This function is only available with @template-haskell-2.8.0.0@ or later. +-- +-- /Since: 0.1/ +showbRuleBndrPrec :: Int -> RuleBndr -> Builder +showbRuleBndrPrec = showbPrec + +-- | Convert a 'TyLit' to a 'Builder' with the given precedence. +-- This function is only available with @template-haskell-2.8.0.0@ or later. +-- +-- /Since: 0.1/ +showbTyLitPrec :: Int -> TyLit -> Builder +showbTyLitPrec = showbPrec +#else +-- | Convert an 'InlineSpec' to a 'Builder' with the given precedence. +-- This function is only available with @template-haskell-2.7.0.0@ or earlier. +-- +-- /Since: 0.1/ +showbInlineSpecPrec :: Int -> InlineSpec -> Builder +showbInlineSpecPrec = showbPrec +#endif + +#if MIN_VERSION_template_haskell(2,9,0) +-- | Convert an 'AnnLookup' to a 'Builder' with the given precedence. +-- This function is only available with @template-haskell-2.9.0.0@ or later. +-- +-- /Since: 0.1/ +showbAnnLookupPrec :: Int -> AnnLookup -> Builder +showbAnnLookupPrec = showbPrec + +-- | Convert an 'AnnTarget' to a 'Builder' with the given precedence. +-- This function is only available with @template-haskell-2.9.0.0@ or later. +-- +-- /Since: 0.1/ +showbAnnTargetPrec :: Int -> AnnTarget -> Builder +showbAnnTargetPrec = showbPrec + +-- | Convert a 'Module' to a 'Builder' with the given precedence. +-- This function is only available with @template-haskell-2.9.0.0@ or later. +-- +-- /Since: 0.1/ +showbModulePrec :: Int -> Module -> Builder +showbModulePrec = showbPrec + +-- | Convert a 'ModuleInfo' to a 'Builder' with the given precedence. +-- This function is only available with @template-haskell-2.9.0.0@ or later. +-- +-- /Since: 0.1/ +showbModuleInfoPrec :: Int -> ModuleInfo -> Builder +showbModuleInfoPrec = showbPrec + +-- | Convert a 'Role' to a 'Builder'. +-- This function is only available with @template-haskell-2.9.0.0@ or later. +-- +-- /Since: 0.1/ +showbRole :: Role -> Builder +showbRole = showb + +-- | Convert a 'TySynEqn' to a 'Builder' with the given precedence. +-- This function is only available with @template-haskell-2.9.0.0@ or later. +-- +-- /Since: 0.1/ +showbTySynEqnPrec :: Int -> TySynEqn -> Builder +showbTySynEqnPrec = showbPrec +#endif + +$(deriveShow ''Body) +$(deriveShow ''Callconv) +$(deriveShow ''Clause) +$(deriveShow ''Con) +$(deriveShow ''Dec) +$(deriveShow ''Exp) +$(deriveShow ''FamFlavour) +$(deriveShow ''Fixity) +$(deriveShow ''FixityDirection) +$(deriveShow ''Foreign) +$(deriveShow ''FunDep) +$(deriveShow ''Guard) +$(deriveShow ''Info) +$(deriveShow ''Lit) +$(deriveShow ''Loc) +$(deriveShow ''Match) +$(deriveShow ''ModName) + +instance Show Name where + showb = showbName + +$(deriveShow ''OccName) +$(deriveShow ''Pat) +$(deriveShow ''PkgName) +$(deriveShow ''Pragma) +$(deriveShow ''Range) +$(deriveShow ''Safety) +$(deriveShow ''Stmt) +$(deriveShow ''Strict) +$(deriveShow ''Type) +$(deriveShow ''TyVarBndr) + +instance Show Doc where + showb = showbDoc + +#if MIN_VERSION_template_haskell(2,5,0) && !(MIN_VERSION_template_haskell(2,7,0)) +$(deriveShow ''ClassInstance) +#endif + +#if MIN_VERSION_template_haskell(2,8,0) +$(deriveShow ''Inline) +$(deriveShow ''Phases) +$(deriveShow ''RuleBndr) +$(deriveShow ''RuleMatch) +$(deriveShow ''TyLit) +#else +$(deriveShow ''InlineSpec) +$(deriveShow ''Kind) +#endif + +#if MIN_VERSION_template_haskell(2,9,0) +$(deriveShow ''AnnLookup) +$(deriveShow ''AnnTarget) +$(deriveShow ''Module) +$(deriveShow ''ModuleInfo) +$(deriveShow ''Role) +$(deriveShow ''TySynEqn) +#endif + +#if !(MIN_VERSION_template_haskell(2,10,0)) +$(deriveShow ''Pred) +#endif diff --git a/src/Text/Show/Text/System.hs b/src/Text/Show/Text/System.hs --- a/src/Text/Show/Text/System.hs +++ b/src/Text/Show/Text/System.hs @@ -1,24 +1,24 @@ -{-# LANGUAGE CPP #-} -{-| -Module: Text.Show.Text.System -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Imports 'Show' instances for @System@ modules. --} -module Text.Show.Text.System () where - -import Text.Show.Text.System.Console.Haskeline () -import Text.Show.Text.System.Locale () -import Text.Show.Text.System.Random () -import Text.Show.Text.System.Time () - -#if defined(mingw32_HOST_OS) -import Text.Show.Text.System.Win32 () -#else -import Text.Show.Text.System.Console.Terminfo () -import Text.Show.Text.System.Posix () +{-# LANGUAGE CPP #-} +{-| +Module: Text.Show.Text.System +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Imports 'Show' instances for @System@ modules. +-} +module Text.Show.Text.System () where + +import Text.Show.Text.System.Console.Haskeline () +import Text.Show.Text.System.Locale () +import Text.Show.Text.System.Random () +import Text.Show.Text.System.Time () + +#if defined(mingw32_HOST_OS) +import Text.Show.Text.System.Win32 () +#else +import Text.Show.Text.System.Console.Terminfo () +import Text.Show.Text.System.Posix () #endif diff --git a/src/Text/Show/Text/System/Console/Haskeline.hs b/src/Text/Show/Text/System/Console/Haskeline.hs --- a/src/Text/Show/Text/System/Console/Haskeline.hs +++ b/src/Text/Show/Text/System/Console/Haskeline.hs @@ -1,73 +1,73 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.System.Console.Haskeline -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @haskeline@ library. - -/Since: 0.2/ --} -module Text.Show.Text.System.Console.Haskeline ( - showbInterrupt - , showbPrefsPrec - , showbCompletionPrec - , showbHistory - ) where - -import Prelude hiding (Show) - -import System.Console.Haskeline (Interrupt, Prefs) -import System.Console.Haskeline.Completion (Completion) -import System.Console.Haskeline.History (History, historyLines) - -import Text.Show.Text (Show(showb, showbPrec), Builder, FromStringShow(..), showbUnary) -import Text.Show.Text.TH (deriveShow, deriveShowPragmas, defaultInlineShowb) - -#include "inline.h" - --- | Convert an 'Interrupt' to a 'Builder'. --- --- /Since: 0.2/ -showbInterrupt :: Interrupt -> Builder -showbInterrupt = showb -{-# INLINE showbInterrupt #-} - --- | Convert a 'Prefs' value to a 'Builder' with the given precedence. --- --- /Since: 0.2/ -showbPrefsPrec :: Int -> Prefs -> Builder -showbPrefsPrec p = showbPrec p . FromStringShow -{-# INLINE showbPrefsPrec #-} - --- | Convert a 'Completion' value to a 'Builder' with the given precedence. --- --- /Since: 0.2/ -showbCompletionPrec :: Int -> Completion -> Builder -showbCompletionPrec = showbPrec -{-# INLINE showbCompletionPrec #-} - --- | Convert a 'History' value to a 'Builder'. --- --- /Since: 0.2/ -showbHistory :: History -> Builder -showbHistory = showbUnary "fromList" 0 . historyLines -{-# INLINE showbHistory #-} - -$(deriveShowPragmas defaultInlineShowb ''Interrupt) - -instance Show Prefs where - showbPrec = showbPrefsPrec - INLINE_INST_FUN(showbPrec) - -$(deriveShow ''Completion) - -instance Show History where - showb = showbHistory - INLINE_INST_FUN(showb) +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.System.Console.Haskeline +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @haskeline@ library. + +/Since: 0.2/ +-} +module Text.Show.Text.System.Console.Haskeline ( + showbInterrupt + , showbPrefsPrec + , showbCompletionPrec + , showbHistory + ) where + +import Prelude hiding (Show) + +import System.Console.Haskeline (Interrupt, Prefs) +import System.Console.Haskeline.Completion (Completion) +import System.Console.Haskeline.History (History, historyLines) + +import Text.Show.Text (Show(showb, showbPrec), Builder, FromStringShow(..), showbUnary) +import Text.Show.Text.TH (deriveShow, deriveShowPragmas, defaultInlineShowb) + +#include "inline.h" + +-- | Convert an 'Interrupt' to a 'Builder'. +-- +-- /Since: 0.2/ +showbInterrupt :: Interrupt -> Builder +showbInterrupt = showb +{-# INLINE showbInterrupt #-} + +-- | Convert a 'Prefs' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.2/ +showbPrefsPrec :: Int -> Prefs -> Builder +showbPrefsPrec p = showbPrec p . FromStringShow +{-# INLINE showbPrefsPrec #-} + +-- | Convert a 'Completion' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.2/ +showbCompletionPrec :: Int -> Completion -> Builder +showbCompletionPrec = showbPrec +{-# INLINE showbCompletionPrec #-} + +-- | Convert a 'History' value to a 'Builder'. +-- +-- /Since: 0.2/ +showbHistory :: History -> Builder +showbHistory = showbUnary "fromList" 0 . historyLines +{-# INLINE showbHistory #-} + +$(deriveShowPragmas defaultInlineShowb ''Interrupt) + +instance Show Prefs where + showbPrec = showbPrefsPrec + INLINE_INST_FUN(showbPrec) + +$(deriveShow ''Completion) + +instance Show History where + showb = showbHistory + INLINE_INST_FUN(showb) diff --git a/src/Text/Show/Text/System/Console/Terminfo.hs b/src/Text/Show/Text/System/Console/Terminfo.hs --- a/src/Text/Show/Text/System/Console/Terminfo.hs +++ b/src/Text/Show/Text/System/Console/Terminfo.hs @@ -1,46 +1,46 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.System.Console.Terminfo -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @terminfo@ library. - -/Since: 0.2/ --} -module Text.Show.Text.System.Console.Terminfo (showbColorPrec, showbSetupTermError) where - -import Prelude hiding (Show) - -import System.Console.Terminfo.Base (SetupTermError) -import System.Console.Terminfo.Color (Color) - -import Text.Show.Text (Show(showb, showbPrec), Builder, FromStringShow(..)) -import Text.Show.Text.TH (deriveShow) - -#include "inline.h" - --- | Convert a 'Color' to a 'Builder' with the given precedence. --- --- /Since: 0.2/ -showbColorPrec :: Int -> Color -> Builder -showbColorPrec = showbPrec -{-# INLINE showbColorPrec #-} - --- | Convert a 'SetupTermError' to a 'Builder'. --- --- /Since: 0.2/ -showbSetupTermError :: SetupTermError -> Builder -showbSetupTermError = showb . FromStringShow -{-# INLINE showbSetupTermError #-} - -$(deriveShow ''Color) - -instance Show SetupTermError where - showb = showbSetupTermError - INLINE_INST_FUN(showb) +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.System.Console.Terminfo +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @terminfo@ library. + +/Since: 0.2/ +-} +module Text.Show.Text.System.Console.Terminfo (showbColorPrec, showbSetupTermError) where + +import Prelude hiding (Show) + +import System.Console.Terminfo.Base (SetupTermError) +import System.Console.Terminfo.Color (Color) + +import Text.Show.Text (Show(showb, showbPrec), Builder, FromStringShow(..)) +import Text.Show.Text.TH (deriveShow) + +#include "inline.h" + +-- | Convert a 'Color' to a 'Builder' with the given precedence. +-- +-- /Since: 0.2/ +showbColorPrec :: Int -> Color -> Builder +showbColorPrec = showbPrec +{-# INLINE showbColorPrec #-} + +-- | Convert a 'SetupTermError' to a 'Builder'. +-- +-- /Since: 0.2/ +showbSetupTermError :: SetupTermError -> Builder +showbSetupTermError = showb . FromStringShow +{-# INLINE showbSetupTermError #-} + +$(deriveShow ''Color) + +instance Show SetupTermError where + showb = showbSetupTermError + INLINE_INST_FUN(showb) diff --git a/src/Text/Show/Text/System/Directory.hs b/src/Text/Show/Text/System/Directory.hs --- a/src/Text/Show/Text/System/Directory.hs +++ b/src/Text/Show/Text/System/Directory.hs @@ -1,31 +1,31 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.System.Directory -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' function for 'Permissions'. - -/Since: 0.1/ --} -module Text.Show.Text.System.Directory (showbPermissionsPrec) where - -import Prelude hiding (Show) - -import System.Directory (Permissions) - -import Text.Show.Text (Show(showbPrec), Builder) -import Text.Show.Text.TH (deriveShow) - --- | Convert 'Permissions' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbPermissionsPrec :: Int -> Permissions -> Builder -showbPermissionsPrec = showbPrec -{-# INLINE showbPermissionsPrec #-} - +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.System.Directory +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' function for 'Permissions'. + +/Since: 0.1/ +-} +module Text.Show.Text.System.Directory (showbPermissionsPrec) where + +import Prelude hiding (Show) + +import System.Directory (Permissions) + +import Text.Show.Text (Show(showbPrec), Builder) +import Text.Show.Text.TH (deriveShow) + +-- | Convert 'Permissions' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbPermissionsPrec :: Int -> Permissions -> Builder +showbPermissionsPrec = showbPrec +{-# INLINE showbPermissionsPrec #-} + $(deriveShow ''Permissions) diff --git a/src/Text/Show/Text/System/Locale.hs b/src/Text/Show/Text/System/Locale.hs --- a/src/Text/Show/Text/System/Locale.hs +++ b/src/Text/Show/Text/System/Locale.hs @@ -1,31 +1,31 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.System.Locale -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' function for old 'TimeLocale's. - -/Since: 0.1/ --} -module Text.Show.Text.System.Locale (showbTimeLocalePrec) where - -import System.Locale (TimeLocale) - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showbPrec), Builder) -import Text.Show.Text.TH (deriveShow) - --- | Convert a 'TimeLocale' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbTimeLocalePrec :: Int -> TimeLocale -> Builder -showbTimeLocalePrec = showbPrec -{-# INLINE showbTimeLocalePrec #-} - +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.System.Locale +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' function for old 'TimeLocale's. + +/Since: 0.1/ +-} +module Text.Show.Text.System.Locale (showbTimeLocalePrec) where + +import System.Locale (TimeLocale) + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showbPrec), Builder) +import Text.Show.Text.TH (deriveShow) + +-- | Convert a 'TimeLocale' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbTimeLocalePrec :: Int -> TimeLocale -> Builder +showbTimeLocalePrec = showbPrec +{-# INLINE showbTimeLocalePrec #-} + $(deriveShow ''TimeLocale) diff --git a/src/Text/Show/Text/System/Posix.hs b/src/Text/Show/Text/System/Posix.hs --- a/src/Text/Show/Text/System/Posix.hs +++ b/src/Text/Show/Text/System/Posix.hs @@ -1,70 +1,70 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.System.Posix -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @unix@ library. This module is -only available on Unix-like operating systems (i.e., not Windows). - -/Since: 0.1/ --} -module Text.Show.Text.System.Posix ( - showbRTLDFlags - , showbDLPrec - , showbProcessStatusPrec - , showbGroupEntryPrec - , showbUserEntryPrec - ) where - -import System.Posix.DynamicLinker (RTLDFlags, DL) -import System.Posix.Process (ProcessStatus) -import System.Posix.User (GroupEntry, UserEntry) - -import Text.Show.Text (Builder, showb, showbPrec) -import Text.Show.Text.TH (deriveShow, deriveShowPragmas, defaultInlineShowb) - --- | Convert an 'RTLDFlags' value to a 'Builder'. --- --- /Since: 0.1/ -showbRTLDFlags :: RTLDFlags -> Builder -showbRTLDFlags = showb -{-# INLINE showbRTLDFlags #-} - --- | Convert a 'DL' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbDLPrec :: Int -> DL -> Builder -showbDLPrec = showbPrec -{-# INLINE showbDLPrec #-} - --- | Convert a 'ProcessStatus' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbProcessStatusPrec :: Int -> ProcessStatus -> Builder -showbProcessStatusPrec = showbPrec -{-# INLINE showbProcessStatusPrec #-} - --- | Convert a 'GroupEntry' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbGroupEntryPrec :: Int -> GroupEntry -> Builder -showbGroupEntryPrec = showbPrec -{-# INLINE showbGroupEntryPrec #-} - --- | Convert a 'UserEntry' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbUserEntryPrec :: Int -> UserEntry -> Builder -showbUserEntryPrec = showbPrec -{-# INLINE showbUserEntryPrec #-} - -$(deriveShowPragmas defaultInlineShowb ''RTLDFlags) -$(deriveShow ''DL) -$(deriveShow ''ProcessStatus) -$(deriveShow ''GroupEntry) +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.System.Posix +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @unix@ library. This module is +only available on Unix-like operating systems (i.e., not Windows). + +/Since: 0.1/ +-} +module Text.Show.Text.System.Posix ( + showbRTLDFlags + , showbDLPrec + , showbProcessStatusPrec + , showbGroupEntryPrec + , showbUserEntryPrec + ) where + +import System.Posix.DynamicLinker (RTLDFlags, DL) +import System.Posix.Process (ProcessStatus) +import System.Posix.User (GroupEntry, UserEntry) + +import Text.Show.Text (Builder, showb, showbPrec) +import Text.Show.Text.TH (deriveShow, deriveShowPragmas, defaultInlineShowb) + +-- | Convert an 'RTLDFlags' value to a 'Builder'. +-- +-- /Since: 0.1/ +showbRTLDFlags :: RTLDFlags -> Builder +showbRTLDFlags = showb +{-# INLINE showbRTLDFlags #-} + +-- | Convert a 'DL' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbDLPrec :: Int -> DL -> Builder +showbDLPrec = showbPrec +{-# INLINE showbDLPrec #-} + +-- | Convert a 'ProcessStatus' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbProcessStatusPrec :: Int -> ProcessStatus -> Builder +showbProcessStatusPrec = showbPrec +{-# INLINE showbProcessStatusPrec #-} + +-- | Convert a 'GroupEntry' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbGroupEntryPrec :: Int -> GroupEntry -> Builder +showbGroupEntryPrec = showbPrec +{-# INLINE showbGroupEntryPrec #-} + +-- | Convert a 'UserEntry' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbUserEntryPrec :: Int -> UserEntry -> Builder +showbUserEntryPrec = showbPrec +{-# INLINE showbUserEntryPrec #-} + +$(deriveShowPragmas defaultInlineShowb ''RTLDFlags) +$(deriveShow ''DL) +$(deriveShow ''ProcessStatus) +$(deriveShow ''GroupEntry) $(deriveShow ''UserEntry) diff --git a/src/Text/Show/Text/System/Random.hs b/src/Text/Show/Text/System/Random.hs --- a/src/Text/Show/Text/System/Random.hs +++ b/src/Text/Show/Text/System/Random.hs @@ -1,32 +1,32 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.System.Random -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' function for 'StdGen'. - -/Since: 0.1/ --} -module Text.Show.Text.System.Random (showbStdGenPrec) where - -import Prelude hiding (Show) -import System.Random (StdGen) -import Text.Show.Text (Show(showbPrec), Builder, FromStringShow(..)) - -#include "inline.h" - --- | Convert a 'StdGen' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbStdGenPrec :: Int -> StdGen -> Builder -showbStdGenPrec p = showbPrec p . FromStringShow -{-# INLINE showbStdGenPrec #-} - -instance Show StdGen where - showbPrec = showbStdGenPrec +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.System.Random +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' function for 'StdGen'. + +/Since: 0.1/ +-} +module Text.Show.Text.System.Random (showbStdGenPrec) where + +import Prelude hiding (Show) +import System.Random (StdGen) +import Text.Show.Text (Show(showbPrec), Builder, FromStringShow(..)) + +#include "inline.h" + +-- | Convert a 'StdGen' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbStdGenPrec :: Int -> StdGen -> Builder +showbStdGenPrec p = showbPrec p . FromStringShow +{-# INLINE showbStdGenPrec #-} + +instance Show StdGen where + showbPrec = showbStdGenPrec INLINE_INST_FUN(showbPrec) diff --git a/src/Text/Show/Text/System/Time.hs b/src/Text/Show/Text/System/Time.hs --- a/src/Text/Show/Text/System/Time.hs +++ b/src/Text/Show/Text/System/Time.hs @@ -1,76 +1,76 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.System.Time -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @old-time@ library. - -/Since: 0.1/ --} -module Text.Show.Text.System.Time ( - showbClockTime - , showbTimeDiffPrec - , showbCalendarTimePrec - , showbMonth - , showbDay - ) where - -import Prelude hiding (Show) - -import System.IO.Unsafe (unsafePerformIO) -import System.Time (ClockTime, TimeDiff, CalendarTime, Month, Day, - calendarTimeToString, toCalendarTime) - -import Text.Show.Text (Show(showb, showbPrec), Builder, fromString) -import Text.Show.Text.TH (deriveShow) - -#include "inline.h" - --- | Convert a 'ClockTime' to a 'Builder'. --- --- /Since: 0.1/ -showbClockTime :: ClockTime -> Builder -showbClockTime = fromString . calendarTimeToString . unsafePerformIO . toCalendarTime - --- | Convert a 'TimeDiff' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbTimeDiffPrec :: Int -> TimeDiff -> Builder -showbTimeDiffPrec = showbPrec -{-# INLINE showbTimeDiffPrec #-} - --- | Convert a 'CalendarTime' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbCalendarTimePrec :: Int -> CalendarTime -> Builder -showbCalendarTimePrec = showbPrec -{-# INLINE showbCalendarTimePrec #-} - --- | Convert a 'Month' to a 'Builder'. --- --- /Since: 0.1/ -showbMonth :: Month -> Builder -showbMonth = showb -{-# INLINE showbMonth #-} - --- | Convert a 'Day' to a 'Builder'. --- --- /Since: 0.1/ -showbDay :: Day -> Builder -showbDay = showb -{-# INLINE showbDay #-} - -instance Show ClockTime where - showb = showbClockTime - INLINE_INST_FUN(showb) - -$(deriveShow ''TimeDiff) -$(deriveShow ''CalendarTime) -$(deriveShow ''Month) -$(deriveShow ''Day) +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.System.Time +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @old-time@ library. + +/Since: 0.1/ +-} +module Text.Show.Text.System.Time ( + showbClockTime + , showbTimeDiffPrec + , showbCalendarTimePrec + , showbMonth + , showbDay + ) where + +import Prelude hiding (Show) + +import System.IO.Unsafe (unsafePerformIO) +import System.Time (ClockTime, TimeDiff, CalendarTime, Month, Day, + calendarTimeToString, toCalendarTime) + +import Text.Show.Text (Show(showb, showbPrec), Builder, fromString) +import Text.Show.Text.TH (deriveShow) + +#include "inline.h" + +-- | Convert a 'ClockTime' to a 'Builder'. +-- +-- /Since: 0.1/ +showbClockTime :: ClockTime -> Builder +showbClockTime = fromString . calendarTimeToString . unsafePerformIO . toCalendarTime + +-- | Convert a 'TimeDiff' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbTimeDiffPrec :: Int -> TimeDiff -> Builder +showbTimeDiffPrec = showbPrec +{-# INLINE showbTimeDiffPrec #-} + +-- | Convert a 'CalendarTime' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbCalendarTimePrec :: Int -> CalendarTime -> Builder +showbCalendarTimePrec = showbPrec +{-# INLINE showbCalendarTimePrec #-} + +-- | Convert a 'Month' to a 'Builder'. +-- +-- /Since: 0.1/ +showbMonth :: Month -> Builder +showbMonth = showb +{-# INLINE showbMonth #-} + +-- | Convert a 'Day' to a 'Builder'. +-- +-- /Since: 0.1/ +showbDay :: Day -> Builder +showbDay = showb +{-# INLINE showbDay #-} + +instance Show ClockTime where + showb = showbClockTime + INLINE_INST_FUN(showb) + +$(deriveShow ''TimeDiff) +$(deriveShow ''CalendarTime) +$(deriveShow ''Month) +$(deriveShow ''Day) diff --git a/src/Text/Show/Text/System/Win32.hs b/src/Text/Show/Text/System/Win32.hs --- a/src/Text/Show/Text/System/Win32.hs +++ b/src/Text/Show/Text/System/Win32.hs @@ -1,117 +1,117 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.System.Win32 -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @Win32@ library. -This module is only available on Windows. - -/Since: 0.1/ --} -module Text.Show.Text.System.Win32 ( - showbDebugEventInfoPrec - , showbExceptionPrec - , showb_BY_HANDLE_FILE_INFORMATION_Prec - , showb_WIN32_FILE_ATTRIBUTE_DATA_Prec - , showbProcessorArchitecturePrec - , showb_SYSTEM_INFO_Prec - , showb_FILETIME_Prec - , showb_SYSTEMTIME_Prec - , showb_TIME_ZONE_INFORMATION_Prec - , showbTimeZoneIdPrec - ) where - -import System.Win32.DebugApi (DebugEventInfo, Exception) -import System.Win32.File (BY_HANDLE_FILE_INFORMATION, WIN32_FILE_ATTRIBUTE_DATA) -import System.Win32.Info (ProcessorArchitecture, SYSTEM_INFO) -import System.Win32.Time (FILETIME, SYSTEMTIME, TIME_ZONE_INFORMATION, TimeZoneId) - -import Text.Show.Text (Builder, showb, showbPrec) -import Text.Show.Text.TH (deriveShow, deriveShowPragmas, - defaultInlineShowb, defaultInlineShowbPrec) - --- | Convert a 'DebugEventInfo' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbDebugEventInfoPrec :: Int -> DebugEventInfo -> Builder -showbDebugEventInfoPrec = showbPrec -{-# INLINE showbDebugEventInfoPrec #-} - --- | Convert an 'Exception' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbExceptionPrec :: Int -> Exception -> Builder -showbExceptionPrec = showbPrec -{-# INLINE showbExceptionPrec #-} - --- | Convert a 'BY_HANDLE_FILE_INFORMATION' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showb_BY_HANDLE_FILE_INFORMATION_Prec :: Int -> BY_HANDLE_FILE_INFORMATION -> Builder -showb_BY_HANDLE_FILE_INFORMATION_Prec = showbPrec -{-# INLINE showb_BY_HANDLE_FILE_INFORMATION_Prec #-} - --- | Convert a 'WIN32_FILE_ATTRIBUTE_DATA' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showb_WIN32_FILE_ATTRIBUTE_DATA_Prec :: Int -> WIN32_FILE_ATTRIBUTE_DATA -> Builder -showb_WIN32_FILE_ATTRIBUTE_DATA_Prec = showbPrec -{-# INLINE showb_WIN32_FILE_ATTRIBUTE_DATA_Prec #-} - --- | Convert a 'ProcessorArchitecture' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbProcessorArchitecturePrec :: Int -> ProcessorArchitecture -> Builder -showbProcessorArchitecturePrec = showbPrec -{-# INLINE showbProcessorArchitecturePrec #-} - --- | Convert a 'SYSTEM_INFO' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showb_SYSTEM_INFO_Prec :: Int -> SYSTEM_INFO -> Builder -showb_SYSTEM_INFO_Prec = showbPrec -{-# INLINE showb_SYSTEM_INFO_Prec #-} - --- | Convert a 'FILETIME' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showb_FILETIME_Prec :: Int -> FILETIME -> Builder -showb_FILETIME_Prec = showbPrec -{-# INLINE showb_FILETIME_Prec #-} - --- | Convert a 'SYSTEMTIME' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showb_SYSTEMTIME_Prec :: Int -> SYSTEMTIME -> Builder -showb_SYSTEMTIME_Prec = showbPrec -{-# INLINE showb_SYSTEMTIME_Prec #-} - --- | Convert a 'TIME_ZONE_INFORMATION' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showb_TIME_ZONE_INFORMATION_Prec :: Int -> TIME_ZONE_INFORMATION -> Builder -showb_TIME_ZONE_INFORMATION_Prec = showbPrec -{-# INLINE showb_TIME_ZONE_INFORMATION_Prec #-} - --- | Convert a 'TimeZoneId' to a 'Builder'. --- --- /Since: 0.1/ -showbTimeZoneIdPrec :: TimeZoneId -> Builder -showbTimeZoneIdPrec = showb -{-# INLINE showbTimeZoneIdPrec #-} - -$(deriveShow ''DebugEventInfo) -$(deriveShow ''Exception) -$(deriveShow ''BY_HANDLE_FILE_INFORMATION) -$(deriveShow ''WIN32_FILE_ATTRIBUTE_DATA) -$(deriveShow ''ProcessorArchitecture) -$(deriveShow ''SYSTEM_INFO) -$(deriveShowPragmas defaultInlineShowbPrec ''FILETIME) -$(deriveShow ''SYSTEMTIME) -$(deriveShow ''TIME_ZONE_INFORMATION) +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.System.Win32 +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @Win32@ library. +This module is only available on Windows. + +/Since: 0.1/ +-} +module Text.Show.Text.System.Win32 ( + showbDebugEventInfoPrec + , showbExceptionPrec + , showb_BY_HANDLE_FILE_INFORMATION_Prec + , showb_WIN32_FILE_ATTRIBUTE_DATA_Prec + , showbProcessorArchitecturePrec + , showb_SYSTEM_INFO_Prec + , showb_FILETIME_Prec + , showb_SYSTEMTIME_Prec + , showb_TIME_ZONE_INFORMATION_Prec + , showbTimeZoneIdPrec + ) where + +import System.Win32.DebugApi (DebugEventInfo, Exception) +import System.Win32.File (BY_HANDLE_FILE_INFORMATION, WIN32_FILE_ATTRIBUTE_DATA) +import System.Win32.Info (ProcessorArchitecture, SYSTEM_INFO) +import System.Win32.Time (FILETIME, SYSTEMTIME, TIME_ZONE_INFORMATION, TimeZoneId) + +import Text.Show.Text (Builder, showb, showbPrec) +import Text.Show.Text.TH (deriveShow, deriveShowPragmas, + defaultInlineShowb, defaultInlineShowbPrec) + +-- | Convert a 'DebugEventInfo' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbDebugEventInfoPrec :: Int -> DebugEventInfo -> Builder +showbDebugEventInfoPrec = showbPrec +{-# INLINE showbDebugEventInfoPrec #-} + +-- | Convert an 'Exception' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbExceptionPrec :: Int -> Exception -> Builder +showbExceptionPrec = showbPrec +{-# INLINE showbExceptionPrec #-} + +-- | Convert a 'BY_HANDLE_FILE_INFORMATION' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showb_BY_HANDLE_FILE_INFORMATION_Prec :: Int -> BY_HANDLE_FILE_INFORMATION -> Builder +showb_BY_HANDLE_FILE_INFORMATION_Prec = showbPrec +{-# INLINE showb_BY_HANDLE_FILE_INFORMATION_Prec #-} + +-- | Convert a 'WIN32_FILE_ATTRIBUTE_DATA' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showb_WIN32_FILE_ATTRIBUTE_DATA_Prec :: Int -> WIN32_FILE_ATTRIBUTE_DATA -> Builder +showb_WIN32_FILE_ATTRIBUTE_DATA_Prec = showbPrec +{-# INLINE showb_WIN32_FILE_ATTRIBUTE_DATA_Prec #-} + +-- | Convert a 'ProcessorArchitecture' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbProcessorArchitecturePrec :: Int -> ProcessorArchitecture -> Builder +showbProcessorArchitecturePrec = showbPrec +{-# INLINE showbProcessorArchitecturePrec #-} + +-- | Convert a 'SYSTEM_INFO' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showb_SYSTEM_INFO_Prec :: Int -> SYSTEM_INFO -> Builder +showb_SYSTEM_INFO_Prec = showbPrec +{-# INLINE showb_SYSTEM_INFO_Prec #-} + +-- | Convert a 'FILETIME' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showb_FILETIME_Prec :: Int -> FILETIME -> Builder +showb_FILETIME_Prec = showbPrec +{-# INLINE showb_FILETIME_Prec #-} + +-- | Convert a 'SYSTEMTIME' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showb_SYSTEMTIME_Prec :: Int -> SYSTEMTIME -> Builder +showb_SYSTEMTIME_Prec = showbPrec +{-# INLINE showb_SYSTEMTIME_Prec #-} + +-- | Convert a 'TIME_ZONE_INFORMATION' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showb_TIME_ZONE_INFORMATION_Prec :: Int -> TIME_ZONE_INFORMATION -> Builder +showb_TIME_ZONE_INFORMATION_Prec = showbPrec +{-# INLINE showb_TIME_ZONE_INFORMATION_Prec #-} + +-- | Convert a 'TimeZoneId' to a 'Builder'. +-- +-- /Since: 0.1/ +showbTimeZoneIdPrec :: TimeZoneId -> Builder +showbTimeZoneIdPrec = showb +{-# INLINE showbTimeZoneIdPrec #-} + +$(deriveShow ''DebugEventInfo) +$(deriveShow ''Exception) +$(deriveShow ''BY_HANDLE_FILE_INFORMATION) +$(deriveShow ''WIN32_FILE_ATTRIBUTE_DATA) +$(deriveShow ''ProcessorArchitecture) +$(deriveShow ''SYSTEM_INFO) +$(deriveShowPragmas defaultInlineShowbPrec ''FILETIME) +$(deriveShow ''SYSTEMTIME) +$(deriveShow ''TIME_ZONE_INFORMATION) $(deriveShowPragmas defaultInlineShowb ''TimeZoneId) diff --git a/src/Text/Show/Text/Text.hs b/src/Text/Show/Text/Text.hs --- a/src/Text/Show/Text/Text.hs +++ b/src/Text/Show/Text/Text.hs @@ -1,13 +1,13 @@ -{-| -Module: Text.Show.Text.Text -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Imports 'Show' instances for @Text@ modules. --} -module Text.Show.Text.Text () where - +{-| +Module: Text.Show.Text.Text +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Imports 'Show' instances for @Text@ modules. +-} +module Text.Show.Text.Text () where + import Text.Show.Text.Text.PrettyPrint () diff --git a/src/Text/Show/Text/Text/PrettyPrint.hs b/src/Text/Show/Text/Text/PrettyPrint.hs --- a/src/Text/Show/Text/Text/PrettyPrint.hs +++ b/src/Text/Show/Text/Text/PrettyPrint.hs @@ -1,111 +1,111 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Text.PrettyPrint -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @pretty@ library. - -/Since: 0.1/ --} -module Text.Show.Text.Text.PrettyPrint ( - renderB - , renderStyleB - , showbMode - , showbStylePrec - , showbTextDetailsPrec -#if MIN_VERSION_pretty(1,1,2) - , showbPrettyLevelPrec -#endif - ) where - -#if !(MIN_VERSION_base(4,8,0)) -import Data.Monoid (mempty) -#endif - -import Prelude hiding (Show) - -import Text.PrettyPrint.HughesPJ (Doc, Mode, Style(..), TextDetails(..), - fullRender, style) -#if MIN_VERSION_pretty(1,1,2) -import Text.PrettyPrint.HughesPJClass (PrettyLevel) -import Text.Show.Text.TH (defaultInlineShowbPrec) -#endif -import Text.Show.Text (Show(showb, showbPrec), Builder, fromString) -import Text.Show.Text.TH (deriveShow, deriveShowPragmas, defaultInlineShowb) -import Text.Show.Text.Utils ((<>), s) - -#include "inline.h" - --- | Renders a 'Doc' to a 'Builder' using the default 'style'. --- --- /Since: 0.3/ -renderB :: Doc -> Builder -renderB = renderStyleB style -{-# INLINE renderB #-} - --- | Renders a 'Doc' to a 'Builder' using the given 'Style'. --- --- /Since: 0.2/ -renderStyleB :: Style -> Doc -> Builder -renderStyleB sty doc = fullRender (mode sty) - (lineLength sty) - (ribbonsPerLine sty) - txtPrinter - mempty - doc -{-# INLINE renderStyleB #-} - -txtPrinter :: TextDetails -> Builder -> Builder -txtPrinter (Chr c) b = s c <> b -txtPrinter (Str s') b = fromString s' <> b -txtPrinter (PStr s') b = fromString s' <> b -{-# INLINE txtPrinter #-} - --- | Convert a 'Mode' to a 'Builder'. --- --- /Since: 0.1/ -showbMode :: Mode -> Builder -showbMode = showb -{-# INLINE showbMode #-} - --- | Convert a 'Style' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbStylePrec :: Int -> Style -> Builder -showbStylePrec = showbPrec -{-# INLINE showbStylePrec #-} - --- | Convert 'TextDetails' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbTextDetailsPrec :: Int -> TextDetails -> Builder -showbTextDetailsPrec = showbPrec -{-# INLINE showbTextDetailsPrec #-} - -#if MIN_VERSION_pretty(1,1,2) --- | Convert a 'PrettyLevel' value to a 'Builder' with the given precedence. --- This function is only available with @pretty-1.1.2.0@ or later. --- --- /Since: 0.1/ -showbPrettyLevelPrec :: Int -> PrettyLevel -> Builder -showbPrettyLevelPrec = showbPrec -{-# INLINE showbPrettyLevelPrec #-} -#endif - -instance Show Doc where - showb = renderB - INLINE_INST_FUN(showb) - -$(deriveShowPragmas defaultInlineShowb ''Mode) -$(deriveShow ''Style) -$(deriveShow ''TextDetails) - -#if MIN_VERSION_pretty(1,1,2) -$(deriveShowPragmas defaultInlineShowbPrec ''PrettyLevel) -#endif +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Text.PrettyPrint +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @pretty@ library. + +/Since: 0.1/ +-} +module Text.Show.Text.Text.PrettyPrint ( + renderB + , renderStyleB + , showbMode + , showbStylePrec + , showbTextDetailsPrec +#if MIN_VERSION_pretty(1,1,2) + , showbPrettyLevelPrec +#endif + ) where + +#if !(MIN_VERSION_base(4,8,0)) +import Data.Monoid (mempty) +#endif + +import Prelude hiding (Show) + +import Text.PrettyPrint.HughesPJ (Doc, Mode, Style(..), TextDetails(..), + fullRender, style) +#if MIN_VERSION_pretty(1,1,2) +import Text.PrettyPrint.HughesPJClass (PrettyLevel) +import Text.Show.Text.TH (defaultInlineShowbPrec) +#endif +import Text.Show.Text (Show(showb, showbPrec), Builder, fromString) +import Text.Show.Text.TH (deriveShow, deriveShowPragmas, defaultInlineShowb) +import Text.Show.Text.Utils ((<>), s) + +#include "inline.h" + +-- | Renders a 'Doc' to a 'Builder' using the default 'style'. +-- +-- /Since: 0.3/ +renderB :: Doc -> Builder +renderB = renderStyleB style +{-# INLINE renderB #-} + +-- | Renders a 'Doc' to a 'Builder' using the given 'Style'. +-- +-- /Since: 0.2/ +renderStyleB :: Style -> Doc -> Builder +renderStyleB sty doc = fullRender (mode sty) + (lineLength sty) + (ribbonsPerLine sty) + txtPrinter + mempty + doc +{-# INLINE renderStyleB #-} + +txtPrinter :: TextDetails -> Builder -> Builder +txtPrinter (Chr c) b = s c <> b +txtPrinter (Str s') b = fromString s' <> b +txtPrinter (PStr s') b = fromString s' <> b +{-# INLINE txtPrinter #-} + +-- | Convert a 'Mode' to a 'Builder'. +-- +-- /Since: 0.1/ +showbMode :: Mode -> Builder +showbMode = showb +{-# INLINE showbMode #-} + +-- | Convert a 'Style' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbStylePrec :: Int -> Style -> Builder +showbStylePrec = showbPrec +{-# INLINE showbStylePrec #-} + +-- | Convert 'TextDetails' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbTextDetailsPrec :: Int -> TextDetails -> Builder +showbTextDetailsPrec = showbPrec +{-# INLINE showbTextDetailsPrec #-} + +#if MIN_VERSION_pretty(1,1,2) +-- | Convert a 'PrettyLevel' value to a 'Builder' with the given precedence. +-- This function is only available with @pretty-1.1.2.0@ or later. +-- +-- /Since: 0.1/ +showbPrettyLevelPrec :: Int -> PrettyLevel -> Builder +showbPrettyLevelPrec = showbPrec +{-# INLINE showbPrettyLevelPrec #-} +#endif + +instance Show Doc where + showb = renderB + INLINE_INST_FUN(showb) + +$(deriveShowPragmas defaultInlineShowb ''Mode) +$(deriveShow ''Style) +$(deriveShow ''TextDetails) + +#if MIN_VERSION_pretty(1,1,2) +$(deriveShowPragmas defaultInlineShowbPrec ''PrettyLevel) +#endif diff --git a/src/Text/Show/Text/Text/XHtml.hs b/src/Text/Show/Text/Text/XHtml.hs --- a/src/Text/Show/Text/Text/XHtml.hs +++ b/src/Text/Show/Text/Text/XHtml.hs @@ -1,91 +1,91 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Text.XHtml -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @xhtml@ library. - -/Since: 0.1/ --} -module Text.Show.Text.Text.XHtml ( - showbHtml - , showbHtmlList - , showbHtmlAttr - , showbHotLinkPrec - , showbHtmlTable - ) where - -#if !(MIN_VERSION_base(4,8,0)) -import Data.Monoid (mconcat) -#endif - -import Prelude hiding (Show) - -import Text.Show.Text (Show(..), Builder, FromStringShow(..), fromString) -import Text.Show.Text.Data.Char (showbString) -import Text.Show.Text.TH (deriveShow) -import Text.Show.Text.Utils ((<>), s) -import Text.XHtml.Frameset (Html, HtmlAttr, HotLink, - htmlAttrPair, renderHtmlFragment) -import Text.XHtml.Table (HtmlTable) - -#include "inline.h" - --- | Convert an 'Html' value to a 'Builder'. --- --- /Since: 0.1/ -showbHtml :: Html -> Builder -showbHtml = fromString . renderHtmlFragment -{-# INLINE showbHtml #-} - --- | Convert a list of 'Html' values to a 'Builder'. --- --- /Since: 0.1/ -showbHtmlList :: [Html] -> Builder -showbHtmlList = mconcat . map showb -{-# INLINE showbHtmlList #-} - --- | Convert an 'HtmlAttr' to a 'Builder'. --- --- /Since: 0.1/ -showbHtmlAttr :: HtmlAttr -> Builder -showbHtmlAttr ha = case htmlAttrPair ha of - (str, val) -> fromString str <> s '=' <> showbString val -{-# INLINE showbHtmlAttr #-} - --- | Convert a 'HotLink' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbHotLinkPrec :: Int -> HotLink -> Builder -showbHotLinkPrec = showbPrec -{-# INLINE showbHotLinkPrec #-} - --- | Convert an 'HtmlTable' to a 'Builder'. --- --- /Since: 0.1/ -showbHtmlTable :: HtmlTable -> Builder -showbHtmlTable = showb . FromStringShow -{-# INLINE showbHtmlTable #-} - -instance Show Html where - showb = showbHtml - INLINE_INST_FUN(showb) - - showbList = showbHtmlList - INLINE_INST_FUN(showbList) - -instance Show HtmlAttr where - showb = showbHtmlAttr - INLINE_INST_FUN(showb) - -$(deriveShow ''HotLink) - -instance Show HtmlTable where - showb = showbHtmlTable - INLINE_INST_FUN(showb) +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Text.XHtml +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @xhtml@ library. + +/Since: 0.1/ +-} +module Text.Show.Text.Text.XHtml ( + showbHtml + , showbHtmlList + , showbHtmlAttr + , showbHotLinkPrec + , showbHtmlTable + ) where + +#if !(MIN_VERSION_base(4,8,0)) +import Data.Monoid (mconcat) +#endif + +import Prelude hiding (Show) + +import Text.Show.Text (Show(..), Builder, FromStringShow(..), fromString) +import Text.Show.Text.Data.Char (showbString) +import Text.Show.Text.TH (deriveShow) +import Text.Show.Text.Utils ((<>), s) +import Text.XHtml.Frameset (Html, HtmlAttr, HotLink, + htmlAttrPair, renderHtmlFragment) +import Text.XHtml.Table (HtmlTable) + +#include "inline.h" + +-- | Convert an 'Html' value to a 'Builder'. +-- +-- /Since: 0.1/ +showbHtml :: Html -> Builder +showbHtml = fromString . renderHtmlFragment +{-# INLINE showbHtml #-} + +-- | Convert a list of 'Html' values to a 'Builder'. +-- +-- /Since: 0.1/ +showbHtmlList :: [Html] -> Builder +showbHtmlList = mconcat . map showb +{-# INLINE showbHtmlList #-} + +-- | Convert an 'HtmlAttr' to a 'Builder'. +-- +-- /Since: 0.1/ +showbHtmlAttr :: HtmlAttr -> Builder +showbHtmlAttr ha = case htmlAttrPair ha of + (str, val) -> fromString str <> s '=' <> showbString val +{-# INLINE showbHtmlAttr #-} + +-- | Convert a 'HotLink' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbHotLinkPrec :: Int -> HotLink -> Builder +showbHotLinkPrec = showbPrec +{-# INLINE showbHotLinkPrec #-} + +-- | Convert an 'HtmlTable' to a 'Builder'. +-- +-- /Since: 0.1/ +showbHtmlTable :: HtmlTable -> Builder +showbHtmlTable = showb . FromStringShow +{-# INLINE showbHtmlTable #-} + +instance Show Html where + showb = showbHtml + INLINE_INST_FUN(showb) + + showbList = showbHtmlList + INLINE_INST_FUN(showbList) + +instance Show HtmlAttr where + showb = showbHtmlAttr + INLINE_INST_FUN(showb) + +$(deriveShow ''HotLink) + +instance Show HtmlTable where + showb = showbHtmlTable + INLINE_INST_FUN(showb) diff --git a/src/Text/Show/Text/Trace.hs b/src/Text/Show/Text/Trace.hs --- a/src/Text/Show/Text/Trace.hs +++ b/src/Text/Show/Text/Trace.hs @@ -1,13 +1,13 @@ -{-| -Module: Text.Show.Text.Trace -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Imports 'Show' instances for @Trace@ modules. --} -module Text.Show.Text.Trace () where - +{-| +Module: Text.Show.Text.Trace +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Imports 'Show' instances for @Trace@ modules. +-} +module Text.Show.Text.Trace () where + import Text.Show.Text.Trace.Hpc () diff --git a/src/Text/Show/Text/Trace/Hpc.hs b/src/Text/Show/Text/Trace/Hpc.hs --- a/src/Text/Show/Text/Trace/Hpc.hs +++ b/src/Text/Show/Text/Trace/Hpc.hs @@ -1,106 +1,106 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Text.Show.Text.Trace.Hpc -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Monomorphic 'Show' functions for data types in the @hpc@ library. - -/Since: 0.1/ --} -module Text.Show.Text.Trace.Hpc ( - showbMixPrec - , showbBoxLabelPrec - , showbCondBox - , showbTixPrec - , showbTixModulePrec - , showbHpcPos - , showbHash - ) where - -import Prelude hiding (Show) - -import Text.Show.Text (Show(showb, showbPrec), Builder, FromStringShow(..)) -import Text.Show.Text.Data.Integral (showbIntPrec) -import Text.Show.Text.Data.Time () -import Text.Show.Text.TH (deriveShow, deriveShowPragmas, - defaultInlineShowb, defaultInlineShowbPrec) -import Text.Show.Text.Utils ((<>), s) - -import Trace.Hpc.Mix (Mix, BoxLabel, CondBox) -import Trace.Hpc.Tix (Tix, TixModule) -import Trace.Hpc.Util (HpcPos, Hash, fromHpcPos) - -#include "inline.h" - --- | Convert a 'Mix' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbMixPrec :: Int -> Mix -> Builder -showbMixPrec = showbPrec -{-# INLINE showbMixPrec #-} - --- | Convert a 'BoxLabel' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbBoxLabelPrec :: Int -> BoxLabel -> Builder -showbBoxLabelPrec = showbPrec -{-# INLINE showbBoxLabelPrec #-} - --- | Convert a 'CondBox' to a 'Builder'. --- --- /Since: 0.1/ -showbCondBox :: CondBox -> Builder -showbCondBox = showb -{-# INLINE showbCondBox #-} - --- | Convert a 'Tix' value to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbTixPrec :: Int -> Tix -> Builder -showbTixPrec = showbPrec -{-# INLINE showbTixPrec #-} - --- | Convert a 'TixModule' to a 'Builder' with the given precedence. --- --- /Since: 0.1/ -showbTixModulePrec :: Int -> TixModule -> Builder -showbTixModulePrec = showbPrec -{-# INLINE showbTixModulePrec #-} - --- | Convert a 'HpcPos' to a 'Builder'. --- --- /Since: 0.1/ -showbHpcPos :: HpcPos -> Builder -showbHpcPos hp = case fromHpcPos hp of - (l1, c1, l2, c2) -> showbIntPrec 0 l1 - <> (s ':' <> showbIntPrec 0 c1) - <> (s '-' <> showbIntPrec 0 l2) - <> (s ':' <> showbIntPrec 0 c2) -{-# INLINE showbHpcPos #-} - --- | Convert a 'Hash' to a 'Builder'. --- --- /Since: 0.1/ -showbHash :: Hash -> Builder -showbHash = showb . FromStringShow -{-# INLINE showbHash #-} - -$(deriveShow ''Mix) -$(deriveShow ''BoxLabel) -$(deriveShowPragmas defaultInlineShowb ''CondBox) -$(deriveShowPragmas defaultInlineShowbPrec ''Tix) -$(deriveShow ''TixModule) - -instance Show HpcPos where - showb = showbHpcPos - INLINE_INST_FUN(showb) - -instance Show Hash where - showb = showbHash - INLINE_INST_FUN(showb) +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Text.Show.Text.Trace.Hpc +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Monomorphic 'Show' functions for data types in the @hpc@ library. + +/Since: 0.1/ +-} +module Text.Show.Text.Trace.Hpc ( + showbMixPrec + , showbBoxLabelPrec + , showbCondBox + , showbTixPrec + , showbTixModulePrec + , showbHpcPos + , showbHash + ) where + +import Prelude hiding (Show) + +import Text.Show.Text (Show(showb, showbPrec), Builder, FromStringShow(..)) +import Text.Show.Text.Data.Integral (showbIntPrec) +import Text.Show.Text.Data.Time () +import Text.Show.Text.TH (deriveShow, deriveShowPragmas, + defaultInlineShowb, defaultInlineShowbPrec) +import Text.Show.Text.Utils ((<>), s) + +import Trace.Hpc.Mix (Mix, BoxLabel, CondBox) +import Trace.Hpc.Tix (Tix, TixModule) +import Trace.Hpc.Util (HpcPos, Hash, fromHpcPos) + +#include "inline.h" + +-- | Convert a 'Mix' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbMixPrec :: Int -> Mix -> Builder +showbMixPrec = showbPrec +{-# INLINE showbMixPrec #-} + +-- | Convert a 'BoxLabel' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbBoxLabelPrec :: Int -> BoxLabel -> Builder +showbBoxLabelPrec = showbPrec +{-# INLINE showbBoxLabelPrec #-} + +-- | Convert a 'CondBox' to a 'Builder'. +-- +-- /Since: 0.1/ +showbCondBox :: CondBox -> Builder +showbCondBox = showb +{-# INLINE showbCondBox #-} + +-- | Convert a 'Tix' value to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbTixPrec :: Int -> Tix -> Builder +showbTixPrec = showbPrec +{-# INLINE showbTixPrec #-} + +-- | Convert a 'TixModule' to a 'Builder' with the given precedence. +-- +-- /Since: 0.1/ +showbTixModulePrec :: Int -> TixModule -> Builder +showbTixModulePrec = showbPrec +{-# INLINE showbTixModulePrec #-} + +-- | Convert a 'HpcPos' to a 'Builder'. +-- +-- /Since: 0.1/ +showbHpcPos :: HpcPos -> Builder +showbHpcPos hp = case fromHpcPos hp of + (l1, c1, l2, c2) -> showbIntPrec 0 l1 + <> (s ':' <> showbIntPrec 0 c1) + <> (s '-' <> showbIntPrec 0 l2) + <> (s ':' <> showbIntPrec 0 c2) +{-# INLINE showbHpcPos #-} + +-- | Convert a 'Hash' to a 'Builder'. +-- +-- /Since: 0.1/ +showbHash :: Hash -> Builder +showbHash = showb . FromStringShow +{-# INLINE showbHash #-} + +$(deriveShow ''Mix) +$(deriveShow ''BoxLabel) +$(deriveShowPragmas defaultInlineShowb ''CondBox) +$(deriveShowPragmas defaultInlineShowbPrec ''Tix) +$(deriveShow ''TixModule) + +instance Show HpcPos where + showb = showbHpcPos + INLINE_INST_FUN(showb) + +instance Show Hash where + showb = showbHash + INLINE_INST_FUN(showb) diff --git a/src/Text/Show/Text/Utils.hs b/src/Text/Show/Text/Utils.hs --- a/src/Text/Show/Text/Utils.hs +++ b/src/Text/Show/Text/Utils.hs @@ -1,38 +1,38 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-| -Module: Text.Show.Text.Utils -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Miscellaneous utility functions. --} -module Text.Show.Text.Utils where - -#if !(MIN_VERSION_base(4,8,0)) -import Data.Monoid (Monoid(mappend)) -#endif -import Prelude hiding (Show) -import Text.Show.Text (Show, Builder, showbUnary, singleton) - -infixr 6 <> - --- | Infix 'mappend', defined here for backwards-compatibility with older versions --- of @base@. -(<>) :: Monoid m => m -> m -> m -(<>) = mappend -{-# INLINE (<>) #-} - --- | A shorter name for 'singleton' for convenience's sake (since it tends to be used --- pretty often in @text-show-instances@). -s :: Char -> Builder -s = singleton -{-# INLINE s #-} - --- | This pattern is used frequently when showing container types. -showbUnaryList :: Show a => Int -> [a] -> Builder -showbUnaryList p = showbUnary "fromList" p -{-# INLINE showbUnaryList #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-| +Module: Text.Show.Text.Utils +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Miscellaneous utility functions. +-} +module Text.Show.Text.Utils where + +#if !(MIN_VERSION_base(4,8,0)) +import Data.Monoid (Monoid(mappend)) +#endif +import Prelude hiding (Show) +import Text.Show.Text (Show, Builder, showbUnary, singleton) + +infixr 6 <> + +-- | Infix 'mappend', defined here for backwards-compatibility with older versions +-- of @base@. +(<>) :: Monoid m => m -> m -> m +(<>) = mappend +{-# INLINE (<>) #-} + +-- | A shorter name for 'singleton' for convenience's sake (since it tends to be used +-- pretty often in @text-show-instances@). +s :: Char -> Builder +s = singleton +{-# INLINE s #-} + +-- | This pattern is used frequently when showing container types. +showbUnaryList :: Show a => Int -> [a] -> Builder +showbUnaryList p = showbUnary "fromList" p +{-# INLINE showbUnaryList #-} diff --git a/tests/Instances/Compiler/Hoopl.hs b/tests/Instances/Compiler/Hoopl.hs --- a/tests/Instances/Compiler/Hoopl.hs +++ b/tests/Instances/Compiler/Hoopl.hs @@ -1,75 +1,75 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Compiler.Hoopl -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for data types in the @hoopl@ library. --} -module Instances.Compiler.Hoopl () where - -import Compiler.Hoopl (Label, LabelMap, LabelSet, Pointed(..), - UniqueMap, UniqueSet, C, mapFromList, setFromList) -#if MIN_VERSION_hoopl(3,9,0) -import Compiler.Hoopl.Internals (uniqueToLbl) -#else -import Compiler.Hoopl (Unique, intToUnique) -import Compiler.Hoopl.GHC (uniqueToLbl) -#endif -import Compiler.Hoopl.Passes.Dominator (DominatorNode(..), DominatorTree(..), DPath(..)) - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative (pure) - -import Data.Functor ((<$>)) -#endif - -import Instances.Utils ((<@>)) - -import Test.Tasty.QuickCheck (Arbitrary(..), oneof) - -instance Arbitrary Label where - arbitrary = uniqueToLbl <$> arbitrary - -instance Arbitrary v => Arbitrary (LabelMap v) where - arbitrary = mapFromList <$> arbitrary - -instance Arbitrary LabelSet where - arbitrary = setFromList <$> arbitrary - -instance Arbitrary a => Arbitrary (Pointed C C a) where - arbitrary = oneof [pure Bot, PElem <$> arbitrary, pure Top] - -#if !(MIN_VERSION_hoopl(3,9,0)) -instance Arbitrary Unique where - arbitrary = intToUnique <$> arbitrary -#endif - -instance Arbitrary v => Arbitrary (UniqueMap v) where - arbitrary = mapFromList <$> arbitrary - -instance Arbitrary UniqueSet where - arbitrary = setFromList <$> arbitrary - -instance Arbitrary DominatorNode where - arbitrary = oneof [pure Entry, Labelled <$> arbitrary] - -instance Arbitrary DominatorTree where - arbitrary = Dominates <$> arbitrary <@> [fDominatorTree] --- arbitrary = Dominates <$> arbitrary <*> arbitrary - -deriving instance Arbitrary DPath - -------------------------------------------------------------------------------- --- Workarounds to make Arbitrary instances faster -------------------------------------------------------------------------------- - -fDominatorTree :: DominatorTree -fDominatorTree = Dominates Entry [] +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Compiler.Hoopl +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for data types in the @hoopl@ library. +-} +module Instances.Compiler.Hoopl () where + +import Compiler.Hoopl (Label, LabelMap, LabelSet, Pointed(..), + UniqueMap, UniqueSet, C, mapFromList, setFromList) +#if MIN_VERSION_hoopl(3,9,0) +import Compiler.Hoopl.Internals (uniqueToLbl) +#else +import Compiler.Hoopl (Unique, intToUnique) +import Compiler.Hoopl.GHC (uniqueToLbl) +#endif +import Compiler.Hoopl.Passes.Dominator (DominatorNode(..), DominatorTree(..), DPath(..)) + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative (pure) + +import Data.Functor ((<$>)) +#endif + +import Instances.Utils ((<@>)) + +import Test.Tasty.QuickCheck (Arbitrary(..), oneof) + +instance Arbitrary Label where + arbitrary = uniqueToLbl <$> arbitrary + +instance Arbitrary v => Arbitrary (LabelMap v) where + arbitrary = mapFromList <$> arbitrary + +instance Arbitrary LabelSet where + arbitrary = setFromList <$> arbitrary + +instance Arbitrary a => Arbitrary (Pointed C C a) where + arbitrary = oneof [pure Bot, PElem <$> arbitrary, pure Top] + +#if !(MIN_VERSION_hoopl(3,9,0)) +instance Arbitrary Unique where + arbitrary = intToUnique <$> arbitrary +#endif + +instance Arbitrary v => Arbitrary (UniqueMap v) where + arbitrary = mapFromList <$> arbitrary + +instance Arbitrary UniqueSet where + arbitrary = setFromList <$> arbitrary + +instance Arbitrary DominatorNode where + arbitrary = oneof [pure Entry, Labelled <$> arbitrary] + +instance Arbitrary DominatorTree where + arbitrary = Dominates <$> arbitrary <@> [fDominatorTree] +-- arbitrary = Dominates <$> arbitrary <*> arbitrary + +deriving instance Arbitrary DPath + +------------------------------------------------------------------------------- +-- Workarounds to make Arbitrary instances faster +------------------------------------------------------------------------------- + +fDominatorTree :: DominatorTree +fDominatorTree = Dominates Entry [] diff --git a/tests/Instances/Control/Applicative/Trans.hs b/tests/Instances/Control/Applicative/Trans.hs --- a/tests/Instances/Control/Applicative/Trans.hs +++ b/tests/Instances/Control/Applicative/Trans.hs @@ -1,30 +1,30 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Control.Applicative.Trans -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for applicative functor transformers. --} -module Instances.Control.Applicative.Trans () where - -import Control.Applicative.Backwards (Backwards(..)) -import Control.Applicative.Lift (Lift(..)) - -#if !(MIN_VERSION_base(4,8,0)) -import Data.Functor ((<$>)) -#endif - -import Test.Tasty.QuickCheck (Arbitrary(..), oneof) - -deriving instance Arbitrary (f a) => Arbitrary (Backwards f a) - -instance (Arbitrary a, Arbitrary (f a)) => Arbitrary (Lift f a) where - arbitrary = oneof [Pure <$> arbitrary, Other <$> arbitrary] +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Control.Applicative.Trans +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for applicative functor transformers. +-} +module Instances.Control.Applicative.Trans () where + +import Control.Applicative.Backwards (Backwards(..)) +import Control.Applicative.Lift (Lift(..)) + +#if !(MIN_VERSION_base(4,8,0)) +import Data.Functor ((<$>)) +#endif + +import Test.Tasty.QuickCheck (Arbitrary(..), oneof) + +deriving instance Arbitrary (f a) => Arbitrary (Backwards f a) + +instance (Arbitrary a, Arbitrary (f a)) => Arbitrary (Lift f a) where + arbitrary = oneof [Pure <$> arbitrary, Other <$> arbitrary] diff --git a/tests/Instances/Control/Monad/Trans.hs b/tests/Instances/Control/Monad/Trans.hs --- a/tests/Instances/Control/Monad/Trans.hs +++ b/tests/Instances/Control/Monad/Trans.hs @@ -1,35 +1,35 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -{-| -Module: Instances.Control.Monad.Trans -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for monad transformers. --} -module Instances.Control.Monad.Trans () where - -import Control.Monad.Trans.Error (ErrorT(..)) -import Control.Monad.Trans.Except (ExceptT(..)) -import Control.Monad.Trans.Identity (IdentityT(..)) -import Control.Monad.Trans.List (ListT(..)) -import Control.Monad.Trans.Maybe (MaybeT(..)) -import qualified Control.Monad.Trans.Writer.Lazy as WL (WriterT(..)) -import qualified Control.Monad.Trans.Writer.Strict as WS (WriterT(..)) - -import Test.Tasty.QuickCheck (Arbitrary) - -deriving instance Arbitrary (m (Either e a)) => Arbitrary (ErrorT e m a) -deriving instance Arbitrary (m (Either e a)) => Arbitrary (ExceptT e m a) -deriving instance Arbitrary (f a) => Arbitrary (IdentityT f a) -deriving instance Arbitrary (m [a]) => Arbitrary (ListT m a) -deriving instance Arbitrary (m (Maybe a)) => Arbitrary (MaybeT m a) -deriving instance Arbitrary (m (a, w)) => Arbitrary (WL.WriterT w m a) -deriving instance Arbitrary (m (a, w)) => Arbitrary (WS.WriterT w m a) +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +{-| +Module: Instances.Control.Monad.Trans +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for monad transformers. +-} +module Instances.Control.Monad.Trans () where + +import Control.Monad.Trans.Error (ErrorT(..)) +import Control.Monad.Trans.Except (ExceptT(..)) +import Control.Monad.Trans.Identity (IdentityT(..)) +import Control.Monad.Trans.List (ListT(..)) +import Control.Monad.Trans.Maybe (MaybeT(..)) +import qualified Control.Monad.Trans.Writer.Lazy as WL (WriterT(..)) +import qualified Control.Monad.Trans.Writer.Strict as WS (WriterT(..)) + +import Test.Tasty.QuickCheck (Arbitrary) + +deriving instance Arbitrary (m (Either e a)) => Arbitrary (ErrorT e m a) +deriving instance Arbitrary (m (Either e a)) => Arbitrary (ExceptT e m a) +deriving instance Arbitrary (f a) => Arbitrary (IdentityT f a) +deriving instance Arbitrary (m [a]) => Arbitrary (ListT m a) +deriving instance Arbitrary (m (Maybe a)) => Arbitrary (MaybeT m a) +deriving instance Arbitrary (m (a, w)) => Arbitrary (WL.WriterT w m a) +deriving instance Arbitrary (m (a, w)) => Arbitrary (WS.WriterT w m a) diff --git a/tests/Instances/Data/Binary.hs b/tests/Instances/Data/Binary.hs --- a/tests/Instances/Data/Binary.hs +++ b/tests/Instances/Data/Binary.hs @@ -1,31 +1,31 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Data.Binary -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides an 'Arbitrary' instance for 'Decoder's. --} -module Instances.Data.Binary () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>)) - -import Data.Functor ((<$>)) -#endif - -import Data.Binary.Get.Internal (Decoder(..)) - -import Test.QuickCheck.Instances () -import Test.Tasty.QuickCheck (Arbitrary(..), oneof) - -instance Arbitrary a => Arbitrary (Decoder a) where - arbitrary = oneof [ Fail <$> arbitrary <*> arbitrary - , Partial <$> arbitrary - , Done <$> arbitrary <*> arbitrary - , BytesRead <$> arbitrary <*> arbitrary - ] +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Data.Binary +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides an 'Arbitrary' instance for 'Decoder's. +-} +module Instances.Data.Binary () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>)) + +import Data.Functor ((<$>)) +#endif + +import Data.Binary.Get.Internal (Decoder(..)) + +import Test.QuickCheck.Instances () +import Test.Tasty.QuickCheck (Arbitrary(..), oneof) + +instance Arbitrary a => Arbitrary (Decoder a) where + arbitrary = oneof [ Fail <$> arbitrary <*> arbitrary + , Partial <$> arbitrary + , Done <$> arbitrary <*> arbitrary + , BytesRead <$> arbitrary <*> arbitrary + ] diff --git a/tests/Instances/Data/Containers.hs b/tests/Instances/Data/Containers.hs --- a/tests/Instances/Data/Containers.hs +++ b/tests/Instances/Data/Containers.hs @@ -1,29 +1,29 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Data.Containers -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for data types located in @containers@. --} -module Instances.Data.Containers () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>), pure) -import Data.Functor ((<$>)) -#endif - -import Data.Sequence (ViewL(..), ViewR(..)) - -import Test.QuickCheck.Instances () -import Test.Tasty.QuickCheck (Arbitrary(..), oneof) - -instance Arbitrary a => Arbitrary (ViewL a) where - arbitrary = oneof [pure EmptyL, (:<) <$> arbitrary <*> arbitrary] - -instance Arbitrary a => Arbitrary (ViewR a) where - arbitrary = oneof [pure EmptyR, (:>) <$> arbitrary <*> arbitrary] +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Data.Containers +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for data types located in @containers@. +-} +module Instances.Data.Containers () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>), pure) +import Data.Functor ((<$>)) +#endif + +import Data.Sequence (ViewL(..), ViewR(..)) + +import Test.QuickCheck.Instances () +import Test.Tasty.QuickCheck (Arbitrary(..), oneof) + +instance Arbitrary a => Arbitrary (ViewL a) where + arbitrary = oneof [pure EmptyL, (:<) <$> arbitrary <*> arbitrary] + +instance Arbitrary a => Arbitrary (ViewR a) where + arbitrary = oneof [pure EmptyR, (:>) <$> arbitrary <*> arbitrary] diff --git a/tests/Instances/Data/Functor/Trans.hs b/tests/Instances/Data/Functor/Trans.hs --- a/tests/Instances/Data/Functor/Trans.hs +++ b/tests/Instances/Data/Functor/Trans.hs @@ -1,40 +1,40 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Data.Functor.Trans -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for functor transformers. --} -module Instances.Data.Functor.Trans () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>)) - -import Data.Functor ((<$>)) -#endif - -import Data.Functor.Compose (Compose(..)) -import Data.Functor.Constant (Constant(..)) -import Data.Functor.Product (Product(..)) -import Data.Functor.Reverse (Reverse(..)) -import Data.Functor.Sum (Sum(..)) - -import Test.Tasty.QuickCheck (Arbitrary(..), oneof) - -deriving instance Arbitrary (f (g a)) => Arbitrary (Compose f g a) -deriving instance Arbitrary a => Arbitrary (Constant a b) -deriving instance Arbitrary (f a) => Arbitrary (Reverse f a) - -instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Product f g a) where - arbitrary = Pair <$> arbitrary <*> arbitrary - -instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Sum f g a) where - arbitrary = oneof [InL <$> arbitrary, InR <$> arbitrary] +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Data.Functor.Trans +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for functor transformers. +-} +module Instances.Data.Functor.Trans () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>)) + +import Data.Functor ((<$>)) +#endif + +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Constant (Constant(..)) +import Data.Functor.Product (Product(..)) +import Data.Functor.Reverse (Reverse(..)) +import Data.Functor.Sum (Sum(..)) + +import Test.Tasty.QuickCheck (Arbitrary(..), oneof) + +deriving instance Arbitrary (f (g a)) => Arbitrary (Compose f g a) +deriving instance Arbitrary a => Arbitrary (Constant a b) +deriving instance Arbitrary (f a) => Arbitrary (Reverse f a) + +instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Product f g a) where + arbitrary = Pair <$> arbitrary <*> arbitrary + +instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Sum f g a) where + arbitrary = oneof [InL <$> arbitrary, InR <$> arbitrary] diff --git a/tests/Instances/Data/List/NonEmpty.hs b/tests/Instances/Data/List/NonEmpty.hs --- a/tests/Instances/Data/List/NonEmpty.hs +++ b/tests/Instances/Data/List/NonEmpty.hs @@ -1,24 +1,24 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Data.List.NonEmpty -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides an 'Arbitrary' instance for 'NonEmpty' lists. --} -module Instances.Data.List.NonEmpty () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>)) -import Data.Functor ((<$>)) -#endif - -import Data.List.NonEmpty (NonEmpty(..)) -import Test.Tasty.QuickCheck (Arbitrary(..)) - -instance Arbitrary a => Arbitrary (NonEmpty a) where - arbitrary = (:|) <$> arbitrary <*> arbitrary +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Data.List.NonEmpty +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides an 'Arbitrary' instance for 'NonEmpty' lists. +-} +module Instances.Data.List.NonEmpty () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>)) +import Data.Functor ((<$>)) +#endif + +import Data.List.NonEmpty (NonEmpty(..)) +import Test.Tasty.QuickCheck (Arbitrary(..)) + +instance Arbitrary a => Arbitrary (NonEmpty a) where + arbitrary = (:|) <$> arbitrary <*> arbitrary diff --git a/tests/Instances/Data/Semigroup.hs b/tests/Instances/Data/Semigroup.hs --- a/tests/Instances/Data/Semigroup.hs +++ b/tests/Instances/Data/Semigroup.hs @@ -1,34 +1,34 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Data.Semigroup -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for @Semigroup@ data types. --} -module Instances.Data.Semigroup () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>)) -import Data.Functor ((<$>)) -#endif - -import Data.Semigroup (Min(..), Max(..), First(..), Last(..), - WrappedMonoid(..), Option(..), Arg(..)) -import Test.Tasty.QuickCheck (Arbitrary(..)) - -deriving instance Arbitrary a => Arbitrary (Min a) -deriving instance Arbitrary a => Arbitrary (Max a) -deriving instance Arbitrary a => Arbitrary (First a) -deriving instance Arbitrary a => Arbitrary (Last a) -deriving instance Arbitrary m => Arbitrary (WrappedMonoid m) -deriving instance Arbitrary a => Arbitrary (Option a) - -instance (Arbitrary a, Arbitrary b) => Arbitrary (Arg a b) where - arbitrary = Arg <$> arbitrary <*> arbitrary +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Data.Semigroup +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for @Semigroup@ data types. +-} +module Instances.Data.Semigroup () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>)) +import Data.Functor ((<$>)) +#endif + +import Data.Semigroup (Min(..), Max(..), First(..), Last(..), + WrappedMonoid(..), Option(..), Arg(..)) +import Test.Tasty.QuickCheck (Arbitrary(..)) + +deriving instance Arbitrary a => Arbitrary (Min a) +deriving instance Arbitrary a => Arbitrary (Max a) +deriving instance Arbitrary a => Arbitrary (First a) +deriving instance Arbitrary a => Arbitrary (Last a) +deriving instance Arbitrary m => Arbitrary (WrappedMonoid m) +deriving instance Arbitrary a => Arbitrary (Option a) + +instance (Arbitrary a, Arbitrary b) => Arbitrary (Arg a b) where + arbitrary = Arg <$> arbitrary <*> arbitrary diff --git a/tests/Instances/Data/String/UTF8.hs b/tests/Instances/Data/String/UTF8.hs --- a/tests/Instances/Data/String/UTF8.hs +++ b/tests/Instances/Data/String/UTF8.hs @@ -1,23 +1,23 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Data.String.UTF8 -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides an 'Arbitrary' instance for 'UTF8' strings. --} -module Instances.Data.String.UTF8 () where - -#if !(MIN_VERSION_base(4,8,0)) -import Data.Functor ((<$>)) -#endif -import Data.String.UTF8 (UTF8, fromRep) - -import Test.Tasty.QuickCheck (Arbitrary(..)) - -instance Arbitrary a => Arbitrary (UTF8 a) where - arbitrary = fromRep <$> arbitrary +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Data.String.UTF8 +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides an 'Arbitrary' instance for 'UTF8' strings. +-} +module Instances.Data.String.UTF8 () where + +#if !(MIN_VERSION_base(4,8,0)) +import Data.Functor ((<$>)) +#endif +import Data.String.UTF8 (UTF8, fromRep) + +import Test.Tasty.QuickCheck (Arbitrary(..)) + +instance Arbitrary a => Arbitrary (UTF8 a) where + arbitrary = fromRep <$> arbitrary diff --git a/tests/Instances/Data/Tagged.hs b/tests/Instances/Data/Tagged.hs --- a/tests/Instances/Data/Tagged.hs +++ b/tests/Instances/Data/Tagged.hs @@ -1,19 +1,19 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Data.Tagged -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides an 'Arbitrary' instance for 'Tagged' values. --} -module Instances.Data.Tagged () where - -import Data.Tagged (Tagged(..)) -import Test.Tasty.QuickCheck (Arbitrary) - -deriving instance Arbitrary b => Arbitrary (Tagged s b) +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Data.Tagged +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides an 'Arbitrary' instance for 'Tagged' values. +-} +module Instances.Data.Tagged () where + +import Data.Tagged (Tagged(..)) +import Test.Tasty.QuickCheck (Arbitrary) + +deriving instance Arbitrary b => Arbitrary (Tagged s b) diff --git a/tests/Instances/Language/Haskell/TH.hs b/tests/Instances/Language/Haskell/TH.hs --- a/tests/Instances/Language/Haskell/TH.hs +++ b/tests/Instances/Language/Haskell/TH.hs @@ -1,618 +1,618 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeSynonymInstances #-} -#if !(MIN_VERSION_template_haskell(2,10,0)) -{-# LANGUAGE MagicHash #-} -#endif -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Language.Haskell.TH -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for data types in the @template-haskell@ library. --} -module Instances.Language.Haskell.TH () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>), pure) - -import Data.Functor ((<$>)) -#endif - -#if !(MIN_VERSION_template_haskell(2,10,0)) -import GHC.Exts (Int(I#)) -#endif - -import Instances.Utils ((<@>)) - -import Language.Haskell.TH.PprLib (Doc, text) -import Language.Haskell.TH.Syntax -#if !(MIN_VERSION_template_haskell(2,8,0)) -import Language.Haskell.TH.Syntax.Internals -#endif - -import Test.Tasty.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) - -instance Arbitrary Body where - arbitrary = oneof $ map pure [ GuardedB [(fGuard, fExp)] - , NormalB fExp - ] --- arbitrary = oneof [GuardedB <$> arbitrary, NormalB <$> arbitrary] - -deriving instance Bounded Callconv -deriving instance Enum Callconv -instance Arbitrary Callconv where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary Clause where - arbitrary = pure $ Clause [fPat] fBody [fDec] --- arbitrary = Clause <$> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary Con where - arbitrary = oneof [ NormalC <$> arbitrary <*> arbitrary - , RecC <$> arbitrary <*> arbitrary - , InfixC <$> arbitrary <*> arbitrary <*> arbitrary - , ForallC <$> arbitrary <@> [fPred] <@> fCon - ] --- arbitrary = oneof [ NormalC <$> arbitrary <*> arbitrary --- , RecC <$> arbitrary <*> arbitrary --- , InfixC <$> arbitrary <*> arbitrary <*> arbitrary --- , ForallC <$> arbitrary <*> arbitrary <*> arbitrary --- ] - -instance Arbitrary Dec where - arbitrary = oneof [ - FunD <$> arbitrary <@> [fClause] - , pure $ ValD fPat fBody [fDec] - , DataD [fPred] <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - , NewtypeD [fPred] <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - , TySynD <$> arbitrary <*> arbitrary <*> arbitrary - , ClassD [fPred] <$> arbitrary <*> arbitrary <*> arbitrary <@> [fDec] - , InstanceD [fPred] <$> arbitrary <@> [fDec] - , SigD <$> arbitrary <*> arbitrary - , ForeignD <$> arbitrary - , PragmaD <$> arbitrary - , FamilyD <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - , DataInstD [fPred] <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - , NewtypeInstD [fPred] <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -#if MIN_VERSION_template_haskell(2,8,0) - , InfixD <$> arbitrary <*> arbitrary -#endif -#if MIN_VERSION_template_haskell(2,9,0) - , ClosedTypeFamilyD <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - , RoleAnnotD <$> arbitrary <*> arbitrary - , TySynInstD <$> arbitrary <*> arbitrary -#else - , TySynInstD <$> arbitrary <*> arbitrary <*> arbitrary -#endif -#if MIN_VERSION_template_haskell(2,10,0) - , StandaloneDerivD <$> arbitrary <*> arbitrary - , DefaultSigD <$> arbitrary <*> arbitrary -#endif - ] --- arbitrary = oneof [ --- FunD <$> arbitrary <*> arbitrary --- , ValD <$> arbitrary <*> arbitrary <*> arbitrary --- , DataD <$> arbitrary <*> arbitrary <*> arbitrary --- <*> arbitrary <*> arbitrary --- , NewtypeD <$> arbitrary <*> arbitrary <*> arbitrary --- <*> arbitrary <*> arbitrary --- , TySynD <$> arbitrary <*> arbitrary <*> arbitrary --- , ClassD <$> arbitrary <*> arbitrary <*> arbitrary --- <*> arbitrary <*> arbitrary --- , InstanceD <$> arbitrary <*> arbitrary <*> arbitrary --- , SigD <$> arbitrary <*> arbitrary --- , ForeignD <$> arbitrary --- , PragmaD <$> arbitrary --- , FamilyD <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary --- , DataInstD <$> arbitrary <*> arbitrary <*> arbitrary --- <*> arbitrary <*> arbitrary --- , NewtypeInstD <$> arbitrary <*> arbitrary <*> arbitrary --- <*> arbitrary <*> arbitrary --- #if MIN_VERSION_template_haskell(2,8,0) --- , InfixD <$> arbitrary <*> arbitrary --- #endif --- #if MIN_VERSION_template_haskell(2,9,0) --- , ClosedTypeFamilyD <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary --- , RoleAnnotD <$> arbitrary <*> arbitrary --- , TySynInstD <$> arbitrary <*> arbitrary --- #else --- , TySynInstD <$> arbitrary <*> arbitrary <*> arbitrary --- #endif --- #if MIN_VERSION_template_haskell(2,10,0) --- , StandaloneDerivD <$> arbitrary <*> arbitrary --- , DefaultSigD <$> arbitrary <*> arbitrary --- #endif --- ] - -instance Arbitrary Exp where - arbitrary = oneof [ VarE <$> arbitrary - , ConE <$> arbitrary - , LitE <$> arbitrary - , pure $ AppE fExp fExp - , pure $ InfixE (Just fExp) fExp (Just fExp) - , pure $ LamE [fPat] fExp - , pure $ TupE [fExp] - , pure $ CondE fExp fExp fExp - , pure $ LetE [fDec] fExp - , pure $ CaseE fExp [fMatch] - , pure $ DoE [fStmt] - , pure $ CompE [fStmt] - , pure $ ArithSeqE fRange - , pure $ ListE [fExp] - , SigE fExp <$> arbitrary - , RecConE <$> arbitrary <@> [fFieldExp] - , pure $ RecUpdE fExp [fFieldExp] -#if MIN_VERSION_template_haskell(2,6,0) - , pure $ UnboxedTupE [fExp] -#endif -#if MIN_VERSION_template_haskell(2,7,0) - , pure $ UInfixE fExp fExp fExp - , pure $ ParensE fExp -#endif -#if MIN_VERSION_template_haskell(2,8,0) - , pure $ LamCaseE [fMatch] - , pure $ MultiIfE [(fGuard, fExp)] -#endif -#if MIN_VERSION_template_haskell(2,10,0) - , pure $ StaticE fExp -#endif - ] --- arbitrary = oneof [ VarE <$> arbitrary --- , ConE <$> arbitrary --- , LitE <$> arbitrary --- , AppE <$> arbitrary <*> arbitrary --- , InfixE <$> arbitrary <*> arbitrary <*> arbitrary --- , LamE <$> arbitrary <*> arbitrary --- , TupE <$> arbitrary --- , CondE <$> arbitrary <*> arbitrary <*> arbitrary --- , LetE <$> arbitrary <*> arbitrary --- , CaseE <$> arbitrary <*> arbitrary --- , DoE <$> arbitrary --- , CompE <$> arbitrary --- , ArithSeqE <$> arbitrary --- , ListE <$> arbitrary --- , SigE <$> arbitrary <*> arbitrary --- , RecConE <$> arbitrary <*> arbitrary --- , RecUpdE <$> arbitrary <*> arbitrary --- #if MIN_VERSION_template_haskell(2,6,0) --- , UnboxedTupE <$> arbitrary --- #endif --- #if MIN_VERSION_template_haskell(2,7,0) --- , UInfixE <$> arbitrary <*> arbitrary <*> arbitrary --- , ParensE <$> arbitrary --- #endif --- #if MIN_VERSION_template_haskell(2,8,0) --- , LamCaseE <$> arbitrary --- , MultiIfE <$> arbitrary --- #endif --- #if MIN_VERSION_template_haskell(2,10,0) --- , StaticE <$> arbitrary --- #endif --- ] - -deriving instance Bounded FamFlavour -deriving instance Enum FamFlavour -instance Arbitrary FamFlavour where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary Fixity where - arbitrary = Fixity <$> arbitrary <*> arbitrary - -deriving instance Bounded FixityDirection -deriving instance Enum FixityDirection -instance Arbitrary FixityDirection where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary Foreign where - arbitrary = oneof [ ImportF <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary - , ExportF <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - ] - -instance Arbitrary FunDep where - arbitrary = FunDep <$> arbitrary <*> arbitrary - -instance Arbitrary Guard where - arbitrary = oneof $ map pure [ NormalG fExp - , PatG [fStmt] - ] --- arbitrary = oneof [NormalG <$> arbitrary, PatG <$> arbitrary] - -instance Arbitrary Info where - arbitrary = oneof [ -#if MIN_VERSION_template_haskell(2,5,0) - pure $ ClassI fDec [fDec] -#else - pure $ ClassI fDec -#endif - , ClassOpI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - , pure $ TyConI fDec - , PrimTyConI <$> arbitrary <*> arbitrary <*> arbitrary - , DataConI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - , VarI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - , TyVarI <$> arbitrary <*> arbitrary -#if MIN_VERSION_template_haskell(2,7,0) - , pure $ FamilyI fDec [fDec] -#endif - ] --- arbitrary = oneof [ --- #if MIN_VERSION_template_haskell(2,5,0) --- ClassI <$> arbitrary <*> arbitrary --- #else --- ClassI <$> arbitrary --- #endif --- , ClassOpI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary --- , TyConI <$> arbitrary --- , PrimTyConI <$> arbitrary <*> arbitrary <*> arbitrary --- , DataConI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary --- , VarI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary --- , TyVarI <$> arbitrary <*> arbitrary --- #if MIN_VERSION_template_haskell(2,7,0) --- , FamilyI <$> arbitrary <*> arbitrary --- #endif --- ] - -instance Arbitrary Lit where - arbitrary = oneof [ CharL <$> arbitrary - , StringL <$> arbitrary - , IntegerL <$> arbitrary - , RationalL <$> arbitrary - , IntPrimL <$> arbitrary - , WordPrimL <$> arbitrary - , FloatPrimL <$> arbitrary - , DoublePrimL <$> arbitrary -#if MIN_VERSION_template_haskell(2,5,0) - , StringPrimL <$> arbitrary -#endif - ] - -instance Arbitrary Loc where - arbitrary = Loc <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary - -#if !(MIN_VERSION_template_haskell(2,10,0)) -deriving instance Show Loc -#endif - -instance Arbitrary Match where - arbitrary = Match <$> arbitrary <@> fBody <@> [fDec] --- arbitrary = Match <$> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary Name where - arbitrary = Name <$> arbitrary <*> arbitrary - -instance Arbitrary NameFlavour where - arbitrary = oneof [ pure NameS - , NameQ <$> arbitrary -#if MIN_VERSION_template_haskell(2,10,0) - , NameU <$> arbitrary - , NameL <$> arbitrary -#else - , (\(I# i#) -> NameU i#) <$> arbitrary - , (\(I# i#) -> NameL i#) <$> arbitrary -#endif - , NameG <$> arbitrary <*> arbitrary <*> arbitrary - ] - -deriving instance Bounded NameIs -deriving instance Enum NameIs -deriving instance Show NameIs -instance Arbitrary NameIs where - arbitrary = arbitraryBoundedEnum - -deriving instance Bounded NameSpace -deriving instance Enum NameSpace -instance Arbitrary NameSpace where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary Pat where - arbitrary = oneof [ LitP <$> arbitrary - , VarP <$> arbitrary - , pure $ TupP [fPat] - , ConP <$> arbitrary <@> [fPat] - , InfixP fPat <$> arbitrary <@> fPat - , pure $ TildeP fPat - , pure $ BangP fPat - , AsP <$> arbitrary <@> fPat - , pure WildP - , RecP <$> arbitrary <@> [fFieldPat] - , pure $ ListP [fPat] - , SigP fPat <$> arbitrary -#if MIN_VERSION_template_haskell(2,5,0) - , pure $ ViewP fExp fPat -#endif -#if MIN_VERSION_template_haskell(2,6,0) - , pure $ UnboxedTupP [fPat] -#endif -#if MIN_VERSION_template_haskell(2,7,0) - , UInfixP fPat <$> arbitrary <@> fPat - , pure $ ParensP fPat -#endif - ] --- arbitrary = oneof [ LitP <$> arbitrary --- , VarP <$> arbitrary --- , TupP <$> arbitrary --- , ConP <$> arbitrary <*> arbitrary --- , InfixP <$> arbitrary <*> arbitrary <*> arbitrary --- , TildeP <$> arbitrary --- , BangP <$> arbitrary --- , AsP <$> arbitrary <*> arbitrary --- , pure WildP --- , RecP <$> arbitrary <*> arbitrary --- , ListP <$> arbitrary --- , SigP <$> arbitrary <*> arbitrary --- #if MIN_VERSION_template_haskell(2,5,0) --- , ViewP <$> arbitrary <*> arbitrary --- #endif --- #if MIN_VERSION_template_haskell(2,6,0) --- , UnboxedTupP <$> arbitrary --- #endif --- #if MIN_VERSION_template_haskell(2,7,0) --- , UInfixP <$> arbitrary <*> arbitrary <*> arbitrary --- , ParensP <$> arbitrary --- #endif --- ] - -instance Arbitrary Pragma where - arbitrary = oneof - [ -#if MIN_VERSION_template_haskell(2,8,0) - InlineP <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - , SpecialiseP <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - , SpecialiseInstP <$> arbitrary - , RuleP <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary -# if MIN_VERSION_template_haskell(2,9,0) - , AnnP <$> arbitrary <*> arbitrary -# endif -# if MIN_VERSION_template_haskell(2,10,0) - , LineP <$> arbitrary <*> arbitrary -# endif -#else - InlineP <$> arbitrary <*> arbitrary - , SpecialiseP <$> arbitrary <*> arbitrary <*> arbitrary -#endif - ] - -instance Arbitrary Range where - arbitrary = oneof $ map pure [ FromR fExp - , FromThenR fExp fExp - , FromToR fExp fExp - , FromThenToR fExp fExp fExp - ] --- arbitrary = oneof [ FromR <$> arbitrary --- , FromThenR <$> arbitrary <*> arbitrary --- , FromToR <$> arbitrary <*> arbitrary --- , FromThenToR <$> arbitrary <*> arbitrary <*> arbitrary --- ] - -deriving instance Bounded Safety -deriving instance Enum Safety -instance Arbitrary Safety where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary Stmt where - arbitrary = oneof $ map pure [ BindS fPat fExp - , LetS [fDec] - , NoBindS fExp - , ParS [[fStmt]] - ] --- arbitrary = oneof [ BindS <$> arbitrary <*> arbitrary --- , LetS <$> arbitrary --- , NoBindS <$> arbitrary --- , ParS <$> arbitrary --- ] - -deriving instance Bounded Strict -deriving instance Enum Strict -instance Arbitrary Strict where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary Type where - arbitrary = oneof [ pure $ ForallT [fTyVarBndr] [fPred] fType - , VarT <$> arbitrary - , ConT <$> arbitrary - , TupleT <$> arbitrary - , pure ArrowT - , pure ListT - , pure $ AppT fType fType - , pure $ SigT fType fKind -#if MIN_VERSION_template_haskell(2,6,0) - , UnboxedTupleT <$> arbitrary -#endif -#if MIN_VERSION_template_haskell(2,8,0) - , PromotedT <$> arbitrary - , PromotedTupleT <$> arbitrary - , pure PromotedNilT - , pure PromotedConsT - , pure StarT - , pure ConstraintT - , LitT <$> arbitrary -#endif -#if MIN_VERSION_template_haskell(2,10,0) - , pure EqualityT -#endif - ] --- arbitrary = oneof [ ForallT <$> arbitrary <*> arbitrary <*> arbitrary --- , VarT <$> arbitrary --- , ConT <$> arbitrary --- , TupleT <$> arbitrary --- , pure ArrowT --- , pure ListT --- , AppT <$> arbitrary <*> arbitrary --- , SigT <$> arbitrary <*> arbitrary --- #if MIN_VERSION_template_haskell(2,6,0) --- , UnboxedTupleT <$> arbitrary --- #endif --- #if MIN_VERSION_template_haskell(2,7,0) --- , PromotedT <$> arbitrary --- , PromotedTupleT <$> arbitrary --- , pure PromotedNilT --- , pure PromotedConsT --- , pure StarT --- , pure ConstraintT --- , LitT <$> arbitrary --- #endif --- #if MIN_VERSION_template_haskell(2,10,0) --- , pure EqualityT --- #endif --- ] - -instance Arbitrary TyVarBndr where - arbitrary = oneof [PlainTV <$> arbitrary, KindedTV <$> arbitrary <@> fKind] --- arbitrary = oneof [PlainTV <$> arbitrary, KindedTV <$> arbitrary <*> arbitrary] - -#if MIN_VERSION_template_haskell(2,5,0) && !(MIN_VERSION_template_haskell(2,7,0)) -instance Arbitrary ClassInstance where - arbitrary = ClassInstance <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary -#endif - -#if MIN_VERSION_template_haskell(2,8,0) -deriving instance Bounded Inline -deriving instance Enum Inline -instance Arbitrary Inline where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary Phases where - arbitrary = oneof [ pure AllPhases - , FromPhase <$> arbitrary - , BeforePhase <$> arbitrary - ] - -instance Arbitrary RuleBndr where - arbitrary = oneof [RuleVar <$> arbitrary, TypedRuleVar <$> arbitrary <*> arbitrary] - -deriving instance Bounded RuleMatch -deriving instance Enum RuleMatch -instance Arbitrary RuleMatch where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary TyLit where - arbitrary = oneof [NumTyLit <$> arbitrary, StrTyLit <$> arbitrary] -#else -instance Arbitrary InlineSpec where - arbitrary = InlineSpec <$> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary Kind where - arbitrary = oneof [pure StarK, pure $ ArrowK fKind fKind] --- arbitrary = oneof [pure StarK, ArrowK <$> arbitrary <*> arbitrary] -#endif - -#if MIN_VERSION_template_haskell(2,9,0) -instance Arbitrary AnnLookup where - arbitrary = oneof [AnnLookupModule <$> arbitrary, AnnLookupName <$> arbitrary] - -instance Arbitrary AnnTarget where - arbitrary = oneof [ pure ModuleAnnotation - , TypeAnnotation <$> arbitrary - , ValueAnnotation <$> arbitrary - ] - -instance Arbitrary Module where - arbitrary = Module <$> arbitrary <*> arbitrary - -instance Arbitrary ModuleInfo where - arbitrary = ModuleInfo <$> arbitrary - -deriving instance Bounded Role -deriving instance Enum Role -instance Arbitrary Role where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary TySynEqn where - arbitrary = TySynEqn <$> arbitrary <*> arbitrary -#endif - -instance Arbitrary Doc where - arbitrary = text <$> arbitrary - -#if !(MIN_VERSION_template_haskell(2,10,0)) -instance Arbitrary Pred where - arbitrary = oneof [ ClassP <$> arbitrary <@> [fType] - , pure $ EqualP fType fType - ] --- arbitrary = oneof [ ClassP <$> arbitrary <*> arbitrary --- , EqualP <$> arbitrary <*> arbitrary --- ] -#endif - -deriving instance Arbitrary ModName -deriving instance Arbitrary OccName -deriving instance Arbitrary PkgName - -#if !(MIN_VERSION_template_haskell(2,9,0)) -deriving instance Show ModName -deriving instance Show OccName -deriving instance Show PkgName -#endif - -------------------------------------------------------------------------------- --- Workarounds to make Arbitrary instances faster -------------------------------------------------------------------------------- - -fBody :: Body -fBody = GuardedB [] - -fClause :: Clause -fClause = Clause [] fBody [] - -fCon :: Con -fCon = NormalC fName [] - -fDec :: Dec -fDec = FunD fName [] - -fExp :: Exp -fExp = TupE [] - -fFieldExp :: FieldExp -fFieldExp = (fName, fExp) - -fFieldPat :: FieldPat -fFieldPat = (fName, fPat) - -fGuard :: Guard -fGuard = PatG [] - -fKind :: Kind -#if MIN_VERSION_template_haskell(2,8,0) -fKind = fType -#else -fKind = StarK -#endif - -fMatch :: Match -fMatch = Match fPat fBody [] - -fName :: Name -fName = Name (OccName "") NameS - -fPat :: Pat -fPat = WildP - -fPred :: Pred -#if MIN_VERSION_template_haskell(2,10,0) -fPred = fType -#else -fPred = ClassP fName [] -#endif - -fRange :: Range -fRange = FromR fExp - -fStmt :: Stmt -fStmt = LetS [] - -fType :: Type -fType = ListT - -fTyVarBndr :: TyVarBndr -fTyVarBndr = PlainTV fName +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeSynonymInstances #-} +#if !(MIN_VERSION_template_haskell(2,10,0)) +{-# LANGUAGE MagicHash #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Language.Haskell.TH +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for data types in the @template-haskell@ library. +-} +module Instances.Language.Haskell.TH () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>), pure) + +import Data.Functor ((<$>)) +#endif + +#if !(MIN_VERSION_template_haskell(2,10,0)) +import GHC.Exts (Int(I#)) +#endif + +import Instances.Utils ((<@>)) + +import Language.Haskell.TH.PprLib (Doc, text) +import Language.Haskell.TH.Syntax +#if !(MIN_VERSION_template_haskell(2,8,0)) +import Language.Haskell.TH.Syntax.Internals +#endif + +import Test.Tasty.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) + +instance Arbitrary Body where + arbitrary = oneof $ map pure [ GuardedB [(fGuard, fExp)] + , NormalB fExp + ] +-- arbitrary = oneof [GuardedB <$> arbitrary, NormalB <$> arbitrary] + +deriving instance Bounded Callconv +deriving instance Enum Callconv +instance Arbitrary Callconv where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary Clause where + arbitrary = pure $ Clause [fPat] fBody [fDec] +-- arbitrary = Clause <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary Con where + arbitrary = oneof [ NormalC <$> arbitrary <*> arbitrary + , RecC <$> arbitrary <*> arbitrary + , InfixC <$> arbitrary <*> arbitrary <*> arbitrary + , ForallC <$> arbitrary <@> [fPred] <@> fCon + ] +-- arbitrary = oneof [ NormalC <$> arbitrary <*> arbitrary +-- , RecC <$> arbitrary <*> arbitrary +-- , InfixC <$> arbitrary <*> arbitrary <*> arbitrary +-- , ForallC <$> arbitrary <*> arbitrary <*> arbitrary +-- ] + +instance Arbitrary Dec where + arbitrary = oneof [ + FunD <$> arbitrary <@> [fClause] + , pure $ ValD fPat fBody [fDec] + , DataD [fPred] <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + , NewtypeD [fPred] <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + , TySynD <$> arbitrary <*> arbitrary <*> arbitrary + , ClassD [fPred] <$> arbitrary <*> arbitrary <*> arbitrary <@> [fDec] + , InstanceD [fPred] <$> arbitrary <@> [fDec] + , SigD <$> arbitrary <*> arbitrary + , ForeignD <$> arbitrary + , PragmaD <$> arbitrary + , FamilyD <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + , DataInstD [fPred] <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + , NewtypeInstD [fPred] <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary +#if MIN_VERSION_template_haskell(2,8,0) + , InfixD <$> arbitrary <*> arbitrary +#endif +#if MIN_VERSION_template_haskell(2,9,0) + , ClosedTypeFamilyD <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + , RoleAnnotD <$> arbitrary <*> arbitrary + , TySynInstD <$> arbitrary <*> arbitrary +#else + , TySynInstD <$> arbitrary <*> arbitrary <*> arbitrary +#endif +#if MIN_VERSION_template_haskell(2,10,0) + , StandaloneDerivD <$> arbitrary <*> arbitrary + , DefaultSigD <$> arbitrary <*> arbitrary +#endif + ] +-- arbitrary = oneof [ +-- FunD <$> arbitrary <*> arbitrary +-- , ValD <$> arbitrary <*> arbitrary <*> arbitrary +-- , DataD <$> arbitrary <*> arbitrary <*> arbitrary +-- <*> arbitrary <*> arbitrary +-- , NewtypeD <$> arbitrary <*> arbitrary <*> arbitrary +-- <*> arbitrary <*> arbitrary +-- , TySynD <$> arbitrary <*> arbitrary <*> arbitrary +-- , ClassD <$> arbitrary <*> arbitrary <*> arbitrary +-- <*> arbitrary <*> arbitrary +-- , InstanceD <$> arbitrary <*> arbitrary <*> arbitrary +-- , SigD <$> arbitrary <*> arbitrary +-- , ForeignD <$> arbitrary +-- , PragmaD <$> arbitrary +-- , FamilyD <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary +-- , DataInstD <$> arbitrary <*> arbitrary <*> arbitrary +-- <*> arbitrary <*> arbitrary +-- , NewtypeInstD <$> arbitrary <*> arbitrary <*> arbitrary +-- <*> arbitrary <*> arbitrary +-- #if MIN_VERSION_template_haskell(2,8,0) +-- , InfixD <$> arbitrary <*> arbitrary +-- #endif +-- #if MIN_VERSION_template_haskell(2,9,0) +-- , ClosedTypeFamilyD <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary +-- , RoleAnnotD <$> arbitrary <*> arbitrary +-- , TySynInstD <$> arbitrary <*> arbitrary +-- #else +-- , TySynInstD <$> arbitrary <*> arbitrary <*> arbitrary +-- #endif +-- #if MIN_VERSION_template_haskell(2,10,0) +-- , StandaloneDerivD <$> arbitrary <*> arbitrary +-- , DefaultSigD <$> arbitrary <*> arbitrary +-- #endif +-- ] + +instance Arbitrary Exp where + arbitrary = oneof [ VarE <$> arbitrary + , ConE <$> arbitrary + , LitE <$> arbitrary + , pure $ AppE fExp fExp + , pure $ InfixE (Just fExp) fExp (Just fExp) + , pure $ LamE [fPat] fExp + , pure $ TupE [fExp] + , pure $ CondE fExp fExp fExp + , pure $ LetE [fDec] fExp + , pure $ CaseE fExp [fMatch] + , pure $ DoE [fStmt] + , pure $ CompE [fStmt] + , pure $ ArithSeqE fRange + , pure $ ListE [fExp] + , SigE fExp <$> arbitrary + , RecConE <$> arbitrary <@> [fFieldExp] + , pure $ RecUpdE fExp [fFieldExp] +#if MIN_VERSION_template_haskell(2,6,0) + , pure $ UnboxedTupE [fExp] +#endif +#if MIN_VERSION_template_haskell(2,7,0) + , pure $ UInfixE fExp fExp fExp + , pure $ ParensE fExp +#endif +#if MIN_VERSION_template_haskell(2,8,0) + , pure $ LamCaseE [fMatch] + , pure $ MultiIfE [(fGuard, fExp)] +#endif +#if MIN_VERSION_template_haskell(2,10,0) + , pure $ StaticE fExp +#endif + ] +-- arbitrary = oneof [ VarE <$> arbitrary +-- , ConE <$> arbitrary +-- , LitE <$> arbitrary +-- , AppE <$> arbitrary <*> arbitrary +-- , InfixE <$> arbitrary <*> arbitrary <*> arbitrary +-- , LamE <$> arbitrary <*> arbitrary +-- , TupE <$> arbitrary +-- , CondE <$> arbitrary <*> arbitrary <*> arbitrary +-- , LetE <$> arbitrary <*> arbitrary +-- , CaseE <$> arbitrary <*> arbitrary +-- , DoE <$> arbitrary +-- , CompE <$> arbitrary +-- , ArithSeqE <$> arbitrary +-- , ListE <$> arbitrary +-- , SigE <$> arbitrary <*> arbitrary +-- , RecConE <$> arbitrary <*> arbitrary +-- , RecUpdE <$> arbitrary <*> arbitrary +-- #if MIN_VERSION_template_haskell(2,6,0) +-- , UnboxedTupE <$> arbitrary +-- #endif +-- #if MIN_VERSION_template_haskell(2,7,0) +-- , UInfixE <$> arbitrary <*> arbitrary <*> arbitrary +-- , ParensE <$> arbitrary +-- #endif +-- #if MIN_VERSION_template_haskell(2,8,0) +-- , LamCaseE <$> arbitrary +-- , MultiIfE <$> arbitrary +-- #endif +-- #if MIN_VERSION_template_haskell(2,10,0) +-- , StaticE <$> arbitrary +-- #endif +-- ] + +deriving instance Bounded FamFlavour +deriving instance Enum FamFlavour +instance Arbitrary FamFlavour where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary Fixity where + arbitrary = Fixity <$> arbitrary <*> arbitrary + +deriving instance Bounded FixityDirection +deriving instance Enum FixityDirection +instance Arbitrary FixityDirection where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary Foreign where + arbitrary = oneof [ ImportF <$> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + , ExportF <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + ] + +instance Arbitrary FunDep where + arbitrary = FunDep <$> arbitrary <*> arbitrary + +instance Arbitrary Guard where + arbitrary = oneof $ map pure [ NormalG fExp + , PatG [fStmt] + ] +-- arbitrary = oneof [NormalG <$> arbitrary, PatG <$> arbitrary] + +instance Arbitrary Info where + arbitrary = oneof [ +#if MIN_VERSION_template_haskell(2,5,0) + pure $ ClassI fDec [fDec] +#else + pure $ ClassI fDec +#endif + , ClassOpI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + , pure $ TyConI fDec + , PrimTyConI <$> arbitrary <*> arbitrary <*> arbitrary + , DataConI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + , VarI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + , TyVarI <$> arbitrary <*> arbitrary +#if MIN_VERSION_template_haskell(2,7,0) + , pure $ FamilyI fDec [fDec] +#endif + ] +-- arbitrary = oneof [ +-- #if MIN_VERSION_template_haskell(2,5,0) +-- ClassI <$> arbitrary <*> arbitrary +-- #else +-- ClassI <$> arbitrary +-- #endif +-- , ClassOpI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary +-- , TyConI <$> arbitrary +-- , PrimTyConI <$> arbitrary <*> arbitrary <*> arbitrary +-- , DataConI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary +-- , VarI <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary +-- , TyVarI <$> arbitrary <*> arbitrary +-- #if MIN_VERSION_template_haskell(2,7,0) +-- , FamilyI <$> arbitrary <*> arbitrary +-- #endif +-- ] + +instance Arbitrary Lit where + arbitrary = oneof [ CharL <$> arbitrary + , StringL <$> arbitrary + , IntegerL <$> arbitrary + , RationalL <$> arbitrary + , IntPrimL <$> arbitrary + , WordPrimL <$> arbitrary + , FloatPrimL <$> arbitrary + , DoublePrimL <$> arbitrary +#if MIN_VERSION_template_haskell(2,5,0) + , StringPrimL <$> arbitrary +#endif + ] + +instance Arbitrary Loc where + arbitrary = Loc <$> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + +#if !(MIN_VERSION_template_haskell(2,10,0)) +deriving instance Show Loc +#endif + +instance Arbitrary Match where + arbitrary = Match <$> arbitrary <@> fBody <@> [fDec] +-- arbitrary = Match <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary Name where + arbitrary = Name <$> arbitrary <*> arbitrary + +instance Arbitrary NameFlavour where + arbitrary = oneof [ pure NameS + , NameQ <$> arbitrary +#if MIN_VERSION_template_haskell(2,10,0) + , NameU <$> arbitrary + , NameL <$> arbitrary +#else + , (\(I# i#) -> NameU i#) <$> arbitrary + , (\(I# i#) -> NameL i#) <$> arbitrary +#endif + , NameG <$> arbitrary <*> arbitrary <*> arbitrary + ] + +deriving instance Bounded NameIs +deriving instance Enum NameIs +deriving instance Show NameIs +instance Arbitrary NameIs where + arbitrary = arbitraryBoundedEnum + +deriving instance Bounded NameSpace +deriving instance Enum NameSpace +instance Arbitrary NameSpace where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary Pat where + arbitrary = oneof [ LitP <$> arbitrary + , VarP <$> arbitrary + , pure $ TupP [fPat] + , ConP <$> arbitrary <@> [fPat] + , InfixP fPat <$> arbitrary <@> fPat + , pure $ TildeP fPat + , pure $ BangP fPat + , AsP <$> arbitrary <@> fPat + , pure WildP + , RecP <$> arbitrary <@> [fFieldPat] + , pure $ ListP [fPat] + , SigP fPat <$> arbitrary +#if MIN_VERSION_template_haskell(2,5,0) + , pure $ ViewP fExp fPat +#endif +#if MIN_VERSION_template_haskell(2,6,0) + , pure $ UnboxedTupP [fPat] +#endif +#if MIN_VERSION_template_haskell(2,7,0) + , UInfixP fPat <$> arbitrary <@> fPat + , pure $ ParensP fPat +#endif + ] +-- arbitrary = oneof [ LitP <$> arbitrary +-- , VarP <$> arbitrary +-- , TupP <$> arbitrary +-- , ConP <$> arbitrary <*> arbitrary +-- , InfixP <$> arbitrary <*> arbitrary <*> arbitrary +-- , TildeP <$> arbitrary +-- , BangP <$> arbitrary +-- , AsP <$> arbitrary <*> arbitrary +-- , pure WildP +-- , RecP <$> arbitrary <*> arbitrary +-- , ListP <$> arbitrary +-- , SigP <$> arbitrary <*> arbitrary +-- #if MIN_VERSION_template_haskell(2,5,0) +-- , ViewP <$> arbitrary <*> arbitrary +-- #endif +-- #if MIN_VERSION_template_haskell(2,6,0) +-- , UnboxedTupP <$> arbitrary +-- #endif +-- #if MIN_VERSION_template_haskell(2,7,0) +-- , UInfixP <$> arbitrary <*> arbitrary <*> arbitrary +-- , ParensP <$> arbitrary +-- #endif +-- ] + +instance Arbitrary Pragma where + arbitrary = oneof + [ +#if MIN_VERSION_template_haskell(2,8,0) + InlineP <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + , SpecialiseP <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + , SpecialiseInstP <$> arbitrary + , RuleP <$> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary +# if MIN_VERSION_template_haskell(2,9,0) + , AnnP <$> arbitrary <*> arbitrary +# endif +# if MIN_VERSION_template_haskell(2,10,0) + , LineP <$> arbitrary <*> arbitrary +# endif +#else + InlineP <$> arbitrary <*> arbitrary + , SpecialiseP <$> arbitrary <*> arbitrary <*> arbitrary +#endif + ] + +instance Arbitrary Range where + arbitrary = oneof $ map pure [ FromR fExp + , FromThenR fExp fExp + , FromToR fExp fExp + , FromThenToR fExp fExp fExp + ] +-- arbitrary = oneof [ FromR <$> arbitrary +-- , FromThenR <$> arbitrary <*> arbitrary +-- , FromToR <$> arbitrary <*> arbitrary +-- , FromThenToR <$> arbitrary <*> arbitrary <*> arbitrary +-- ] + +deriving instance Bounded Safety +deriving instance Enum Safety +instance Arbitrary Safety where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary Stmt where + arbitrary = oneof $ map pure [ BindS fPat fExp + , LetS [fDec] + , NoBindS fExp + , ParS [[fStmt]] + ] +-- arbitrary = oneof [ BindS <$> arbitrary <*> arbitrary +-- , LetS <$> arbitrary +-- , NoBindS <$> arbitrary +-- , ParS <$> arbitrary +-- ] + +deriving instance Bounded Strict +deriving instance Enum Strict +instance Arbitrary Strict where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary Type where + arbitrary = oneof [ pure $ ForallT [fTyVarBndr] [fPred] fType + , VarT <$> arbitrary + , ConT <$> arbitrary + , TupleT <$> arbitrary + , pure ArrowT + , pure ListT + , pure $ AppT fType fType + , pure $ SigT fType fKind +#if MIN_VERSION_template_haskell(2,6,0) + , UnboxedTupleT <$> arbitrary +#endif +#if MIN_VERSION_template_haskell(2,8,0) + , PromotedT <$> arbitrary + , PromotedTupleT <$> arbitrary + , pure PromotedNilT + , pure PromotedConsT + , pure StarT + , pure ConstraintT + , LitT <$> arbitrary +#endif +#if MIN_VERSION_template_haskell(2,10,0) + , pure EqualityT +#endif + ] +-- arbitrary = oneof [ ForallT <$> arbitrary <*> arbitrary <*> arbitrary +-- , VarT <$> arbitrary +-- , ConT <$> arbitrary +-- , TupleT <$> arbitrary +-- , pure ArrowT +-- , pure ListT +-- , AppT <$> arbitrary <*> arbitrary +-- , SigT <$> arbitrary <*> arbitrary +-- #if MIN_VERSION_template_haskell(2,6,0) +-- , UnboxedTupleT <$> arbitrary +-- #endif +-- #if MIN_VERSION_template_haskell(2,7,0) +-- , PromotedT <$> arbitrary +-- , PromotedTupleT <$> arbitrary +-- , pure PromotedNilT +-- , pure PromotedConsT +-- , pure StarT +-- , pure ConstraintT +-- , LitT <$> arbitrary +-- #endif +-- #if MIN_VERSION_template_haskell(2,10,0) +-- , pure EqualityT +-- #endif +-- ] + +instance Arbitrary TyVarBndr where + arbitrary = oneof [PlainTV <$> arbitrary, KindedTV <$> arbitrary <@> fKind] +-- arbitrary = oneof [PlainTV <$> arbitrary, KindedTV <$> arbitrary <*> arbitrary] + +#if MIN_VERSION_template_haskell(2,5,0) && !(MIN_VERSION_template_haskell(2,7,0)) +instance Arbitrary ClassInstance where + arbitrary = ClassInstance <$> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary +#endif + +#if MIN_VERSION_template_haskell(2,8,0) +deriving instance Bounded Inline +deriving instance Enum Inline +instance Arbitrary Inline where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary Phases where + arbitrary = oneof [ pure AllPhases + , FromPhase <$> arbitrary + , BeforePhase <$> arbitrary + ] + +instance Arbitrary RuleBndr where + arbitrary = oneof [RuleVar <$> arbitrary, TypedRuleVar <$> arbitrary <*> arbitrary] + +deriving instance Bounded RuleMatch +deriving instance Enum RuleMatch +instance Arbitrary RuleMatch where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary TyLit where + arbitrary = oneof [NumTyLit <$> arbitrary, StrTyLit <$> arbitrary] +#else +instance Arbitrary InlineSpec where + arbitrary = InlineSpec <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary Kind where + arbitrary = oneof [pure StarK, pure $ ArrowK fKind fKind] +-- arbitrary = oneof [pure StarK, ArrowK <$> arbitrary <*> arbitrary] +#endif + +#if MIN_VERSION_template_haskell(2,9,0) +instance Arbitrary AnnLookup where + arbitrary = oneof [AnnLookupModule <$> arbitrary, AnnLookupName <$> arbitrary] + +instance Arbitrary AnnTarget where + arbitrary = oneof [ pure ModuleAnnotation + , TypeAnnotation <$> arbitrary + , ValueAnnotation <$> arbitrary + ] + +instance Arbitrary Module where + arbitrary = Module <$> arbitrary <*> arbitrary + +instance Arbitrary ModuleInfo where + arbitrary = ModuleInfo <$> arbitrary + +deriving instance Bounded Role +deriving instance Enum Role +instance Arbitrary Role where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary TySynEqn where + arbitrary = TySynEqn <$> arbitrary <*> arbitrary +#endif + +instance Arbitrary Doc where + arbitrary = text <$> arbitrary + +#if !(MIN_VERSION_template_haskell(2,10,0)) +instance Arbitrary Pred where + arbitrary = oneof [ ClassP <$> arbitrary <@> [fType] + , pure $ EqualP fType fType + ] +-- arbitrary = oneof [ ClassP <$> arbitrary <*> arbitrary +-- , EqualP <$> arbitrary <*> arbitrary +-- ] +#endif + +deriving instance Arbitrary ModName +deriving instance Arbitrary OccName +deriving instance Arbitrary PkgName + +#if !(MIN_VERSION_template_haskell(2,9,0)) +deriving instance Show ModName +deriving instance Show OccName +deriving instance Show PkgName +#endif + +------------------------------------------------------------------------------- +-- Workarounds to make Arbitrary instances faster +------------------------------------------------------------------------------- + +fBody :: Body +fBody = GuardedB [] + +fClause :: Clause +fClause = Clause [] fBody [] + +fCon :: Con +fCon = NormalC fName [] + +fDec :: Dec +fDec = FunD fName [] + +fExp :: Exp +fExp = TupE [] + +fFieldExp :: FieldExp +fFieldExp = (fName, fExp) + +fFieldPat :: FieldPat +fFieldPat = (fName, fPat) + +fGuard :: Guard +fGuard = PatG [] + +fKind :: Kind +#if MIN_VERSION_template_haskell(2,8,0) +fKind = fType +#else +fKind = StarK +#endif + +fMatch :: Match +fMatch = Match fPat fBody [] + +fName :: Name +fName = Name (OccName "") NameS + +fPat :: Pat +fPat = WildP + +fPred :: Pred +#if MIN_VERSION_template_haskell(2,10,0) +fPred = fType +#else +fPred = ClassP fName [] +#endif + +fRange :: Range +fRange = FromR fExp + +fStmt :: Stmt +fStmt = LetS [] + +fType :: Type +fType = ListT + +fTyVarBndr :: TyVarBndr +fTyVarBndr = PlainTV fName diff --git a/tests/Instances/Miscellaneous.hs b/tests/Instances/Miscellaneous.hs --- a/tests/Instances/Miscellaneous.hs +++ b/tests/Instances/Miscellaneous.hs @@ -1,56 +1,56 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Miscellaneous -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides miscellaneous 'Arbitrary' instances (taken from @text-show@). --} -module Instances.Miscellaneous () where - -#include "HsBaseConfig.h" - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative (pure) - -import Data.Functor ((<$>)) -#endif - -import Data.Version (Version(..)) - -import Foreign.C.Types (CInt(..)) -import Foreign.Ptr (Ptr, nullPtr, plusPtr) - -import System.Exit (ExitCode(..)) -#if defined(HTYPE_GID_T) -import System.Posix.Types (CGid(..)) -#endif -#if defined(HTYPE_UID_T) -import System.Posix.Types (CUid(..)) -#endif - -import Test.Tasty.QuickCheck (Arbitrary(..), oneof) - -instance Arbitrary ExitCode where - arbitrary = oneof [pure ExitSuccess, ExitFailure <$> arbitrary] - -instance Arbitrary (Ptr a) where - arbitrary = plusPtr nullPtr <$> arbitrary - -instance Arbitrary Version where - arbitrary = pure $ Version [0] [""] --- arbitrary = Version <$> arbitrary <*> arbitrary - -deriving instance Arbitrary CInt -#if defined(HTYPE_GID_T) -deriving instance Arbitrary CGid -#endif -#if defined(HTYPE_UID_T) -deriving instance Arbitrary CUid -#endif +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Miscellaneous +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides miscellaneous 'Arbitrary' instances (taken from @text-show@). +-} +module Instances.Miscellaneous () where + +#include "HsBaseConfig.h" + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative (pure) + +import Data.Functor ((<$>)) +#endif + +import Data.Version (Version(..)) + +import Foreign.C.Types (CInt(..)) +import Foreign.Ptr (Ptr, nullPtr, plusPtr) + +import System.Exit (ExitCode(..)) +#if defined(HTYPE_GID_T) +import System.Posix.Types (CGid(..)) +#endif +#if defined(HTYPE_UID_T) +import System.Posix.Types (CUid(..)) +#endif + +import Test.Tasty.QuickCheck (Arbitrary(..), oneof) + +instance Arbitrary ExitCode where + arbitrary = oneof [pure ExitSuccess, ExitFailure <$> arbitrary] + +instance Arbitrary (Ptr a) where + arbitrary = plusPtr nullPtr <$> arbitrary + +instance Arbitrary Version where + arbitrary = pure $ Version [0] [""] +-- arbitrary = Version <$> arbitrary <*> arbitrary + +deriving instance Arbitrary CInt +#if defined(HTYPE_GID_T) +deriving instance Arbitrary CGid +#endif +#if defined(HTYPE_UID_T) +deriving instance Arbitrary CUid +#endif diff --git a/tests/Instances/System/Console/Haskeline.hs b/tests/Instances/System/Console/Haskeline.hs --- a/tests/Instances/System/Console/Haskeline.hs +++ b/tests/Instances/System/Console/Haskeline.hs @@ -1,38 +1,38 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.System.Console.Haskeline -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for data types in the @haskeline@ library. --} -module Instances.System.Console.Haskeline () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>), pure) - -import Data.Functor ((<$>)) -#endif - -import Instances.Utils ((<@>)) - -import System.Console.Haskeline (Interrupt(..)) -import System.Console.Haskeline.Completion (Completion(..)) -import System.Console.Haskeline.History (History, addHistory, emptyHistory) - -import Test.Tasty.QuickCheck (Arbitrary(..)) - -instance Arbitrary Interrupt where - arbitrary = pure Interrupt - --- instance Arbitrary Prefs - -instance Arbitrary Completion where - arbitrary = Completion <$> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary History where - arbitrary = addHistory <$> arbitrary <@> emptyHistory +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.System.Console.Haskeline +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for data types in the @haskeline@ library. +-} +module Instances.System.Console.Haskeline () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>), pure) + +import Data.Functor ((<$>)) +#endif + +import Instances.Utils ((<@>)) + +import System.Console.Haskeline (Interrupt(..)) +import System.Console.Haskeline.Completion (Completion(..)) +import System.Console.Haskeline.History (History, addHistory, emptyHistory) + +import Test.Tasty.QuickCheck (Arbitrary(..)) + +instance Arbitrary Interrupt where + arbitrary = pure Interrupt + +-- instance Arbitrary Prefs + +instance Arbitrary Completion where + arbitrary = Completion <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary History where + arbitrary = addHistory <$> arbitrary <@> emptyHistory diff --git a/tests/Instances/System/Console/Terminfo.hs b/tests/Instances/System/Console/Terminfo.hs --- a/tests/Instances/System/Console/Terminfo.hs +++ b/tests/Instances/System/Console/Terminfo.hs @@ -1,35 +1,35 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.System.Console.Terminfo -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for data types in the @terminfo@ library. --} -module Instances.System.Console.Terminfo () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative (pure) -import Data.Functor ((<$>)) -#endif - -import System.Console.Terminfo.Color (Color(..)) -import Test.Tasty.QuickCheck (Arbitrary(..), oneof) - -instance Arbitrary Color where - arbitrary = oneof [ pure Black - , pure Red - , pure Green - , pure Yellow - , pure Blue - , pure Magenta - , pure Cyan - , pure White - , ColorNumber <$> arbitrary - ] - --- instance Arbitrary SetupTermError +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.System.Console.Terminfo +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for data types in the @terminfo@ library. +-} +module Instances.System.Console.Terminfo () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative (pure) +import Data.Functor ((<$>)) +#endif + +import System.Console.Terminfo.Color (Color(..)) +import Test.Tasty.QuickCheck (Arbitrary(..), oneof) + +instance Arbitrary Color where + arbitrary = oneof [ pure Black + , pure Red + , pure Green + , pure Yellow + , pure Blue + , pure Magenta + , pure Cyan + , pure White + , ColorNumber <$> arbitrary + ] + +-- instance Arbitrary SetupTermError diff --git a/tests/Instances/System/Directory.hs b/tests/Instances/System/Directory.hs --- a/tests/Instances/System/Directory.hs +++ b/tests/Instances/System/Directory.hs @@ -1,29 +1,29 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.System.Directory -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides an 'Arbitrary' instance for 'Permissions'. --} -module Instances.System.Directory () where - -#if MIN_VERSION_directory(1,1,0) -import Control.Applicative ((<**>)) -# if !(MIN_VERSION_base(4,8,0)) -import Data.Functor ((<$>)) -# endif -import System.Directory (Permissions, emptyPermissions, setOwnerReadable, - setOwnerWritable, setOwnerExecutable, setOwnerSearchable) -import Test.Tasty.QuickCheck (Arbitrary(..)) - -instance Arbitrary Permissions where - arbitrary = ($ emptyPermissions) <$> (setOwnerReadable <$> arbitrary) - <**> (setOwnerWritable <$> arbitrary) - <**> (setOwnerExecutable <$> arbitrary) - <**> (setOwnerSearchable <$> arbitrary) -#endif +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.System.Directory +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides an 'Arbitrary' instance for 'Permissions'. +-} +module Instances.System.Directory () where + +#if MIN_VERSION_directory(1,1,0) +import Control.Applicative ((<**>)) +# if !(MIN_VERSION_base(4,8,0)) +import Data.Functor ((<$>)) +# endif +import System.Directory (Permissions, emptyPermissions, setOwnerReadable, + setOwnerWritable, setOwnerExecutable, setOwnerSearchable) +import Test.Tasty.QuickCheck (Arbitrary(..)) + +instance Arbitrary Permissions where + arbitrary = ($ emptyPermissions) <$> (setOwnerReadable <$> arbitrary) + <**> (setOwnerWritable <$> arbitrary) + <**> (setOwnerExecutable <$> arbitrary) + <**> (setOwnerSearchable <$> arbitrary) +#endif diff --git a/tests/Instances/System/Locale.hs b/tests/Instances/System/Locale.hs --- a/tests/Instances/System/Locale.hs +++ b/tests/Instances/System/Locale.hs @@ -1,25 +1,25 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.System.Locale -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides an 'Arbitrary' instance for old 'TimeLocale' values. --} -module Instances.System.Locale () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>)) -import Data.Functor ((<$>)) -#endif - -import System.Locale (TimeLocale(..)) -import Test.Tasty.QuickCheck (Arbitrary(..)) - -instance Arbitrary TimeLocale where - arbitrary = TimeLocale <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.System.Locale +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides an 'Arbitrary' instance for old 'TimeLocale' values. +-} +module Instances.System.Locale () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>)) +import Data.Functor ((<$>)) +#endif + +import System.Locale (TimeLocale(..)) +import Test.Tasty.QuickCheck (Arbitrary(..)) + +instance Arbitrary TimeLocale where + arbitrary = TimeLocale <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary diff --git a/tests/Instances/System/Posix.hs b/tests/Instances/System/Posix.hs --- a/tests/Instances/System/Posix.hs +++ b/tests/Instances/System/Posix.hs @@ -1,53 +1,53 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.System.Posix -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for data types in the @unix@ library. --} -module Instances.System.Posix () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>), pure) - -import Data.Functor ((<$>)) -#endif - -import Instances.Miscellaneous () - -import System.Posix.DynamicLinker (RTLDFlags(..), DL(..)) -import System.Posix.Process (ProcessStatus(..)) -import System.Posix.User (GroupEntry(..), UserEntry(..)) - -import Test.Tasty.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) - -deriving instance Bounded RTLDFlags -deriving instance Enum RTLDFlags -instance Arbitrary RTLDFlags where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary DL where - arbitrary = oneof [pure Null, pure Next, pure Default, DLHandle <$> arbitrary] - -instance Arbitrary ProcessStatus where - arbitrary = oneof [ Exited <$> arbitrary -#if MIN_VERSION_unix(2,7,0) - , Terminated <$> arbitrary <*> arbitrary -#else - , Terminated <$> arbitrary -#endif - , Stopped <$> arbitrary - ] - -instance Arbitrary GroupEntry where - arbitrary = GroupEntry <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary UserEntry where - arbitrary = UserEntry <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary +{-# LANGUAGE CPP #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.System.Posix +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for data types in the @unix@ library. +-} +module Instances.System.Posix () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>), pure) + +import Data.Functor ((<$>)) +#endif + +import Instances.Miscellaneous () + +import System.Posix.DynamicLinker (RTLDFlags(..), DL(..)) +import System.Posix.Process (ProcessStatus(..)) +import System.Posix.User (GroupEntry(..), UserEntry(..)) + +import Test.Tasty.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) + +deriving instance Bounded RTLDFlags +deriving instance Enum RTLDFlags +instance Arbitrary RTLDFlags where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary DL where + arbitrary = oneof [pure Null, pure Next, pure Default, DLHandle <$> arbitrary] + +instance Arbitrary ProcessStatus where + arbitrary = oneof [ Exited <$> arbitrary +#if MIN_VERSION_unix(2,7,0) + , Terminated <$> arbitrary <*> arbitrary +#else + , Terminated <$> arbitrary +#endif + , Stopped <$> arbitrary + ] + +instance Arbitrary GroupEntry where + arbitrary = GroupEntry <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary UserEntry where + arbitrary = UserEntry <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary diff --git a/tests/Instances/System/Random.hs b/tests/Instances/System/Random.hs --- a/tests/Instances/System/Random.hs +++ b/tests/Instances/System/Random.hs @@ -1,22 +1,22 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.System.Random -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides an 'Arbitrary' instance for 'StdGen' values. --} -module Instances.System.Random () where - -#if !(MIN_VERSION_base(4,8,0)) -import Data.Functor ((<$>)) -#endif -import System.Random (StdGen, mkStdGen) -import Test.Tasty.QuickCheck (Arbitrary(..)) - -instance Arbitrary StdGen where - arbitrary = mkStdGen <$> arbitrary +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.System.Random +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides an 'Arbitrary' instance for 'StdGen' values. +-} +module Instances.System.Random () where + +#if !(MIN_VERSION_base(4,8,0)) +import Data.Functor ((<$>)) +#endif +import System.Random (StdGen, mkStdGen) +import Test.Tasty.QuickCheck (Arbitrary(..)) + +instance Arbitrary StdGen where + arbitrary = mkStdGen <$> arbitrary diff --git a/tests/Instances/System/Win32.hs b/tests/Instances/System/Win32.hs --- a/tests/Instances/System/Win32.hs +++ b/tests/Instances/System/Win32.hs @@ -1,106 +1,106 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.System.Win32 -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for data types in the @Win32@ library. --} -module Instances.System.Win32 () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>), pure) - -import Data.Functor ((<$>)) -#endif - -import Instances.Miscellaneous () - -import System.Win32.DebugApi (DebugEventInfo(..), Exception(..)) -import System.Win32.File (BY_HANDLE_FILE_INFORMATION(..), WIN32_FILE_ATTRIBUTE_DATA(..)) -import System.Win32.Info (ProcessorArchitecture(..), SYSTEM_INFO(..)) -import System.Win32.Time (FILETIME(..), SYSTEMTIME(..), - TIME_ZONE_INFORMATION(..), TimeZoneId(..)) - -import Test.Tasty.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) - -instance Arbitrary DebugEventInfo where - arbitrary = oneof [ pure UnknownDebugEvent - , Exception <$> arbitrary <*> arbitrary - , CreateThread <$> arbitrary - , CreateProcess <$> arbitrary <*> arbitrary <*> arbitrary - , ExitThread <$> arbitrary - , ExitProcess <$> arbitrary - , LoadDll <$> arbitrary - , UnloadDll <$> arbitrary - , DebugString <$> arbitrary <*> arbitrary <*> arbitrary - ] - -instance Arbitrary Exception where - arbitrary = oneof [ pure UnknownException - , AccessViolation <$> arbitrary <*> arbitrary - , pure ArrayBoundsExceeded - , pure Breakpoint - , pure DataTypeMisalignment - , pure FltDenormalOperand - , pure FltDivideByZero - , pure FltInexactResult - , pure FltInvalidOperation - , pure FltOverflow - , pure FltStackCheck - , pure FltUnderflow - , pure IllegalInstruction - , pure InPageError - , pure IntDivideByZero - , pure IntOverflow - , pure InvalidDisposition - , pure NonContinuable - , pure PrivilegedInstruction - , pure SingleStep - , pure StackOverflow - ] - -instance Arbitrary BY_HANDLE_FILE_INFORMATION where - arbitrary = BY_HANDLE_FILE_INFORMATION <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary WIN32_FILE_ATTRIBUTE_DATA where - arbitrary = WIN32_FILE_ATTRIBUTE_DATA <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary - -instance Arbitrary ProcessorArchitecture where - arbitrary = oneof [ PaUnknown <$> arbitrary - , pure PaIntel - , pure PaMips - , pure PaAlpha - , pure PaPpc - , pure PaIa64 - , pure PaIa32OnIa64 - , pure PaAmd64 - ] - -instance Arbitrary SYSTEM_INFO where - arbitrary = SYSTEM_INFO <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary - -deriving instance Arbitrary FILETIME - -instance Arbitrary SYSTEMTIME where - arbitrary = SYSTEMTIME <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary TIME_ZONE_INFORMATION where - arbitrary = TIME_ZONE_INFORMATION <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary - -deriving instance Bounded TimeZoneId -deriving instance Enum TimeZoneId -instance Arbitrary TimeZoneId where - arbitrary = arbitraryBoundedEnum +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.System.Win32 +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for data types in the @Win32@ library. +-} +module Instances.System.Win32 () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>), pure) + +import Data.Functor ((<$>)) +#endif + +import Instances.Miscellaneous () + +import System.Win32.DebugApi (DebugEventInfo(..), Exception(..)) +import System.Win32.File (BY_HANDLE_FILE_INFORMATION(..), WIN32_FILE_ATTRIBUTE_DATA(..)) +import System.Win32.Info (ProcessorArchitecture(..), SYSTEM_INFO(..)) +import System.Win32.Time (FILETIME(..), SYSTEMTIME(..), + TIME_ZONE_INFORMATION(..), TimeZoneId(..)) + +import Test.Tasty.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) + +instance Arbitrary DebugEventInfo where + arbitrary = oneof [ pure UnknownDebugEvent + , Exception <$> arbitrary <*> arbitrary + , CreateThread <$> arbitrary + , CreateProcess <$> arbitrary <*> arbitrary <*> arbitrary + , ExitThread <$> arbitrary + , ExitProcess <$> arbitrary + , LoadDll <$> arbitrary + , UnloadDll <$> arbitrary + , DebugString <$> arbitrary <*> arbitrary <*> arbitrary + ] + +instance Arbitrary Exception where + arbitrary = oneof [ pure UnknownException + , AccessViolation <$> arbitrary <*> arbitrary + , pure ArrayBoundsExceeded + , pure Breakpoint + , pure DataTypeMisalignment + , pure FltDenormalOperand + , pure FltDivideByZero + , pure FltInexactResult + , pure FltInvalidOperation + , pure FltOverflow + , pure FltStackCheck + , pure FltUnderflow + , pure IllegalInstruction + , pure InPageError + , pure IntDivideByZero + , pure IntOverflow + , pure InvalidDisposition + , pure NonContinuable + , pure PrivilegedInstruction + , pure SingleStep + , pure StackOverflow + ] + +instance Arbitrary BY_HANDLE_FILE_INFORMATION where + arbitrary = BY_HANDLE_FILE_INFORMATION <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary WIN32_FILE_ATTRIBUTE_DATA where + arbitrary = WIN32_FILE_ATTRIBUTE_DATA <$> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + +instance Arbitrary ProcessorArchitecture where + arbitrary = oneof [ PaUnknown <$> arbitrary + , pure PaIntel + , pure PaMips + , pure PaAlpha + , pure PaPpc + , pure PaIa64 + , pure PaIa32OnIa64 + , pure PaAmd64 + ] + +instance Arbitrary SYSTEM_INFO where + arbitrary = SYSTEM_INFO <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary + +deriving instance Arbitrary FILETIME + +instance Arbitrary SYSTEMTIME where + arbitrary = SYSTEMTIME <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary TIME_ZONE_INFORMATION where + arbitrary = TIME_ZONE_INFORMATION <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary + +deriving instance Bounded TimeZoneId +deriving instance Enum TimeZoneId +instance Arbitrary TimeZoneId where + arbitrary = arbitraryBoundedEnum diff --git a/tests/Instances/Text/PrettyPrint.hs b/tests/Instances/Text/PrettyPrint.hs --- a/tests/Instances/Text/PrettyPrint.hs +++ b/tests/Instances/Text/PrettyPrint.hs @@ -1,53 +1,53 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE StandaloneDeriving #-} -#if MIN_VERSION_pretty(1,1,2) -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -#endif -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Text.PrettyPrint -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for data types in the @pretty@ library -(as well as 'Show' instances if using an old version of @pretty@). --} -module Instances.Text.PrettyPrint () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>)) - -import Data.Functor ((<$>)) -#endif - -import Test.Tasty.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) - -import Text.PrettyPrint.HughesPJ (Doc, Mode(..), Style(..), TextDetails(..), text) -#if MIN_VERSION_pretty(1,1,2) -import Text.PrettyPrint.HughesPJClass (PrettyLevel(..)) -#endif - -instance Arbitrary Doc where - arbitrary = text <$> arbitrary - -deriving instance Bounded Mode -deriving instance Enum Mode -instance Arbitrary Mode where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary Style where - arbitrary = Style <$> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary TextDetails where - arbitrary = oneof [Chr <$> arbitrary, Str <$> arbitrary, PStr <$> arbitrary] - -#if MIN_VERSION_pretty(1,1,2) -deriving instance Arbitrary PrettyLevel -#else -deriving instance Show Mode -deriving instance Show Style -deriving instance Show TextDetails -#endif +{-# LANGUAGE CPP #-} +{-# LANGUAGE StandaloneDeriving #-} +#if MIN_VERSION_pretty(1,1,2) +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Text.PrettyPrint +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for data types in the @pretty@ library +(as well as 'Show' instances if using an old version of @pretty@). +-} +module Instances.Text.PrettyPrint () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>)) + +import Data.Functor ((<$>)) +#endif + +import Test.Tasty.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) + +import Text.PrettyPrint.HughesPJ (Doc, Mode(..), Style(..), TextDetails(..), text) +#if MIN_VERSION_pretty(1,1,2) +import Text.PrettyPrint.HughesPJClass (PrettyLevel(..)) +#endif + +instance Arbitrary Doc where + arbitrary = text <$> arbitrary + +deriving instance Bounded Mode +deriving instance Enum Mode +instance Arbitrary Mode where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary Style where + arbitrary = Style <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary TextDetails where + arbitrary = oneof [Chr <$> arbitrary, Str <$> arbitrary, PStr <$> arbitrary] + +#if MIN_VERSION_pretty(1,1,2) +deriving instance Arbitrary PrettyLevel +#else +deriving instance Show Mode +deriving instance Show Style +deriving instance Show TextDetails +#endif diff --git a/tests/Instances/Text/XHtml.hs b/tests/Instances/Text/XHtml.hs --- a/tests/Instances/Text/XHtml.hs +++ b/tests/Instances/Text/XHtml.hs @@ -1,36 +1,36 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Text.XHtml -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for data types in the @xhtml@ library. --} -module Instances.Text.XHtml () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>)) - -import Data.Functor ((<$>)) -#endif - -import Test.Tasty.QuickCheck (Arbitrary(..), Gen) - -import Text.XHtml.Frameset (Html, HtmlAttr, HotLink(..), strAttr, toHtml) -import Text.XHtml.Table (HtmlTable, cell) - -instance Arbitrary Html where - arbitrary = toHtml <$> (arbitrary :: Gen String) - -instance Arbitrary HtmlAttr where - arbitrary = strAttr <$> arbitrary <*> arbitrary - -instance Arbitrary HotLink where - arbitrary = HotLink <$> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary HtmlTable where - arbitrary = cell <$> (arbitrary :: Gen Html) +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Text.XHtml +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for data types in the @xhtml@ library. +-} +module Instances.Text.XHtml () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>)) + +import Data.Functor ((<$>)) +#endif + +import Test.Tasty.QuickCheck (Arbitrary(..), Gen) + +import Text.XHtml.Frameset (Html, HtmlAttr, HotLink(..), strAttr, toHtml) +import Text.XHtml.Table (HtmlTable, cell) + +instance Arbitrary Html where + arbitrary = toHtml <$> (arbitrary :: Gen String) + +instance Arbitrary HtmlAttr where + arbitrary = strAttr <$> arbitrary <*> arbitrary + +instance Arbitrary HotLink where + arbitrary = HotLink <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary HtmlTable where + arbitrary = cell <$> (arbitrary :: Gen Html) diff --git a/tests/Instances/Trace/Hpc.hs b/tests/Instances/Trace/Hpc.hs --- a/tests/Instances/Trace/Hpc.hs +++ b/tests/Instances/Trace/Hpc.hs @@ -1,67 +1,67 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| -Module: Instances.Trace.Hpc -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -Provides 'Arbitrary' instances for data types in the @hpc@ library. --} -module Instances.Trace.Hpc () where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative ((<*>)) - -import Data.Functor ((<$>)) -#endif - -import Instances.Utils ((<@>)) - -import Test.QuickCheck.Instances () -import Test.Tasty.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) - -import Trace.Hpc.Mix (Mix(..), MixEntry, BoxLabel(..), CondBox(..)) -import Trace.Hpc.Tix (Tix(..), TixModule(..)) -import Trace.Hpc.Util (HpcPos, Hash, toHpcPos) - -instance Arbitrary Mix where - arbitrary = Mix <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <@> [fMixEntry] --- arbitrary = Mix <$> arbitrary <*> arbitrary <*> arbitrary --- <*> arbitrary <*> arbitrary - -instance Arbitrary BoxLabel where - arbitrary = oneof [ ExpBox <$> arbitrary - , TopLevelBox <$> arbitrary - , LocalBox <$> arbitrary - , BinBox <$> arbitrary <*> arbitrary - ] - -deriving instance Bounded CondBox -deriving instance Enum CondBox -instance Arbitrary CondBox where - arbitrary = arbitraryBoundedEnum - -instance Arbitrary Tix where - arbitrary = Tix <$> arbitrary - -instance Arbitrary TixModule where - arbitrary = TixModule <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - -instance Arbitrary HpcPos where - arbitrary = toHpcPos <$> ((,,,) <$> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary) - -instance Arbitrary Hash where - arbitrary = fromInteger <$> arbitrary - -------------------------------------------------------------------------------- --- Workarounds to make Arbitrary instances faster -------------------------------------------------------------------------------- - -fMixEntry :: MixEntry -fMixEntry = (toHpcPos (0, 1, 2, 3), ExpBox True) +{-# LANGUAGE CPP #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Module: Instances.Trace.Hpc +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +Provides 'Arbitrary' instances for data types in the @hpc@ library. +-} +module Instances.Trace.Hpc () where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative ((<*>)) + +import Data.Functor ((<$>)) +#endif + +import Instances.Utils ((<@>)) + +import Test.QuickCheck.Instances () +import Test.Tasty.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) + +import Trace.Hpc.Mix (Mix(..), MixEntry, BoxLabel(..), CondBox(..)) +import Trace.Hpc.Tix (Tix(..), TixModule(..)) +import Trace.Hpc.Util (HpcPos, Hash, toHpcPos) + +instance Arbitrary Mix where + arbitrary = Mix <$> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <@> [fMixEntry] +-- arbitrary = Mix <$> arbitrary <*> arbitrary <*> arbitrary +-- <*> arbitrary <*> arbitrary + +instance Arbitrary BoxLabel where + arbitrary = oneof [ ExpBox <$> arbitrary + , TopLevelBox <$> arbitrary + , LocalBox <$> arbitrary + , BinBox <$> arbitrary <*> arbitrary + ] + +deriving instance Bounded CondBox +deriving instance Enum CondBox +instance Arbitrary CondBox where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary Tix where + arbitrary = Tix <$> arbitrary + +instance Arbitrary TixModule where + arbitrary = TixModule <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary HpcPos where + arbitrary = toHpcPos <$> ((,,,) <$> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary) + +instance Arbitrary Hash where + arbitrary = fromInteger <$> arbitrary + +------------------------------------------------------------------------------- +-- Workarounds to make Arbitrary instances faster +------------------------------------------------------------------------------- + +fMixEntry :: MixEntry +fMixEntry = (toHpcPos (0, 1, 2, 3), ExpBox True) diff --git a/tests/Instances/Utils.hs b/tests/Instances/Utils.hs --- a/tests/Instances/Utils.hs +++ b/tests/Instances/Utils.hs @@ -1,16 +1,16 @@ -{-| -Module: Instances.Utils -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -A collection of utility functions. --} -module Instances.Utils ((<@>)) where - -infixl 4 <@> --- | A useful way to escape a 'Functor' context. -(<@>) :: Functor f => f (a -> b) -> a -> f b +{-| +Module: Instances.Utils +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +A collection of utility functions. +-} +module Instances.Utils ((<@>)) where + +infixl 4 <@> +-- | A useful way to escape a 'Functor' context. +(<@>) :: Functor f => f (a -> b) -> a -> f b f <@> x = fmap ($ x) f diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -1,82 +1,82 @@ -{-# LANGUAGE CPP #-} -{-| -Module: Properties -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ tests for @text-show-instances@. --} -module Main (main) where - -import Properties.Compiler.Hoopl (hooplTests) -import Properties.Control.Applicative.Trans (applicativeFunctorTransformerTests) -import Properties.Control.Monad.Trans (monadTransformerTests) -import Properties.Data.Binary (binaryTests) -import Properties.Data.Containers (containersTests) -import Properties.Data.Functor.Trans (functorTransformerTests) -import Properties.Data.List.NonEmpty (nonEmptyListTests) -import Properties.Data.Semigroup (semigroupTests) -import Properties.Data.String.UTF8 (utf8StringTests) -import Properties.Data.Tagged (taggedTests) -import Properties.Data.Time (timeTests) -import Properties.Data.UnorderedContainers (unorderedContainersTests) -import Properties.Data.Vector (vectorTests) -import Properties.Language.Haskell.TH (templateHaskellTests) -import Properties.System.Console.Haskeline (haskelineTests) -import Properties.System.Directory (directoryTests) -import Properties.System.Locale (oldLocaleTests) -#if !defined(mingw32_HOST_OS) -import Properties.System.Console.Terminfo (terminfoTests) -import Properties.System.Posix (unixTests) -#endif -import Properties.System.Random (randomTests) -import Properties.System.Time (oldTimeTests) -#if defined(mingw32_HOST_OS) -import Properties.System.Win32 (win32Tests) -#endif -import Properties.Text.PrettyPrint (prettyTests) -import Properties.Text.XHtml (xhtmlTests) -import Properties.Trace.Hpc (hpcTests) - -import Test.Tasty (TestTree, defaultMain, testGroup) - -main :: IO () -main = defaultMain testTree - -testTree :: TestTree -testTree = testGroup "QuickCheck properties" allTests - -allTests :: [TestTree] -allTests = concat [ hooplTests - , applicativeFunctorTransformerTests - , monadTransformerTests - , binaryTests - , containersTests - , functorTransformerTests - , nonEmptyListTests - , semigroupTests - , utf8StringTests - , taggedTests - , timeTests - , unorderedContainersTests - , vectorTests - , templateHaskellTests - , haskelineTests - , directoryTests - , oldLocaleTests -#if !defined(mingw32_HOST_OS) - , terminfoTests - , unixTests -#endif - , randomTests - , oldTimeTests -#if defined(mingw32_HOST_OS) - , win32Tests -#endif - , prettyTests - , xhtmlTests - , hpcTests +{-# LANGUAGE CPP #-} +{-| +Module: Properties +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ tests for @text-show-instances@. +-} +module Main (main) where + +import Properties.Compiler.Hoopl (hooplTests) +import Properties.Control.Applicative.Trans (applicativeFunctorTransformerTests) +import Properties.Control.Monad.Trans (monadTransformerTests) +import Properties.Data.Binary (binaryTests) +import Properties.Data.Containers (containersTests) +import Properties.Data.Functor.Trans (functorTransformerTests) +import Properties.Data.List.NonEmpty (nonEmptyListTests) +import Properties.Data.Semigroup (semigroupTests) +import Properties.Data.String.UTF8 (utf8StringTests) +import Properties.Data.Tagged (taggedTests) +import Properties.Data.Time (timeTests) +import Properties.Data.UnorderedContainers (unorderedContainersTests) +import Properties.Data.Vector (vectorTests) +import Properties.Language.Haskell.TH (templateHaskellTests) +import Properties.System.Console.Haskeline (haskelineTests) +import Properties.System.Directory (directoryTests) +import Properties.System.Locale (oldLocaleTests) +#if !defined(mingw32_HOST_OS) +import Properties.System.Console.Terminfo (terminfoTests) +import Properties.System.Posix (unixTests) +#endif +import Properties.System.Random (randomTests) +import Properties.System.Time (oldTimeTests) +#if defined(mingw32_HOST_OS) +import Properties.System.Win32 (win32Tests) +#endif +import Properties.Text.PrettyPrint (prettyTests) +import Properties.Text.XHtml (xhtmlTests) +import Properties.Trace.Hpc (hpcTests) + +import Test.Tasty (TestTree, defaultMain, testGroup) + +main :: IO () +main = defaultMain testTree + +testTree :: TestTree +testTree = testGroup "QuickCheck properties" allTests + +allTests :: [TestTree] +allTests = concat [ hooplTests + , applicativeFunctorTransformerTests + , monadTransformerTests + , binaryTests + , containersTests + , functorTransformerTests + , nonEmptyListTests + , semigroupTests + , utf8StringTests + , taggedTests + , timeTests + , unorderedContainersTests + , vectorTests + , templateHaskellTests + , haskelineTests + , directoryTests + , oldLocaleTests +#if !defined(mingw32_HOST_OS) + , terminfoTests + , unixTests +#endif + , randomTests + , oldTimeTests +#if defined(mingw32_HOST_OS) + , win32Tests +#endif + , prettyTests + , xhtmlTests + , hpcTests ] diff --git a/tests/Properties/Compiler/Hoopl.hs b/tests/Properties/Compiler/Hoopl.hs --- a/tests/Properties/Compiler/Hoopl.hs +++ b/tests/Properties/Compiler/Hoopl.hs @@ -1,40 +1,40 @@ -{-| -Module: Properties.Compiler.Hoopl -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in the @hoopl@ library. --} -module Properties.Compiler.Hoopl (hooplTests) where - -import Compiler.Hoopl (Label, LabelMap, LabelSet, Pointed, - Unique, UniqueMap, UniqueSet, C) -import Compiler.Hoopl.Passes.Dominator (DominatorNode, DominatorTree, DPath) - -import Instances.Compiler.Hoopl () - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Compiler.Hoopl () - -hooplTests :: [TestTree] -hooplTests = - [ testGroup "Text.Show.Text.Compiler.Hoopl" - [ testProperty "Label instance" (prop_matchesShow :: Int -> Label -> Bool) - , testProperty "LabelMap Char instance" (prop_matchesShow :: Int -> LabelMap Char -> Bool) - , testProperty "LabelSet instance" (prop_matchesShow :: Int -> LabelSet -> Bool) - , testProperty "Pointed C C Int instance" (prop_matchesShow :: Int -> Pointed C C Int -> Bool) - , testProperty "Unique instance" (prop_matchesShow :: Int -> Unique -> Bool) - , testProperty "UniqueMap Char instance" (prop_matchesShow :: Int -> UniqueMap Char -> Bool) - , testProperty "UniqueSet instance" (prop_matchesShow :: Int -> UniqueSet -> Bool) - , testProperty "DominatorNode instance" (prop_matchesShow :: Int -> DominatorNode -> Bool) - , testProperty "DominatorTree instance" (prop_matchesShow :: Int -> DominatorTree -> Bool) - , testProperty "DPath instance" (prop_matchesShow :: Int -> DPath -> Bool) - ] +{-| +Module: Properties.Compiler.Hoopl +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in the @hoopl@ library. +-} +module Properties.Compiler.Hoopl (hooplTests) where + +import Compiler.Hoopl (Label, LabelMap, LabelSet, Pointed, + Unique, UniqueMap, UniqueSet, C) +import Compiler.Hoopl.Passes.Dominator (DominatorNode, DominatorTree, DPath) + +import Instances.Compiler.Hoopl () + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Compiler.Hoopl () + +hooplTests :: [TestTree] +hooplTests = + [ testGroup "Text.Show.Text.Compiler.Hoopl" + [ testProperty "Label instance" (prop_matchesShow :: Int -> Label -> Bool) + , testProperty "LabelMap Char instance" (prop_matchesShow :: Int -> LabelMap Char -> Bool) + , testProperty "LabelSet instance" (prop_matchesShow :: Int -> LabelSet -> Bool) + , testProperty "Pointed C C Int instance" (prop_matchesShow :: Int -> Pointed C C Int -> Bool) + , testProperty "Unique instance" (prop_matchesShow :: Int -> Unique -> Bool) + , testProperty "UniqueMap Char instance" (prop_matchesShow :: Int -> UniqueMap Char -> Bool) + , testProperty "UniqueSet instance" (prop_matchesShow :: Int -> UniqueSet -> Bool) + , testProperty "DominatorNode instance" (prop_matchesShow :: Int -> DominatorNode -> Bool) + , testProperty "DominatorTree instance" (prop_matchesShow :: Int -> DominatorTree -> Bool) + , testProperty "DPath instance" (prop_matchesShow :: Int -> DPath -> Bool) + ] ] diff --git a/tests/Properties/Control/Applicative/Trans.hs b/tests/Properties/Control/Applicative/Trans.hs --- a/tests/Properties/Control/Applicative/Trans.hs +++ b/tests/Properties/Control/Applicative/Trans.hs @@ -1,31 +1,31 @@ -{-| -Module: Properties.Control.Applicative.Trans -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for applicative functor transformers. --} -module Properties.Control.Applicative.Trans (applicativeFunctorTransformerTests) where - -import Control.Applicative.Backwards (Backwards) -import Control.Applicative.Lift (Lift) - -import Instances.Control.Applicative.Trans () - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Control.Applicative.Trans () - -applicativeFunctorTransformerTests :: [TestTree] -applicativeFunctorTransformerTests = - [ testGroup "Text.Show.Text.Control.Applicative.Trans" - [ testProperty "Backwards Maybe Int instance" (prop_matchesShow :: Int -> Backwards Maybe Int -> Bool) - , testProperty "Lift Maybe Int instance" (prop_matchesShow :: Int -> Lift Maybe Int -> Bool) - ] +{-| +Module: Properties.Control.Applicative.Trans +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for applicative functor transformers. +-} +module Properties.Control.Applicative.Trans (applicativeFunctorTransformerTests) where + +import Control.Applicative.Backwards (Backwards) +import Control.Applicative.Lift (Lift) + +import Instances.Control.Applicative.Trans () + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Control.Applicative.Trans () + +applicativeFunctorTransformerTests :: [TestTree] +applicativeFunctorTransformerTests = + [ testGroup "Text.Show.Text.Control.Applicative.Trans" + [ testProperty "Backwards Maybe Int instance" (prop_matchesShow :: Int -> Backwards Maybe Int -> Bool) + , testProperty "Lift Maybe Int instance" (prop_matchesShow :: Int -> Lift Maybe Int -> Bool) + ] ] diff --git a/tests/Properties/Control/Monad/Trans.hs b/tests/Properties/Control/Monad/Trans.hs --- a/tests/Properties/Control/Monad/Trans.hs +++ b/tests/Properties/Control/Monad/Trans.hs @@ -1,42 +1,42 @@ -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -{-| -Module: Properties.Control.Monad.Trans -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for monad transformers. --} -module Properties.Control.Monad.Trans (monadTransformerTests) where - -import Control.Monad.Trans.Error (ErrorT) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Identity (IdentityT) -import Control.Monad.Trans.List (ListT) -import Control.Monad.Trans.Maybe (MaybeT) -import qualified Control.Monad.Trans.Writer.Lazy as WL (WriterT) -import qualified Control.Monad.Trans.Writer.Strict as WS (WriterT) - -import Instances.Control.Monad.Trans () - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Control.Monad.Trans () - -monadTransformerTests :: [TestTree] -monadTransformerTests = - [ testGroup "Text.Show.Text.Control.Monad.Trans" - [ testProperty "ErrorT Char Maybe Int instance" (prop_matchesShow :: Int -> ErrorT Char Maybe Int -> Bool) - , testProperty "ExceptT Char Maybe Int instance" (prop_matchesShow :: Int -> ExceptT Char Maybe Int -> Bool) - , testProperty "IdentityT Maybe Int instance" (prop_matchesShow :: Int -> IdentityT Maybe Int -> Bool) - , testProperty "ListT Maybe Char instance" (prop_matchesShow :: Int -> ListT Maybe Char -> Bool) - , testProperty "Maybe [] Int instance" (prop_matchesShow :: Int -> MaybeT [] Int -> Bool) - , testProperty "lazy WriterT String Maybe Int instance" (prop_matchesShow :: Int -> WL.WriterT String Maybe Int -> Bool) - , testProperty "strict WriterT String Maybe Int instance" (prop_matchesShow :: Int -> WS.WriterT String Maybe Int -> Bool) - ] +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +{-| +Module: Properties.Control.Monad.Trans +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for monad transformers. +-} +module Properties.Control.Monad.Trans (monadTransformerTests) where + +import Control.Monad.Trans.Error (ErrorT) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Identity (IdentityT) +import Control.Monad.Trans.List (ListT) +import Control.Monad.Trans.Maybe (MaybeT) +import qualified Control.Monad.Trans.Writer.Lazy as WL (WriterT) +import qualified Control.Monad.Trans.Writer.Strict as WS (WriterT) + +import Instances.Control.Monad.Trans () + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Control.Monad.Trans () + +monadTransformerTests :: [TestTree] +monadTransformerTests = + [ testGroup "Text.Show.Text.Control.Monad.Trans" + [ testProperty "ErrorT Char Maybe Int instance" (prop_matchesShow :: Int -> ErrorT Char Maybe Int -> Bool) + , testProperty "ExceptT Char Maybe Int instance" (prop_matchesShow :: Int -> ExceptT Char Maybe Int -> Bool) + , testProperty "IdentityT Maybe Int instance" (prop_matchesShow :: Int -> IdentityT Maybe Int -> Bool) + , testProperty "ListT Maybe Char instance" (prop_matchesShow :: Int -> ListT Maybe Char -> Bool) + , testProperty "Maybe [] Int instance" (prop_matchesShow :: Int -> MaybeT [] Int -> Bool) + , testProperty "lazy WriterT String Maybe Int instance" (prop_matchesShow :: Int -> WL.WriterT String Maybe Int -> Bool) + , testProperty "strict WriterT String Maybe Int instance" (prop_matchesShow :: Int -> WS.WriterT String Maybe Int -> Bool) + ] ] diff --git a/tests/Properties/Data/Binary.hs b/tests/Properties/Data/Binary.hs --- a/tests/Properties/Data/Binary.hs +++ b/tests/Properties/Data/Binary.hs @@ -1,29 +1,29 @@ -{-| -Module: Properties.Data.Binary -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for 'Decoder's. --} -module Properties.Data.Binary (binaryTests) where - -import Data.Binary.Get.Internal (Decoder) - -import Instances.Data.Binary () - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Data.Binary () - -binaryTests :: [TestTree] -binaryTests = - [ testGroup "Text.Show.Text.Data.Binary" - [ testProperty "Decoder Int instance" (prop_matchesShow :: Int -> Decoder Int -> Bool) - ] +{-| +Module: Properties.Data.Binary +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for 'Decoder's. +-} +module Properties.Data.Binary (binaryTests) where + +import Data.Binary.Get.Internal (Decoder) + +import Instances.Data.Binary () + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Data.Binary () + +binaryTests :: [TestTree] +binaryTests = + [ testGroup "Text.Show.Text.Data.Binary" + [ testProperty "Decoder Int instance" (prop_matchesShow :: Int -> Decoder Int -> Bool) + ] ] diff --git a/tests/Properties/Data/Containers.hs b/tests/Properties/Data/Containers.hs --- a/tests/Properties/Data/Containers.hs +++ b/tests/Properties/Data/Containers.hs @@ -1,42 +1,42 @@ -{-| -Module: Properties.Data.Containers -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in the @containers@ library. --} -module Properties.Data.Containers (containersTests) where - -import Data.IntMap (IntMap) -import Data.IntSet (IntSet) -import Data.Map (Map) -import Data.Sequence (Seq, ViewL, ViewR) -import Data.Set (Set) -import Data.Tree (Tree) - -import Instances.Data.Containers () - -import Properties.Utils (prop_matchesShow) - -import Test.QuickCheck.Instances () -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Data.Containers () - -containersTests :: [TestTree] -containersTests = - [ testGroup "Text.Show.Text.Data.Containers" - [ testProperty "IntMap Char instance" (prop_matchesShow :: Int -> IntMap Char -> Bool) - , testProperty "IntSet instance" (prop_matchesShow :: Int -> IntSet -> Bool) - , testProperty "Map Char Char instance" (prop_matchesShow :: Int -> Map Char Char -> Bool) - , testProperty "Sequence Char" (prop_matchesShow :: Int -> Seq Char -> Bool) - , testProperty "ViewL Int instance" (prop_matchesShow :: Int -> ViewL Int -> Bool) - , testProperty "ViewR Int instance" (prop_matchesShow :: Int -> ViewR Int -> Bool) - , testProperty "Set Char instance" (prop_matchesShow :: Int -> Set Char -> Bool) - , testProperty "Tree Char instance" (prop_matchesShow :: Int -> Tree Char -> Bool) - ] +{-| +Module: Properties.Data.Containers +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in the @containers@ library. +-} +module Properties.Data.Containers (containersTests) where + +import Data.IntMap (IntMap) +import Data.IntSet (IntSet) +import Data.Map (Map) +import Data.Sequence (Seq, ViewL, ViewR) +import Data.Set (Set) +import Data.Tree (Tree) + +import Instances.Data.Containers () + +import Properties.Utils (prop_matchesShow) + +import Test.QuickCheck.Instances () +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Data.Containers () + +containersTests :: [TestTree] +containersTests = + [ testGroup "Text.Show.Text.Data.Containers" + [ testProperty "IntMap Char instance" (prop_matchesShow :: Int -> IntMap Char -> Bool) + , testProperty "IntSet instance" (prop_matchesShow :: Int -> IntSet -> Bool) + , testProperty "Map Char Char instance" (prop_matchesShow :: Int -> Map Char Char -> Bool) + , testProperty "Sequence Char" (prop_matchesShow :: Int -> Seq Char -> Bool) + , testProperty "ViewL Int instance" (prop_matchesShow :: Int -> ViewL Int -> Bool) + , testProperty "ViewR Int instance" (prop_matchesShow :: Int -> ViewR Int -> Bool) + , testProperty "Set Char instance" (prop_matchesShow :: Int -> Set Char -> Bool) + , testProperty "Tree Char instance" (prop_matchesShow :: Int -> Tree Char -> Bool) + ] ] diff --git a/tests/Properties/Data/Functor/Trans.hs b/tests/Properties/Data/Functor/Trans.hs --- a/tests/Properties/Data/Functor/Trans.hs +++ b/tests/Properties/Data/Functor/Trans.hs @@ -1,37 +1,37 @@ -{-| -Module: Properties.Data.Functor.Trans -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for functor transformers. --} -module Properties.Data.Functor.Trans (functorTransformerTests) where - -import Data.Functor.Compose (Compose) -import Data.Functor.Constant (Constant) -import Data.Functor.Product (Product) -import Data.Functor.Reverse (Reverse) -import Data.Functor.Sum (Sum) - -import Instances.Data.Functor.Trans () - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Data.Functor.Trans () - -functorTransformerTests :: [TestTree] -functorTransformerTests = - [ testGroup "Text.Show.Text.Data.Functor.Trans" - [ testProperty "Compose Maybe [] Char instance" (prop_matchesShow :: Int -> Compose Maybe [] Char -> Bool) - , testProperty "Constant Int Char instance" (prop_matchesShow :: Int -> Constant Int Char -> Bool) - , testProperty "Product Maybe [] Char instance" (prop_matchesShow :: Int -> Product Maybe [] Char -> Bool) - , testProperty "Reverse Maybe Int instance" (prop_matchesShow :: Int -> Reverse Maybe Int -> Bool) - , testProperty "Sum Maybe [] Char instance" (prop_matchesShow :: Int -> Sum Maybe [] Char -> Bool) - ] +{-| +Module: Properties.Data.Functor.Trans +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for functor transformers. +-} +module Properties.Data.Functor.Trans (functorTransformerTests) where + +import Data.Functor.Compose (Compose) +import Data.Functor.Constant (Constant) +import Data.Functor.Product (Product) +import Data.Functor.Reverse (Reverse) +import Data.Functor.Sum (Sum) + +import Instances.Data.Functor.Trans () + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Data.Functor.Trans () + +functorTransformerTests :: [TestTree] +functorTransformerTests = + [ testGroup "Text.Show.Text.Data.Functor.Trans" + [ testProperty "Compose Maybe [] Char instance" (prop_matchesShow :: Int -> Compose Maybe [] Char -> Bool) + , testProperty "Constant Int Char instance" (prop_matchesShow :: Int -> Constant Int Char -> Bool) + , testProperty "Product Maybe [] Char instance" (prop_matchesShow :: Int -> Product Maybe [] Char -> Bool) + , testProperty "Reverse Maybe Int instance" (prop_matchesShow :: Int -> Reverse Maybe Int -> Bool) + , testProperty "Sum Maybe [] Char instance" (prop_matchesShow :: Int -> Sum Maybe [] Char -> Bool) + ] ] diff --git a/tests/Properties/Data/List/NonEmpty.hs b/tests/Properties/Data/List/NonEmpty.hs --- a/tests/Properties/Data/List/NonEmpty.hs +++ b/tests/Properties/Data/List/NonEmpty.hs @@ -1,29 +1,29 @@ -{-| -Module: Properties.Data.List.NonEmpty -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for 'NonEmpty' lists. --} -module Properties.Data.List.NonEmpty (nonEmptyListTests) where - -import Data.List.NonEmpty (NonEmpty) - -import Instances.Data.List.NonEmpty () - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Data.List.NonEmpty () - -nonEmptyListTests :: [TestTree] -nonEmptyListTests = - [ testGroup "Text.Show.Text.Data.List.NonEmpty" - [ testProperty "NonEmpty Char instance" (prop_matchesShow :: Int -> NonEmpty Char -> Bool) - ] +{-| +Module: Properties.Data.List.NonEmpty +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for 'NonEmpty' lists. +-} +module Properties.Data.List.NonEmpty (nonEmptyListTests) where + +import Data.List.NonEmpty (NonEmpty) + +import Instances.Data.List.NonEmpty () + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Data.List.NonEmpty () + +nonEmptyListTests :: [TestTree] +nonEmptyListTests = + [ testGroup "Text.Show.Text.Data.List.NonEmpty" + [ testProperty "NonEmpty Char instance" (prop_matchesShow :: Int -> NonEmpty Char -> Bool) + ] ] diff --git a/tests/Properties/Data/Semigroup.hs b/tests/Properties/Data/Semigroup.hs --- a/tests/Properties/Data/Semigroup.hs +++ b/tests/Properties/Data/Semigroup.hs @@ -1,35 +1,35 @@ -{-| -Module: Properties.Data.Semigroup -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for @Semigroup@ data types. --} -module Properties.Data.Semigroup (semigroupTests) where - -import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg) - -import Instances.Data.Semigroup () - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Data.Semigroup () - -semigroupTests :: [TestTree] -semigroupTests = - [ testGroup "Text.Show.Text.Data.Semigroup" - [ testProperty "Min Int instance" (prop_matchesShow :: Int -> Min Int -> Bool) - , testProperty "Max Int instance" (prop_matchesShow :: Int -> Max Int -> Bool) - , testProperty "First Int instance" (prop_matchesShow :: Int -> First Int -> Bool) - , testProperty "Last Int Char" (prop_matchesShow :: Int -> Last Int -> Bool) - , testProperty "WrappedMonoid Int instance" (prop_matchesShow :: Int -> WrappedMonoid Int -> Bool) - , testProperty "Option Int instance" (prop_matchesShow :: Int -> Option Int -> Bool) - , testProperty "Arg Int Int instance" (prop_matchesShow :: Int -> Arg Int Int -> Bool) - ] +{-| +Module: Properties.Data.Semigroup +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for @Semigroup@ data types. +-} +module Properties.Data.Semigroup (semigroupTests) where + +import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg) + +import Instances.Data.Semigroup () + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Data.Semigroup () + +semigroupTests :: [TestTree] +semigroupTests = + [ testGroup "Text.Show.Text.Data.Semigroup" + [ testProperty "Min Int instance" (prop_matchesShow :: Int -> Min Int -> Bool) + , testProperty "Max Int instance" (prop_matchesShow :: Int -> Max Int -> Bool) + , testProperty "First Int instance" (prop_matchesShow :: Int -> First Int -> Bool) + , testProperty "Last Int Char" (prop_matchesShow :: Int -> Last Int -> Bool) + , testProperty "WrappedMonoid Int instance" (prop_matchesShow :: Int -> WrappedMonoid Int -> Bool) + , testProperty "Option Int instance" (prop_matchesShow :: Int -> Option Int -> Bool) + , testProperty "Arg Int Int instance" (prop_matchesShow :: Int -> Arg Int Int -> Bool) + ] ] diff --git a/tests/Properties/Data/String/UTF8.hs b/tests/Properties/Data/String/UTF8.hs --- a/tests/Properties/Data/String/UTF8.hs +++ b/tests/Properties/Data/String/UTF8.hs @@ -1,35 +1,35 @@ -{-| -Module: Properties.Data.String.UTF8 -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for 'UTF8' strings. --} -module Properties.Data.String.UTF8 (utf8StringTests) where - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BL -import Data.String.UTF8 (UTF8) -import Data.Word (Word8) - -import Instances.Data.String.UTF8 () - -import Properties.Utils (prop_matchesShow) - -import Test.QuickCheck.Instances () -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Data.String.UTF8 () - -utf8StringTests :: [TestTree] -utf8StringTests = - [ testGroup "Text.Show.Text.Data.String.UTF8" - [ testProperty "UTF8 ByteString (strict) instance" (prop_matchesShow :: Int -> UTF8 BS.ByteString -> Bool) - , testProperty "UTF8 ByteString (lazy) instance" (prop_matchesShow :: Int -> UTF8 BL.ByteString -> Bool) - , testProperty "UTF8 [Word8] instance" (prop_matchesShow :: Int -> UTF8 [Word8] -> Bool) - ] +{-| +Module: Properties.Data.String.UTF8 +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for 'UTF8' strings. +-} +module Properties.Data.String.UTF8 (utf8StringTests) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import Data.String.UTF8 (UTF8) +import Data.Word (Word8) + +import Instances.Data.String.UTF8 () + +import Properties.Utils (prop_matchesShow) + +import Test.QuickCheck.Instances () +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Data.String.UTF8 () + +utf8StringTests :: [TestTree] +utf8StringTests = + [ testGroup "Text.Show.Text.Data.String.UTF8" + [ testProperty "UTF8 ByteString (strict) instance" (prop_matchesShow :: Int -> UTF8 BS.ByteString -> Bool) + , testProperty "UTF8 ByteString (lazy) instance" (prop_matchesShow :: Int -> UTF8 BL.ByteString -> Bool) + , testProperty "UTF8 [Word8] instance" (prop_matchesShow :: Int -> UTF8 [Word8] -> Bool) + ] ] diff --git a/tests/Properties/Data/Tagged.hs b/tests/Properties/Data/Tagged.hs --- a/tests/Properties/Data/Tagged.hs +++ b/tests/Properties/Data/Tagged.hs @@ -1,29 +1,29 @@ -{-| -Module: Properties.Data.Tagged -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for 'Tagged' values. --} -module Properties.Data.Tagged (taggedTests) where - -import Data.Tagged (Tagged) - -import Instances.Data.Tagged () - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Data.Tagged () - -taggedTests :: [TestTree] -taggedTests = - [ testGroup "Text.Show.Text.Data.Tagged" - [ testProperty "Tagged Char Int instance" (prop_matchesShow :: Int -> Tagged Char Int -> Bool) - ] +{-| +Module: Properties.Data.Tagged +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for 'Tagged' values. +-} +module Properties.Data.Tagged (taggedTests) where + +import Data.Tagged (Tagged) + +import Instances.Data.Tagged () + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Data.Tagged () + +taggedTests :: [TestTree] +taggedTests = + [ testGroup "Text.Show.Text.Data.Tagged" + [ testProperty "Tagged Char Int instance" (prop_matchesShow :: Int -> Tagged Char Int -> Bool) + ] ] diff --git a/tests/Properties/Data/Time.hs b/tests/Properties/Data/Time.hs --- a/tests/Properties/Data/Time.hs +++ b/tests/Properties/Data/Time.hs @@ -1,39 +1,39 @@ -{-| -Module: Properties.Data.Time -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in the @time@ library. --} -module Properties.Data.Time (timeTests) where - -import Data.Time.Calendar (Day) -import Data.Time.Clock (DiffTime, UTCTime, NominalDiffTime) -import Data.Time.Clock.TAI (AbsoluteTime) -import Data.Time.LocalTime (TimeZone, TimeOfDay, LocalTime, ZonedTime) - -import Properties.Utils (prop_matchesShow) - -import Test.QuickCheck.Instances () -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Data.Time () - -timeTests :: [TestTree] -timeTests = - [ testGroup "Text.Show.Text.Data.Time" - [ testProperty "Day instance" (prop_matchesShow :: Int -> Day -> Bool) - , testProperty "DiffTime instance" (prop_matchesShow :: Int -> DiffTime -> Bool) - , testProperty "UTCTime instance" (prop_matchesShow :: Int -> UTCTime -> Bool) - , testProperty "NominalDiffTime instance" (prop_matchesShow :: Int -> NominalDiffTime -> Bool) - , testProperty "AbsoluteTime instance" (prop_matchesShow :: Int -> AbsoluteTime -> Bool) - , testProperty "TimeZone instance" (prop_matchesShow :: Int -> TimeZone -> Bool) - , testProperty "TimeOfDay instance" (prop_matchesShow :: Int -> TimeOfDay -> Bool) - , testProperty "LocalTime instance" (prop_matchesShow :: Int -> LocalTime -> Bool) - , testProperty "ZonedTime instance" (prop_matchesShow :: Int -> ZonedTime -> Bool) - ] +{-| +Module: Properties.Data.Time +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in the @time@ library. +-} +module Properties.Data.Time (timeTests) where + +import Data.Time.Calendar (Day) +import Data.Time.Clock (DiffTime, UTCTime, NominalDiffTime) +import Data.Time.Clock.TAI (AbsoluteTime) +import Data.Time.LocalTime (TimeZone, TimeOfDay, LocalTime, ZonedTime) + +import Properties.Utils (prop_matchesShow) + +import Test.QuickCheck.Instances () +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Data.Time () + +timeTests :: [TestTree] +timeTests = + [ testGroup "Text.Show.Text.Data.Time" + [ testProperty "Day instance" (prop_matchesShow :: Int -> Day -> Bool) + , testProperty "DiffTime instance" (prop_matchesShow :: Int -> DiffTime -> Bool) + , testProperty "UTCTime instance" (prop_matchesShow :: Int -> UTCTime -> Bool) + , testProperty "NominalDiffTime instance" (prop_matchesShow :: Int -> NominalDiffTime -> Bool) + , testProperty "AbsoluteTime instance" (prop_matchesShow :: Int -> AbsoluteTime -> Bool) + , testProperty "TimeZone instance" (prop_matchesShow :: Int -> TimeZone -> Bool) + , testProperty "TimeOfDay instance" (prop_matchesShow :: Int -> TimeOfDay -> Bool) + , testProperty "LocalTime instance" (prop_matchesShow :: Int -> LocalTime -> Bool) + , testProperty "ZonedTime instance" (prop_matchesShow :: Int -> ZonedTime -> Bool) + ] ] diff --git a/tests/Properties/Data/UnorderedContainers.hs b/tests/Properties/Data/UnorderedContainers.hs --- a/tests/Properties/Data/UnorderedContainers.hs +++ b/tests/Properties/Data/UnorderedContainers.hs @@ -1,30 +1,30 @@ -{-| -Module: Properties.Data.UnorderedContainers -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for 'HashMap's and 'HashSet's. --} -module Properties.Data.UnorderedContainers (unorderedContainersTests) where - -import Data.HashMap.Lazy (HashMap) -import Data.HashSet (HashSet) - -import Properties.Utils (prop_matchesShow) - -import Test.QuickCheck.Instances () -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Data.UnorderedContainers () - -unorderedContainersTests :: [TestTree] -unorderedContainersTests = - [ testGroup "Text.Show.Text.Data.UnorderedContainers" - [ testProperty "HashMap Char Char instance" (prop_matchesShow :: Int -> HashMap Char Char -> Bool) - , testProperty "HashSet Char instance" (prop_matchesShow :: Int -> HashSet Char -> Bool) - ] +{-| +Module: Properties.Data.UnorderedContainers +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for 'HashMap's and 'HashSet's. +-} +module Properties.Data.UnorderedContainers (unorderedContainersTests) where + +import Data.HashMap.Lazy (HashMap) +import Data.HashSet (HashSet) + +import Properties.Utils (prop_matchesShow) + +import Test.QuickCheck.Instances () +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Data.UnorderedContainers () + +unorderedContainersTests :: [TestTree] +unorderedContainersTests = + [ testGroup "Text.Show.Text.Data.UnorderedContainers" + [ testProperty "HashMap Char Char instance" (prop_matchesShow :: Int -> HashMap Char Char -> Bool) + , testProperty "HashSet Char instance" (prop_matchesShow :: Int -> HashSet Char -> Bool) + ] ] diff --git a/tests/Properties/Language/Haskell/TH.hs b/tests/Properties/Language/Haskell/TH.hs --- a/tests/Properties/Language/Haskell/TH.hs +++ b/tests/Properties/Language/Haskell/TH.hs @@ -1,100 +1,100 @@ -{-# LANGUAGE CPP #-} -{-| -Module: Properties.Language.Haskell.TH -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in the @template-haskell@ library. --} -module Properties.Language.Haskell.TH (templateHaskellTests) where - -import Instances.Language.Haskell.TH () - -import Language.Haskell.TH.PprLib -import Language.Haskell.TH.Syntax - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text (fromString) -import Text.Show.Text.Language.Haskell.TH (showbName') - --- | Verifies that `showName'` and `showbName'` have the same output. -prop_showName' :: NameIs -> Name -> Bool -prop_showName' nameIs name = fromString (showName' nameIs name) == showbName' nameIs name - -templateHaskellTests :: [TestTree] -templateHaskellTests = - [ testGroup "Text.Show.Text.Language.Haskell.TH" - [ -#if MIN_VERSION_template_haskell(2,9,0) - testProperty "AnnLookup instance" (prop_matchesShow :: Int -> AnnLookup -> Bool) - , testProperty "AnnTarget instance" (prop_matchesShow :: Int -> AnnTarget -> Bool), -#endif - testProperty "Body instance" (prop_matchesShow :: Int -> Body -> Bool) - , testProperty "Callconv instance" (prop_matchesShow :: Int -> Callconv -> Bool) -#if MIN_VERSION_template_haskell(2,5,0) && !(MIN_VERSION_template_haskell(2,7,0)) - , testProperty "ClassInstance instance" (prop_matchesShow :: Int -> ClassInstance -> Bool) -#endif - , testProperty "Clause instance" (prop_matchesShow :: Int -> Clause -> Bool) - , testProperty "Con instance" (prop_matchesShow :: Int -> Con -> Bool) - , testProperty "Dec instance" (prop_matchesShow :: Int -> Dec -> Bool) - , testProperty "Exp instance" (prop_matchesShow :: Int -> Exp -> Bool) - , testProperty "FamFlavour instance" (prop_matchesShow :: Int -> FamFlavour -> Bool) - , testProperty "Fixity instance" (prop_matchesShow :: Int -> Fixity -> Bool) - , testProperty "FixityDirection instance" (prop_matchesShow :: Int -> FixityDirection -> Bool) - , testProperty "Foreign instance" (prop_matchesShow :: Int -> Foreign -> Bool) - , testProperty "FunDep instance" (prop_matchesShow :: Int -> FunDep -> Bool) - , testProperty "Guard instance" (prop_matchesShow :: Int -> Guard -> Bool) - , testProperty "Info instance" (prop_matchesShow :: Int -> Info -> Bool) -#if MIN_VERSION_template_haskell(2,8,0) - , testProperty "Inline instance" (prop_matchesShow :: Int -> Inline -> Bool) -#else - , testProperty "InlineSpec instance" (prop_matchesShow :: Int -> InlineSpec -> Bool) -#endif - , testProperty "Kind instance" (prop_matchesShow :: Int -> Kind -> Bool) - , testProperty "Lit instance" (prop_matchesShow :: Int -> Lit -> Bool) - , testProperty "Loc instance" (prop_matchesShow :: Int -> Loc -> Bool) - , testProperty "Match instance" (prop_matchesShow :: Int -> Match -> Bool) - , testProperty "ModName instance" (prop_matchesShow :: Int -> ModName -> Bool) -#if MIN_VERSION_template_haskell(2,9,0) - , testProperty "Module instance" (prop_matchesShow :: Int -> Module -> Bool) - , testProperty "ModuleInfo instance" (prop_matchesShow :: Int -> ModuleInfo -> Bool) -#endif - , testProperty "Name instance" (prop_matchesShow :: Int -> Name -> Bool) - , testProperty "showbName' output" prop_showName' - , testProperty "OccName instance" (prop_matchesShow :: Int -> OccName -> Bool) - , testProperty "Pat instance" (prop_matchesShow :: Int -> Pat -> Bool) -#if MIN_VERSION_template_haskell(2,8,0) - , testProperty "Phases instance" (prop_matchesShow :: Int -> Phases -> Bool) -#endif - , testProperty "PkgName instance" (prop_matchesShow :: Int -> PkgName -> Bool) - , testProperty "Pred instance" (prop_matchesShow :: Int -> Pred -> Bool) - , testProperty "Pragma instance" (prop_matchesShow :: Int -> Pragma -> Bool) - , testProperty "Range instance" (prop_matchesShow :: Int -> Range -> Bool) -#if MIN_VERSION_template_haskell(2,9,0) - , testProperty "Role instance" (prop_matchesShow :: Int -> Role -> Bool) -#endif -#if MIN_VERSION_template_haskell(2,8,0) - , testProperty "RuleBndr instance" (prop_matchesShow :: Int -> RuleBndr -> Bool) - , testProperty "RuleMatch instance" (prop_matchesShow :: Int -> RuleMatch -> Bool) -#endif - , testProperty "Safety instance" (prop_matchesShow :: Int -> Safety -> Bool) - , testProperty "Stmt instance" (prop_matchesShow :: Int -> Stmt -> Bool) - , testProperty "Strict instance" (prop_matchesShow :: Int -> Strict -> Bool) -#if MIN_VERSION_template_haskell(2,8,0) - , testProperty "TyLit instance" (prop_matchesShow :: Int -> TyLit -> Bool) -#endif - , testProperty "Type instance" (prop_matchesShow :: Int -> Type -> Bool) -#if MIN_VERSION_template_haskell(2,9,0) - , testProperty "TySynEqn instance" (prop_matchesShow :: Int -> TySynEqn -> Bool) -#endif - , testProperty "TyVarBndr instance" (prop_matchesShow :: Int -> TyVarBndr -> Bool) - , testProperty "Doc instance" (prop_matchesShow :: Int -> Doc -> Bool) - ] +{-# LANGUAGE CPP #-} +{-| +Module: Properties.Language.Haskell.TH +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in the @template-haskell@ library. +-} +module Properties.Language.Haskell.TH (templateHaskellTests) where + +import Instances.Language.Haskell.TH () + +import Language.Haskell.TH.PprLib +import Language.Haskell.TH.Syntax + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text (fromString) +import Text.Show.Text.Language.Haskell.TH (showbName') + +-- | Verifies that `showName'` and `showbName'` have the same output. +prop_showName' :: NameIs -> Name -> Bool +prop_showName' nameIs name = fromString (showName' nameIs name) == showbName' nameIs name + +templateHaskellTests :: [TestTree] +templateHaskellTests = + [ testGroup "Text.Show.Text.Language.Haskell.TH" + [ +#if MIN_VERSION_template_haskell(2,9,0) + testProperty "AnnLookup instance" (prop_matchesShow :: Int -> AnnLookup -> Bool) + , testProperty "AnnTarget instance" (prop_matchesShow :: Int -> AnnTarget -> Bool), +#endif + testProperty "Body instance" (prop_matchesShow :: Int -> Body -> Bool) + , testProperty "Callconv instance" (prop_matchesShow :: Int -> Callconv -> Bool) +#if MIN_VERSION_template_haskell(2,5,0) && !(MIN_VERSION_template_haskell(2,7,0)) + , testProperty "ClassInstance instance" (prop_matchesShow :: Int -> ClassInstance -> Bool) +#endif + , testProperty "Clause instance" (prop_matchesShow :: Int -> Clause -> Bool) + , testProperty "Con instance" (prop_matchesShow :: Int -> Con -> Bool) + , testProperty "Dec instance" (prop_matchesShow :: Int -> Dec -> Bool) + , testProperty "Exp instance" (prop_matchesShow :: Int -> Exp -> Bool) + , testProperty "FamFlavour instance" (prop_matchesShow :: Int -> FamFlavour -> Bool) + , testProperty "Fixity instance" (prop_matchesShow :: Int -> Fixity -> Bool) + , testProperty "FixityDirection instance" (prop_matchesShow :: Int -> FixityDirection -> Bool) + , testProperty "Foreign instance" (prop_matchesShow :: Int -> Foreign -> Bool) + , testProperty "FunDep instance" (prop_matchesShow :: Int -> FunDep -> Bool) + , testProperty "Guard instance" (prop_matchesShow :: Int -> Guard -> Bool) + , testProperty "Info instance" (prop_matchesShow :: Int -> Info -> Bool) +#if MIN_VERSION_template_haskell(2,8,0) + , testProperty "Inline instance" (prop_matchesShow :: Int -> Inline -> Bool) +#else + , testProperty "InlineSpec instance" (prop_matchesShow :: Int -> InlineSpec -> Bool) +#endif + , testProperty "Kind instance" (prop_matchesShow :: Int -> Kind -> Bool) + , testProperty "Lit instance" (prop_matchesShow :: Int -> Lit -> Bool) + , testProperty "Loc instance" (prop_matchesShow :: Int -> Loc -> Bool) + , testProperty "Match instance" (prop_matchesShow :: Int -> Match -> Bool) + , testProperty "ModName instance" (prop_matchesShow :: Int -> ModName -> Bool) +#if MIN_VERSION_template_haskell(2,9,0) + , testProperty "Module instance" (prop_matchesShow :: Int -> Module -> Bool) + , testProperty "ModuleInfo instance" (prop_matchesShow :: Int -> ModuleInfo -> Bool) +#endif + , testProperty "Name instance" (prop_matchesShow :: Int -> Name -> Bool) + , testProperty "showbName' output" prop_showName' + , testProperty "OccName instance" (prop_matchesShow :: Int -> OccName -> Bool) + , testProperty "Pat instance" (prop_matchesShow :: Int -> Pat -> Bool) +#if MIN_VERSION_template_haskell(2,8,0) + , testProperty "Phases instance" (prop_matchesShow :: Int -> Phases -> Bool) +#endif + , testProperty "PkgName instance" (prop_matchesShow :: Int -> PkgName -> Bool) + , testProperty "Pred instance" (prop_matchesShow :: Int -> Pred -> Bool) + , testProperty "Pragma instance" (prop_matchesShow :: Int -> Pragma -> Bool) + , testProperty "Range instance" (prop_matchesShow :: Int -> Range -> Bool) +#if MIN_VERSION_template_haskell(2,9,0) + , testProperty "Role instance" (prop_matchesShow :: Int -> Role -> Bool) +#endif +#if MIN_VERSION_template_haskell(2,8,0) + , testProperty "RuleBndr instance" (prop_matchesShow :: Int -> RuleBndr -> Bool) + , testProperty "RuleMatch instance" (prop_matchesShow :: Int -> RuleMatch -> Bool) +#endif + , testProperty "Safety instance" (prop_matchesShow :: Int -> Safety -> Bool) + , testProperty "Stmt instance" (prop_matchesShow :: Int -> Stmt -> Bool) + , testProperty "Strict instance" (prop_matchesShow :: Int -> Strict -> Bool) +#if MIN_VERSION_template_haskell(2,8,0) + , testProperty "TyLit instance" (prop_matchesShow :: Int -> TyLit -> Bool) +#endif + , testProperty "Type instance" (prop_matchesShow :: Int -> Type -> Bool) +#if MIN_VERSION_template_haskell(2,9,0) + , testProperty "TySynEqn instance" (prop_matchesShow :: Int -> TySynEqn -> Bool) +#endif + , testProperty "TyVarBndr instance" (prop_matchesShow :: Int -> TyVarBndr -> Bool) + , testProperty "Doc instance" (prop_matchesShow :: Int -> Doc -> Bool) + ] ] diff --git a/tests/Properties/System/Console/Haskeline.hs b/tests/Properties/System/Console/Haskeline.hs --- a/tests/Properties/System/Console/Haskeline.hs +++ b/tests/Properties/System/Console/Haskeline.hs @@ -1,37 +1,37 @@ -{-| -Module: Properties.System.Console.Haskeline -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in the @haskeline@ library. --} -module Properties.System.Console.Haskeline (haskelineTests) where - -import Instances.System.Console.Haskeline () - -import Properties.Utils (prop_matchesShow) - -import System.Console.Haskeline (Interrupt, defaultPrefs) -import System.Console.Haskeline.Completion (Completion) -import System.Console.Haskeline.History (History) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit ((@=?), testCase) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text (FromStringShow(..), showb) -import Text.Show.Text.System.Console.Haskeline () - -haskelineTests :: [TestTree] -haskelineTests = - [ testGroup "Text.Show.Text.System.Console.Haskeline" - [ testProperty "Interrupt instance" (prop_matchesShow :: Int -> Interrupt -> Bool) --- , testProperty "Prefs instance" (prop_matchesShow :: Int -> Prefs -> Bool) - , testCase "defaultPrefs Show output" $ showb (FromStringShow defaultPrefs) @=? showb defaultPrefs - , testProperty "Completion instance" (prop_matchesShow :: Int -> Completion -> Bool) - , testProperty "History instance" (prop_matchesShow :: Int -> History -> Bool) - ] +{-| +Module: Properties.System.Console.Haskeline +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in the @haskeline@ library. +-} +module Properties.System.Console.Haskeline (haskelineTests) where + +import Instances.System.Console.Haskeline () + +import Properties.Utils (prop_matchesShow) + +import System.Console.Haskeline (Interrupt, defaultPrefs) +import System.Console.Haskeline.Completion (Completion) +import System.Console.Haskeline.History (History) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit ((@=?), testCase) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text (FromStringShow(..), showb) +import Text.Show.Text.System.Console.Haskeline () + +haskelineTests :: [TestTree] +haskelineTests = + [ testGroup "Text.Show.Text.System.Console.Haskeline" + [ testProperty "Interrupt instance" (prop_matchesShow :: Int -> Interrupt -> Bool) +-- , testProperty "Prefs instance" (prop_matchesShow :: Int -> Prefs -> Bool) + , testCase "defaultPrefs Show output" $ showb (FromStringShow defaultPrefs) @=? showb defaultPrefs + , testProperty "Completion instance" (prop_matchesShow :: Int -> Completion -> Bool) + , testProperty "History instance" (prop_matchesShow :: Int -> History -> Bool) + ] ] diff --git a/tests/Properties/System/Console/Terminfo.hs b/tests/Properties/System/Console/Terminfo.hs --- a/tests/Properties/System/Console/Terminfo.hs +++ b/tests/Properties/System/Console/Terminfo.hs @@ -1,30 +1,30 @@ -{-| -Module: Properties.System.Console.Terminfo -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in the @terminfo@ library. --} -module Properties.System.Console.Terminfo (terminfoTests) where - -import Instances.System.Console.Terminfo () - -import Properties.Utils (prop_matchesShow) - -import System.Console.Terminfo.Color (Color) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.System.Console.Terminfo () - -terminfoTests :: [TestTree] -terminfoTests = - [ testGroup "Text.Show.Text.System.Console.Terminfo" - [ testProperty "Color instance" (prop_matchesShow :: Int -> Color -> Bool) --- , testProperty "SetupTermError instance" (prop_matchesShow :: Int -> SetupTermError -> Bool) - ] +{-| +Module: Properties.System.Console.Terminfo +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in the @terminfo@ library. +-} +module Properties.System.Console.Terminfo (terminfoTests) where + +import Instances.System.Console.Terminfo () + +import Properties.Utils (prop_matchesShow) + +import System.Console.Terminfo.Color (Color) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.System.Console.Terminfo () + +terminfoTests :: [TestTree] +terminfoTests = + [ testGroup "Text.Show.Text.System.Console.Terminfo" + [ testProperty "Color instance" (prop_matchesShow :: Int -> Color -> Bool) +-- , testProperty "SetupTermError instance" (prop_matchesShow :: Int -> SetupTermError -> Bool) + ] ] diff --git a/tests/Properties/System/Directory.hs b/tests/Properties/System/Directory.hs --- a/tests/Properties/System/Directory.hs +++ b/tests/Properties/System/Directory.hs @@ -1,35 +1,35 @@ -{-# LANGUAGE CPP #-} -{-| -Module: Properties.System.Directory -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for 'Permissions'. --} -module Properties.System.Directory (directoryTests) where - -#if MIN_VERSION_directory(1,1,0) -import Instances.System.Directory () - -import Properties.Utils (prop_matchesShow) - -import System.Directory (Permissions) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.System.Directory () -#endif - -directoryTests :: [TestTree] -directoryTests = - [ -#if MIN_VERSION_directory(1,1,0) - testGroup "Text.Show.Text.System.Directory" - [ testProperty "Permissions instance" (prop_matchesShow :: Int -> Permissions -> Bool) - ] -#endif +{-# LANGUAGE CPP #-} +{-| +Module: Properties.System.Directory +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for 'Permissions'. +-} +module Properties.System.Directory (directoryTests) where + +#if MIN_VERSION_directory(1,1,0) +import Instances.System.Directory () + +import Properties.Utils (prop_matchesShow) + +import System.Directory (Permissions) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.System.Directory () +#endif + +directoryTests :: [TestTree] +directoryTests = + [ +#if MIN_VERSION_directory(1,1,0) + testGroup "Text.Show.Text.System.Directory" + [ testProperty "Permissions instance" (prop_matchesShow :: Int -> Permissions -> Bool) + ] +#endif ] diff --git a/tests/Properties/System/Locale.hs b/tests/Properties/System/Locale.hs --- a/tests/Properties/System/Locale.hs +++ b/tests/Properties/System/Locale.hs @@ -1,29 +1,29 @@ -{-| -Module: Properties.System.Locale -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for old 'TimeLocale's. --} -module Properties.System.Locale (oldLocaleTests) where - -import Instances.System.Locale () - -import Properties.Utils (prop_matchesShow) - -import System.Locale (TimeLocale) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.System.Locale () - -oldLocaleTests :: [TestTree] -oldLocaleTests = - [ testGroup "Text.Show.Text.System.Locale" - [ testProperty "TimeLocale instance" (prop_matchesShow :: Int -> TimeLocale -> Bool) - ] +{-| +Module: Properties.System.Locale +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for old 'TimeLocale's. +-} +module Properties.System.Locale (oldLocaleTests) where + +import Instances.System.Locale () + +import Properties.Utils (prop_matchesShow) + +import System.Locale (TimeLocale) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.System.Locale () + +oldLocaleTests :: [TestTree] +oldLocaleTests = + [ testGroup "Text.Show.Text.System.Locale" + [ testProperty "TimeLocale instance" (prop_matchesShow :: Int -> TimeLocale -> Bool) + ] ] diff --git a/tests/Properties/System/Posix.hs b/tests/Properties/System/Posix.hs --- a/tests/Properties/System/Posix.hs +++ b/tests/Properties/System/Posix.hs @@ -1,35 +1,35 @@ -{-| -Module: Properties.System.Posix -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in the @unix@ library. --} -module Properties.System.Posix (unixTests) where - -import Instances.System.Posix () - -import Properties.Utils (prop_matchesShow) - -import System.Posix.DynamicLinker (RTLDFlags, DL) -import System.Posix.Process (ProcessStatus) -import System.Posix.User (GroupEntry, UserEntry) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.System.Posix () - -unixTests :: [TestTree] -unixTests = - [ testGroup "Text.Show.Text.System.Posix" - [ testProperty "RTLDFlags instance" (prop_matchesShow :: Int -> RTLDFlags -> Bool) - , testProperty "DL instance" (prop_matchesShow :: Int -> DL -> Bool) - , testProperty "ProcessStatus instance" (prop_matchesShow :: Int -> ProcessStatus -> Bool) - , testProperty "GroupEntry instance" (prop_matchesShow :: Int -> GroupEntry -> Bool) - , testProperty "UserEntry instance" (prop_matchesShow :: Int -> UserEntry -> Bool) - ] +{-| +Module: Properties.System.Posix +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in the @unix@ library. +-} +module Properties.System.Posix (unixTests) where + +import Instances.System.Posix () + +import Properties.Utils (prop_matchesShow) + +import System.Posix.DynamicLinker (RTLDFlags, DL) +import System.Posix.Process (ProcessStatus) +import System.Posix.User (GroupEntry, UserEntry) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.System.Posix () + +unixTests :: [TestTree] +unixTests = + [ testGroup "Text.Show.Text.System.Posix" + [ testProperty "RTLDFlags instance" (prop_matchesShow :: Int -> RTLDFlags -> Bool) + , testProperty "DL instance" (prop_matchesShow :: Int -> DL -> Bool) + , testProperty "ProcessStatus instance" (prop_matchesShow :: Int -> ProcessStatus -> Bool) + , testProperty "GroupEntry instance" (prop_matchesShow :: Int -> GroupEntry -> Bool) + , testProperty "UserEntry instance" (prop_matchesShow :: Int -> UserEntry -> Bool) + ] ] diff --git a/tests/Properties/System/Random.hs b/tests/Properties/System/Random.hs --- a/tests/Properties/System/Random.hs +++ b/tests/Properties/System/Random.hs @@ -1,29 +1,29 @@ -{-| -Module: Properties.System.Random -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for 'StdGen' values. --} -module Properties.System.Random (randomTests) where - -import Instances.System.Random () - -import Properties.Utils (prop_matchesShow) - -import System.Random (StdGen) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.System.Random () - -randomTests :: [TestTree] -randomTests = - [ testGroup "Text.Show.Text.System.Random" - [ testProperty "StdGen instance" (prop_matchesShow :: Int -> StdGen -> Bool) - ] +{-| +Module: Properties.System.Random +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for 'StdGen' values. +-} +module Properties.System.Random (randomTests) where + +import Instances.System.Random () + +import Properties.Utils (prop_matchesShow) + +import System.Random (StdGen) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.System.Random () + +randomTests :: [TestTree] +randomTests = + [ testGroup "Text.Show.Text.System.Random" + [ testProperty "StdGen instance" (prop_matchesShow :: Int -> StdGen -> Bool) + ] ] diff --git a/tests/Properties/System/Time.hs b/tests/Properties/System/Time.hs --- a/tests/Properties/System/Time.hs +++ b/tests/Properties/System/Time.hs @@ -1,32 +1,32 @@ -{-| -Module: Properties.System.Time -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in @old-time@. --} -module Properties.System.Time (oldTimeTests) where - -import Properties.Utils (prop_matchesShow) - -import System.Time (ClockTime, TimeDiff, CalendarTime, Month, Day) - -import Test.QuickCheck.Instances () -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.System.Time () - -oldTimeTests :: [TestTree] -oldTimeTests = - [ testGroup "Text.Show.Text.System.Time" - [ testProperty "ClockTime instance" (prop_matchesShow :: Int -> ClockTime -> Bool) - , testProperty "TimeDiff instance" (prop_matchesShow :: Int -> TimeDiff -> Bool) - , testProperty "CalendarTime instance" (prop_matchesShow :: Int -> CalendarTime -> Bool) - , testProperty "Month instance" (prop_matchesShow :: Int -> Month -> Bool) - , testProperty "Day instance" (prop_matchesShow :: Int -> Day -> Bool) - ] - ] +{-| +Module: Properties.System.Time +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in @old-time@. +-} +module Properties.System.Time (oldTimeTests) where + +import Properties.Utils (prop_matchesShow) + +import System.Time (ClockTime, TimeDiff, CalendarTime, Month, Day) + +import Test.QuickCheck.Instances () +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.System.Time () + +oldTimeTests :: [TestTree] +oldTimeTests = + [ testGroup "Text.Show.Text.System.Time" + [ testProperty "ClockTime instance" (prop_matchesShow :: Int -> ClockTime -> Bool) + , testProperty "TimeDiff instance" (prop_matchesShow :: Int -> TimeDiff -> Bool) + , testProperty "CalendarTime instance" (prop_matchesShow :: Int -> CalendarTime -> Bool) + , testProperty "Month instance" (prop_matchesShow :: Int -> Month -> Bool) + , testProperty "Day instance" (prop_matchesShow :: Int -> Day -> Bool) + ] + ] diff --git a/tests/Properties/System/Win32.hs b/tests/Properties/System/Win32.hs --- a/tests/Properties/System/Win32.hs +++ b/tests/Properties/System/Win32.hs @@ -1,41 +1,41 @@ -{-| -Module: Properties.System.Win32 -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in the @Win32@ library. --} -module Properties.System.Win32 (win32Tests) where - -import Instances.System.Win32 () - -import Properties.Utils (prop_matchesShow) - -import System.Win32.DebugApi (DebugEventInfo, Exception) -import System.Win32.File (BY_HANDLE_FILE_INFORMATION, WIN32_FILE_ATTRIBUTE_DATA) -import System.Win32.Info (ProcessorArchitecture, SYSTEM_INFO) -import System.Win32.Time (FILETIME, SYSTEMTIME, TIME_ZONE_INFORMATION, TimeZoneId) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.System.Win32 () - -win32Tests :: [TestTree] -win32Tests = - [ testGroup "Text.Show.Text.System.Win32" - [ testProperty "DebugEventInfo instance" (prop_matchesShow :: Int -> DebugEventInfo -> Bool) - , testProperty "Exception instance" (prop_matchesShow :: Int -> Exception -> Bool) - , testProperty "BY_HANDLE_FILE_INFORMATION instance" (prop_matchesShow :: Int -> BY_HANDLE_FILE_INFORMATION -> Bool) - , testProperty "WIN32_FILE_ATTRIBUTE_DATA instance" (prop_matchesShow :: Int -> WIN32_FILE_ATTRIBUTE_DATA -> Bool) - , testProperty "ProcessorArchitecture instance" (prop_matchesShow :: Int -> ProcessorArchitecture -> Bool) - , testProperty "SYSTEM_INFO instance" (prop_matchesShow :: Int -> SYSTEM_INFO -> Bool) - , testProperty "FILETIME instance" (prop_matchesShow :: Int -> FILETIME -> Bool) - , testProperty "SYSTEMTIME instance" (prop_matchesShow :: Int -> SYSTEMTIME -> Bool) - , testProperty "TIME_ZONE_INFORMATION instance" (prop_matchesShow :: Int -> TIME_ZONE_INFORMATION -> Bool) - , testProperty "TimeZoneId instance" (prop_matchesShow :: Int -> TimeZoneId -> Bool) - ] +{-| +Module: Properties.System.Win32 +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in the @Win32@ library. +-} +module Properties.System.Win32 (win32Tests) where + +import Instances.System.Win32 () + +import Properties.Utils (prop_matchesShow) + +import System.Win32.DebugApi (DebugEventInfo, Exception) +import System.Win32.File (BY_HANDLE_FILE_INFORMATION, WIN32_FILE_ATTRIBUTE_DATA) +import System.Win32.Info (ProcessorArchitecture, SYSTEM_INFO) +import System.Win32.Time (FILETIME, SYSTEMTIME, TIME_ZONE_INFORMATION, TimeZoneId) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.System.Win32 () + +win32Tests :: [TestTree] +win32Tests = + [ testGroup "Text.Show.Text.System.Win32" + [ testProperty "DebugEventInfo instance" (prop_matchesShow :: Int -> DebugEventInfo -> Bool) + , testProperty "Exception instance" (prop_matchesShow :: Int -> Exception -> Bool) + , testProperty "BY_HANDLE_FILE_INFORMATION instance" (prop_matchesShow :: Int -> BY_HANDLE_FILE_INFORMATION -> Bool) + , testProperty "WIN32_FILE_ATTRIBUTE_DATA instance" (prop_matchesShow :: Int -> WIN32_FILE_ATTRIBUTE_DATA -> Bool) + , testProperty "ProcessorArchitecture instance" (prop_matchesShow :: Int -> ProcessorArchitecture -> Bool) + , testProperty "SYSTEM_INFO instance" (prop_matchesShow :: Int -> SYSTEM_INFO -> Bool) + , testProperty "FILETIME instance" (prop_matchesShow :: Int -> FILETIME -> Bool) + , testProperty "SYSTEMTIME instance" (prop_matchesShow :: Int -> SYSTEMTIME -> Bool) + , testProperty "TIME_ZONE_INFORMATION instance" (prop_matchesShow :: Int -> TIME_ZONE_INFORMATION -> Bool) + , testProperty "TimeZoneId instance" (prop_matchesShow :: Int -> TimeZoneId -> Bool) + ] ] diff --git a/tests/Properties/Text/PrettyPrint.hs b/tests/Properties/Text/PrettyPrint.hs --- a/tests/Properties/Text/PrettyPrint.hs +++ b/tests/Properties/Text/PrettyPrint.hs @@ -1,45 +1,45 @@ -{-# LANGUAGE CPP #-} -{-| -Module: Properties.Text.PrettyPrint -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in the @pretty@ library. --} -module Properties.Text.PrettyPrint (prettyTests) where - -import Instances.Text.PrettyPrint () - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.PrettyPrint.HughesPJ (Doc, Mode, Style, TextDetails {-, renderStyle -}) -#if MIN_VERSION_pretty(1,1,2) -import Text.PrettyPrint.HughesPJClass (PrettyLevel) -#endif --- import Text.Show.Text (fromString) -import Text.Show.Text.Text.PrettyPrint () -- (renderStyleB) - --- | Verifies that the output of 'renderStyle' and 'renderStyleB' coincides. --- prop_renderStyle :: Style -> Doc -> Bool --- prop_renderStyle sty doc = fromString (renderStyle sty doc) == renderStyleB sty doc - -prettyTests :: [TestTree] -prettyTests = - [ testGroup "Text.Show.Text.Text.PrettyPrint" - [ testProperty "Doc instance" (prop_matchesShow :: Int -> Doc -> Bool) - -- TODO: Figure out why this randomly stalls forever --- , testProperty "renderStyleB output" prop_renderStyle - , testProperty "Mode instance" (prop_matchesShow :: Int -> Mode -> Bool) - , testProperty "Style instance" (prop_matchesShow :: Int -> Style -> Bool) - , testProperty "TextDetails instance" (prop_matchesShow :: Int -> TextDetails -> Bool) -#if MIN_VERSION_pretty(1,1,2) - , testProperty "PrettyLevel instance" (prop_matchesShow :: Int -> PrettyLevel -> Bool) -#endif - ] - ] +{-# LANGUAGE CPP #-} +{-| +Module: Properties.Text.PrettyPrint +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in the @pretty@ library. +-} +module Properties.Text.PrettyPrint (prettyTests) where + +import Instances.Text.PrettyPrint () + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.PrettyPrint.HughesPJ (Doc, Mode, Style, TextDetails {-, renderStyle -}) +#if MIN_VERSION_pretty(1,1,2) +import Text.PrettyPrint.HughesPJClass (PrettyLevel) +#endif +-- import Text.Show.Text (fromString) +import Text.Show.Text.Text.PrettyPrint () -- (renderStyleB) + +-- | Verifies that the output of 'renderStyle' and 'renderStyleB' coincides. +-- prop_renderStyle :: Style -> Doc -> Bool +-- prop_renderStyle sty doc = fromString (renderStyle sty doc) == renderStyleB sty doc + +prettyTests :: [TestTree] +prettyTests = + [ testGroup "Text.Show.Text.Text.PrettyPrint" + [ testProperty "Doc instance" (prop_matchesShow :: Int -> Doc -> Bool) + -- TODO: Figure out why this randomly stalls forever +-- , testProperty "renderStyleB output" prop_renderStyle + , testProperty "Mode instance" (prop_matchesShow :: Int -> Mode -> Bool) + , testProperty "Style instance" (prop_matchesShow :: Int -> Style -> Bool) + , testProperty "TextDetails instance" (prop_matchesShow :: Int -> TextDetails -> Bool) +#if MIN_VERSION_pretty(1,1,2) + , testProperty "PrettyLevel instance" (prop_matchesShow :: Int -> PrettyLevel -> Bool) +#endif + ] + ] diff --git a/tests/Properties/Text/XHtml.hs b/tests/Properties/Text/XHtml.hs --- a/tests/Properties/Text/XHtml.hs +++ b/tests/Properties/Text/XHtml.hs @@ -1,33 +1,33 @@ -{-| -Module: Properties.Text.XHtml -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in the @xhtml@ library. --} -module Properties.Text.XHtml (xhtmlTests) where - -import Instances.Text.XHtml () - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Text.XHtml () -import Text.XHtml.Frameset (Html, HtmlAttr, HotLink) -import Text.XHtml.Table (HtmlTable) - -xhtmlTests :: [TestTree] -xhtmlTests = - [ testGroup "Text.Show.Text.Text.XHtml" - [ testProperty "Html instance" (prop_matchesShow :: Int -> Html -> Bool) - , testProperty "[Html] instance" (prop_matchesShow :: Int -> [Html] -> Bool) - , testProperty "HtmlAttr instance" (prop_matchesShow :: Int -> HtmlAttr -> Bool) - , testProperty "HotLink instance" (prop_matchesShow :: Int -> HotLink -> Bool) - , testProperty "HtmlTable instance" (prop_matchesShow :: Int -> HtmlTable -> Bool) - ] +{-| +Module: Properties.Text.XHtml +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in the @xhtml@ library. +-} +module Properties.Text.XHtml (xhtmlTests) where + +import Instances.Text.XHtml () + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Text.XHtml () +import Text.XHtml.Frameset (Html, HtmlAttr, HotLink) +import Text.XHtml.Table (HtmlTable) + +xhtmlTests :: [TestTree] +xhtmlTests = + [ testGroup "Text.Show.Text.Text.XHtml" + [ testProperty "Html instance" (prop_matchesShow :: Int -> Html -> Bool) + , testProperty "[Html] instance" (prop_matchesShow :: Int -> [Html] -> Bool) + , testProperty "HtmlAttr instance" (prop_matchesShow :: Int -> HtmlAttr -> Bool) + , testProperty "HotLink instance" (prop_matchesShow :: Int -> HotLink -> Bool) + , testProperty "HtmlTable instance" (prop_matchesShow :: Int -> HtmlTable -> Bool) + ] ] diff --git a/tests/Properties/Trace/Hpc.hs b/tests/Properties/Trace/Hpc.hs --- a/tests/Properties/Trace/Hpc.hs +++ b/tests/Properties/Trace/Hpc.hs @@ -1,37 +1,37 @@ -{-| -Module: Properties.Trace.Hpc -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ properties for data types in the @hpc@ library. --} -module Properties.Trace.Hpc (hpcTests) where - -import Instances.Trace.Hpc () - -import Properties.Utils (prop_matchesShow) - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) - -import Text.Show.Text.Trace.Hpc () - -import Trace.Hpc.Mix (Mix, BoxLabel, CondBox) -import Trace.Hpc.Tix (Tix, TixModule) -import Trace.Hpc.Util (HpcPos, Hash) - -hpcTests :: [TestTree] -hpcTests = - [ testGroup "Text.Show.Text.Trace.Hpc" - [ testProperty "Mix instance" (prop_matchesShow :: Int -> Mix -> Bool) - , testProperty "BoxLabel instance" (prop_matchesShow :: Int -> BoxLabel -> Bool) - , testProperty "CondBox instance" (prop_matchesShow :: Int -> CondBox -> Bool) - , testProperty "Tix instance" (prop_matchesShow :: Int -> Tix -> Bool) - , testProperty "TixModule instance" (prop_matchesShow :: Int -> TixModule -> Bool) - , testProperty "HpcPos instance" (prop_matchesShow :: Int -> HpcPos -> Bool) - , testProperty "Hash instance" (prop_matchesShow :: Int -> Hash -> Bool) - ] +{-| +Module: Properties.Trace.Hpc +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ properties for data types in the @hpc@ library. +-} +module Properties.Trace.Hpc (hpcTests) where + +import Instances.Trace.Hpc () + +import Properties.Utils (prop_matchesShow) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import Text.Show.Text.Trace.Hpc () + +import Trace.Hpc.Mix (Mix, BoxLabel, CondBox) +import Trace.Hpc.Tix (Tix, TixModule) +import Trace.Hpc.Util (HpcPos, Hash) + +hpcTests :: [TestTree] +hpcTests = + [ testGroup "Text.Show.Text.Trace.Hpc" + [ testProperty "Mix instance" (prop_matchesShow :: Int -> Mix -> Bool) + , testProperty "BoxLabel instance" (prop_matchesShow :: Int -> BoxLabel -> Bool) + , testProperty "CondBox instance" (prop_matchesShow :: Int -> CondBox -> Bool) + , testProperty "Tix instance" (prop_matchesShow :: Int -> Tix -> Bool) + , testProperty "TixModule instance" (prop_matchesShow :: Int -> TixModule -> Bool) + , testProperty "HpcPos instance" (prop_matchesShow :: Int -> HpcPos -> Bool) + , testProperty "Hash instance" (prop_matchesShow :: Int -> Hash -> Bool) + ] ] diff --git a/tests/Properties/Utils.hs b/tests/Properties/Utils.hs --- a/tests/Properties/Utils.hs +++ b/tests/Properties/Utils.hs @@ -1,24 +1,24 @@ -{-| -Module: Properties.Utils -Copyright: (C) 2014-2015 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Experimental -Portability: GHC - -@QuickCheck@ property-related utility functions. --} -module Properties.Utils (prop_matchesShow) where - -import Prelude hiding (Show) - -import Test.Tasty.QuickCheck (Arbitrary) - -import qualified Text.Show as S (Show) -import qualified Text.Show.Text as T (Show) -import Text.Show.Text (showbPrec, FromStringShow(..)) - --- | Verifies that a type's @Show@ instances coincide for both 'String's and 'Text', --- irrespective of precedence. -prop_matchesShow :: (S.Show a, T.Show a, Arbitrary a) => Int -> a -> Bool +{-| +Module: Properties.Utils +Copyright: (C) 2014-2015 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Experimental +Portability: GHC + +@QuickCheck@ property-related utility functions. +-} +module Properties.Utils (prop_matchesShow) where + +import Prelude hiding (Show) + +import Test.Tasty.QuickCheck (Arbitrary) + +import qualified Text.Show as S (Show) +import qualified Text.Show.Text as T (Show) +import Text.Show.Text (showbPrec, FromStringShow(..)) + +-- | Verifies that a type's @Show@ instances coincide for both 'String's and 'Text', +-- irrespective of precedence. +prop_matchesShow :: (S.Show a, T.Show a, Arbitrary a) => Int -> a -> Bool prop_matchesShow p x = showbPrec p (FromStringShow x) == showbPrec p x diff --git a/text-show-instances.cabal b/text-show-instances.cabal --- a/text-show-instances.cabal +++ b/text-show-instances.cabal @@ -1,235 +1,235 @@ -name: text-show-instances -version: 0.3 -synopsis: Additional instances for text-show -description: @text-show-instances@ is a supplemental library to @text-show@ - that provides additional @Show@ instances for data types in - common Haskell libraries and GHC dependencies that are not - encompassed by @text-show@. Currently, @text-show-instances@ - covers these libraries: - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - * @@ - . - One can use these instances by importing - "Text.Show.Text.Instances". Alternatively, there are monomorphic - versions of the @showb@ function available in the other submodules - of "Text.Show.Text". -homepage: https://github.com/RyanGlScott/text-show-instances -bug-reports: https://github.com/RyanGlScott/text-show-instances/issues -license: BSD3 -license-file: LICENSE -author: Ryan Scott -maintainer: Ryan Scott -stability: Experimental -copyright: (C) 2014-2015 Ryan Scott -category: Text -build-type: Simple -extra-source-files: CHANGELOG.md, README.md, include/inline.h -cabal-version: >=1.10 - -source-repository head - type: git - location: git://github.com/RyanGlScott/text-show-instances.git - -library - exposed-modules: Text.Show.Text.Instances - - Text.Show.Text.Compiler.Hoopl - Text.Show.Text.Control.Applicative.Trans - Text.Show.Text.Control.Monad.Trans - Text.Show.Text.Data.Binary - Text.Show.Text.Data.Containers - Text.Show.Text.Data.Functor.Trans - Text.Show.Text.Data.List.NonEmpty - Text.Show.Text.Data.Semigroup - Text.Show.Text.Data.String.UTF8 - Text.Show.Text.Data.Tagged - Text.Show.Text.Data.Time - Text.Show.Text.Data.UnorderedContainers - Text.Show.Text.Data.Vector - Text.Show.Text.Language.Haskell.TH - Text.Show.Text.System.Console.Haskeline - Text.Show.Text.System.Directory - Text.Show.Text.System.Locale - Text.Show.Text.System.Random - Text.Show.Text.System.Time - Text.Show.Text.Text.PrettyPrint - Text.Show.Text.Text.XHtml - Text.Show.Text.Trace.Hpc - other-modules: Text.Show.Text.Compiler - Text.Show.Text.Control - Text.Show.Text.Data - Text.Show.Text.Language - Text.Show.Text.System - Text.Show.Text.Text - Text.Show.Text.Trace - Text.Show.Text.Utils - build-depends: base >= 4.2 && < 5 - , binary >= 0.6 && < 0.8 - , bytestring  >= 0.9 && < 0.11 - , containers >= 0.1 && < 0.6 - , directory >= 1 && < 1.3 - , haskeline >= 0.7 && < 0.8 - , hoopl >= 3.8.7 && < 3.11 - , hpc >= 0.5 && < 0.7 - , old-locale >= 1 && < 1.1 - , old-time >= 1 && < 1.2 - , pretty >= 1 && < 1.2 - , random >= 1.0.1 && < 1.2 - , semigroups >= 0.16.2 && < 1 - , tagged >= 0.4.4 && < 1 - , template-haskell >= 2.4 && < 2.11 - , text >= 0.8 && < 1.3 - , text-show >= 0.5 && < 0.8 - , time >= 0.1 && < 1.6 - , transformers >= 0.2.1 && < 0.5 - , transformers-compat >= 0.3 && < 1 - , unordered-containers >= 0.2 && < 0.3 - , utf8-string >= 0.3.1 && < 1.1 - , vector >= 0.9 && < 0.11 - , xhtml >= 3000.2 && < 3000.3 - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall - include-dirs: include - includes: inline.h - install-includes: inline.h - - if os(windows) - build-depends: Win32 >= 2.1 && < 2.4 - exposed-modules: Text.Show.Text.System.Win32 - else - build-depends: terminfo >= 0.3.2 && < 0.5 - , unix >= 2 && < 2.8 - exposed-modules: Text.Show.Text.System.Console.Terminfo - Text.Show.Text.System.Posix - -test-suite text-show-instances-properties - type: exitcode-stdio-1.0 - main-is: Properties.hs - other-modules: Instances.Compiler.Hoopl - Instances.Control.Applicative.Trans - Instances.Control.Monad.Trans - Instances.Data.Binary - Instances.Data.Containers - Instances.Data.Functor.Trans - Instances.Data.List.NonEmpty - Instances.Data.Semigroup - Instances.Data.String.UTF8 - Instances.Data.Tagged - Instances.Language.Haskell.TH - Instances.Miscellaneous - Instances.System.Console.Haskeline - Instances.System.Directory - Instances.System.Locale - Instances.System.Random - Instances.Text.PrettyPrint - Instances.Text.XHtml - Instances.Trace.Hpc - Instances.Utils - Properties.Compiler.Hoopl - Properties.Control.Applicative.Trans - Properties.Control.Monad.Trans - Properties.Data.Binary - Properties.Data.Containers - Properties.Data.Functor.Trans - Properties.Data.List.NonEmpty - Properties.Data.Semigroup - Properties.Data.String.UTF8 - Properties.Data.Tagged - Properties.Data.Time - Properties.Data.UnorderedContainers - Properties.Language.Haskell.TH - Properties.System.Console.Haskeline - Properties.System.Directory - Properties.System.Locale - Properties.System.Random - Properties.System.Time - Properties.Text.PrettyPrint - Properties.Text.XHtml - Properties.Trace.Hpc - Properties.Utils - build-depends: base >= 4.5 && < 5 - , binary >= 0.6 && < 0.8 - , bytestring  >= 0.9 && < 0.11 - , containers >= 0.1 && < 0.6 - , directory >= 1 && < 1.3 - , haskeline >= 0.7 && < 0.8 - , hoopl >= 3.8.7 && < 3.11 - , hpc >= 0.5 && < 0.7 - , old-locale >= 1 && < 1.1 - , old-time >= 1 && < 1.2 - , pretty >= 1 && < 1.2 - , quickcheck-instances >= 0.1 && < 0.4 - , random >= 1.0.1 && < 1.2 - , semigroups >= 0.8.4 && < 1 - , tagged >= 0.4.4 && < 1 - , tasty >= 0.8 && < 0.11 - , tasty-hunit >= 0.8 && < 0.10 - , tasty-quickcheck >= 0.8 && < 0.9 - , template-haskell >= 2.4 && < 2.11 - , text-show >= 0.5 && < 0.8 - , text-show-instances == 0.3 - , time >= 0.1 && < 1.6 - , transformers >= 0.2.1 && < 0.5 - , transformers-compat >= 0.3 && < 1 - , unordered-containers >= 0.2 && < 0.3 - , utf8-string >= 0.3.1 && < 1.1 - , vector >= 0.9 && < 0.11 - , xhtml >= 3000.2 && < 3000.3 - hs-source-dirs: tests - default-language: Haskell2010 - ghc-options: -Wall - - if os(windows) - build-depends: Win32 >= 2.1 && < 2.4 - other-modules: Instances.System.Win32 - Properties.System.Win32 - else - build-depends: terminfo >= 0.3.2 && < 0.5 - , unix >= 2 && < 2.8 - other-modules: Instances.System.Console.Terminfo - Instances.System.Posix - Properties.System.Console.Terminfo - Properties.System.Posix +name: text-show-instances +version: 0.3.0.1 +synopsis: Additional instances for text-show +description: @text-show-instances@ is a supplemental library to @text-show@ + that provides additional @Show@ instances for data types in + common Haskell libraries and GHC dependencies that are not + encompassed by @text-show@. Currently, @text-show-instances@ + covers these libraries: + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + One can use these instances by importing + "Text.Show.Text.Instances". Alternatively, there are monomorphic + versions of the @showb@ function available in the other submodules + of "Text.Show.Text". +homepage: https://github.com/RyanGlScott/text-show-instances +bug-reports: https://github.com/RyanGlScott/text-show-instances/issues +license: BSD3 +license-file: LICENSE +author: Ryan Scott +maintainer: Ryan Scott +stability: Experimental +copyright: (C) 2014-2015 Ryan Scott +category: Text +build-type: Simple +extra-source-files: CHANGELOG.md, README.md, include/inline.h +cabal-version: >=1.10 + +source-repository head + type: git + location: git://github.com/RyanGlScott/text-show-instances.git + +library + exposed-modules: Text.Show.Text.Instances + + Text.Show.Text.Compiler.Hoopl + Text.Show.Text.Control.Applicative.Trans + Text.Show.Text.Control.Monad.Trans + Text.Show.Text.Data.Binary + Text.Show.Text.Data.Containers + Text.Show.Text.Data.Functor.Trans + Text.Show.Text.Data.List.NonEmpty + Text.Show.Text.Data.Semigroup + Text.Show.Text.Data.String.UTF8 + Text.Show.Text.Data.Tagged + Text.Show.Text.Data.Time + Text.Show.Text.Data.UnorderedContainers + Text.Show.Text.Data.Vector + Text.Show.Text.Language.Haskell.TH + Text.Show.Text.System.Console.Haskeline + Text.Show.Text.System.Directory + Text.Show.Text.System.Locale + Text.Show.Text.System.Random + Text.Show.Text.System.Time + Text.Show.Text.Text.PrettyPrint + Text.Show.Text.Text.XHtml + Text.Show.Text.Trace.Hpc + other-modules: Text.Show.Text.Compiler + Text.Show.Text.Control + Text.Show.Text.Data + Text.Show.Text.Language + Text.Show.Text.System + Text.Show.Text.Text + Text.Show.Text.Trace + Text.Show.Text.Utils + build-depends: base >= 4.2 && < 5 + , binary >= 0.6 && < 0.8 + , bytestring  >= 0.9 && < 0.11 + , containers >= 0.1 && < 0.6 + , directory >= 1 && < 1.3 + , haskeline >= 0.7 && < 0.8 + , hoopl >= 3.8.7 && < 3.11 + , hpc >= 0.5 && < 0.7 + , old-locale >= 1 && < 1.1 + , old-time >= 1 && < 1.2 + , pretty >= 1 && < 1.2 + , random >= 1.0.1 && < 1.2 + , semigroups >= 0.16.2 && < 1 + , tagged >= 0.4.4 && < 1 + , template-haskell >= 2.4 && < 2.11 + , text >= 0.8 && < 1.3 + , text-show >= 0.5 && < 0.8 + , time >= 0.1 && < 1.6 + , transformers >= 0.2.1 && < 0.5 + , transformers-compat >= 0.3 && < 1 + , unordered-containers >= 0.2 && < 0.3 + , utf8-string >= 0.3.1 && < 1.1 + , vector >= 0.9 && < 0.11 + , xhtml >= 3000.2 && < 3000.3 + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + include-dirs: include + includes: inline.h + install-includes: inline.h + + if os(windows) + build-depends: Win32 >= 2.1 && < 2.4 + exposed-modules: Text.Show.Text.System.Win32 + else + build-depends: terminfo >= 0.3.2 && < 0.5 + , unix >= 2 && < 2.8 + exposed-modules: Text.Show.Text.System.Console.Terminfo + Text.Show.Text.System.Posix + +test-suite text-show-instances-properties + type: exitcode-stdio-1.0 + main-is: Properties.hs + other-modules: Instances.Compiler.Hoopl + Instances.Control.Applicative.Trans + Instances.Control.Monad.Trans + Instances.Data.Binary + Instances.Data.Containers + Instances.Data.Functor.Trans + Instances.Data.List.NonEmpty + Instances.Data.Semigroup + Instances.Data.String.UTF8 + Instances.Data.Tagged + Instances.Language.Haskell.TH + Instances.Miscellaneous + Instances.System.Console.Haskeline + Instances.System.Directory + Instances.System.Locale + Instances.System.Random + Instances.Text.PrettyPrint + Instances.Text.XHtml + Instances.Trace.Hpc + Instances.Utils + Properties.Compiler.Hoopl + Properties.Control.Applicative.Trans + Properties.Control.Monad.Trans + Properties.Data.Binary + Properties.Data.Containers + Properties.Data.Functor.Trans + Properties.Data.List.NonEmpty + Properties.Data.Semigroup + Properties.Data.String.UTF8 + Properties.Data.Tagged + Properties.Data.Time + Properties.Data.UnorderedContainers + Properties.Language.Haskell.TH + Properties.System.Console.Haskeline + Properties.System.Directory + Properties.System.Locale + Properties.System.Random + Properties.System.Time + Properties.Text.PrettyPrint + Properties.Text.XHtml + Properties.Trace.Hpc + Properties.Utils + build-depends: base >= 4.5 && < 5 + , binary >= 0.6 && < 0.8 + , bytestring  >= 0.9 && < 0.11 + , containers >= 0.1 && < 0.6 + , directory >= 1 && < 1.3 + , haskeline >= 0.7 && < 0.8 + , hoopl >= 3.8.7 && < 3.11 + , hpc >= 0.5 && < 0.7 + , old-locale >= 1 && < 1.1 + , old-time >= 1 && < 1.2 + , pretty >= 1 && < 1.2 + , quickcheck-instances >= 0.1 && < 0.4 + , random >= 1.0.1 && < 1.2 + , semigroups >= 0.8.4 && < 1 + , tagged >= 0.4.4 && < 1 + , tasty >= 0.8 && < 0.11 + , tasty-hunit >= 0.8 && < 0.10 + , tasty-quickcheck >= 0.8 && < 0.9 + , template-haskell >= 2.4 && < 2.11 + , text-show >= 0.5 && < 0.8 + , text-show-instances == 0.3.0.1 + , time >= 0.1 && < 1.6 + , transformers >= 0.2.1 && < 0.5 + , transformers-compat >= 0.3 && < 1 + , unordered-containers >= 0.2 && < 0.3 + , utf8-string >= 0.3.1 && < 1.1 + , vector >= 0.9 && < 0.11 + , xhtml >= 3000.2 && < 3000.3 + hs-source-dirs: tests + default-language: Haskell2010 + ghc-options: -Wall + + if os(windows) + build-depends: Win32 >= 2.1 && < 2.4 + other-modules: Instances.System.Win32 + Properties.System.Win32 + else + build-depends: terminfo >= 0.3.2 && < 0.5 + , unix >= 2 && < 2.8 + other-modules: Instances.System.Console.Terminfo + Instances.System.Posix + Properties.System.Console.Terminfo + Properties.System.Posix