{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module                  : Language.Jsonnet.Common
-- Copyright               : (c) 2020-2021 Alexandre Moreno
-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0
-- Maintainer              : Alexandre Moreno <alexmorenocano@gmail.com>
-- Stability               : experimental
-- Portability             : non-portable
module Language.Jsonnet.Common where

import Data.Binary (Binary)
import Data.Data (Data)
import Data.Functor.Classes
import Data.Functor.Classes.Generic
import Data.Scientific (Scientific)
import Data.String
import Data.Text (Text)
import Data.Typeable (Typeable)
import GHC.Generics (Generic, Generic1)
import Language.Jsonnet.Parser.SrcSpan
import Text.Show.Deriving
import Unbound.Generics.LocallyNameless
import Unbound.Generics.LocallyNameless.TH (makeClosedAlpha)

data Literal
  = Null
  | Bool Bool
  | String Text
  | Number Scientific
  deriving (Int -> Literal -> ShowS
[Literal] -> ShowS
Literal -> String
(Int -> Literal -> ShowS)
-> (Literal -> String) -> ([Literal] -> ShowS) -> Show Literal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Literal] -> ShowS
$cshowList :: [Literal] -> ShowS
show :: Literal -> String
$cshow :: Literal -> String
showsPrec :: Int -> Literal -> ShowS
$cshowsPrec :: Int -> Literal -> ShowS
Show, Literal -> Literal -> Bool
(Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool) -> Eq Literal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Literal -> Literal -> Bool
$c/= :: Literal -> Literal -> Bool
== :: Literal -> Literal -> Bool
$c== :: Literal -> Literal -> Bool
Eq, Eq Literal
Eq Literal
-> (Literal -> Literal -> Ordering)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Bool)
-> (Literal -> Literal -> Literal)
-> (Literal -> Literal -> Literal)
-> Ord Literal
Literal -> Literal -> Bool
Literal -> Literal -> Ordering
Literal -> Literal -> Literal
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Literal -> Literal -> Literal
$cmin :: Literal -> Literal -> Literal
max :: Literal -> Literal -> Literal
$cmax :: Literal -> Literal -> Literal
>= :: Literal -> Literal -> Bool
$c>= :: Literal -> Literal -> Bool
> :: Literal -> Literal -> Bool
$c> :: Literal -> Literal -> Bool
<= :: Literal -> Literal -> Bool
$c<= :: Literal -> Literal -> Bool
< :: Literal -> Literal -> Bool
$c< :: Literal -> Literal -> Bool
compare :: Literal -> Literal -> Ordering
$ccompare :: Literal -> Literal -> Ordering
$cp1Ord :: Eq Literal
Ord, (forall x. Literal -> Rep Literal x)
-> (forall x. Rep Literal x -> Literal) -> Generic Literal
forall x. Rep Literal x -> Literal
forall x. Literal -> Rep Literal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Literal x -> Literal
$cfrom :: forall x. Literal -> Rep Literal x
Generic, Typeable, Typeable Literal
DataType
Constr
Typeable Literal
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Literal -> c Literal)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Literal)
-> (Literal -> Constr)
-> (Literal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Literal))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal))
-> ((forall b. Data b => b -> b) -> Literal -> Literal)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Literal -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Literal -> r)
-> (forall u. (forall d. Data d => d -> u) -> Literal -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> Data Literal
Literal -> DataType
Literal -> Constr
(forall b. Data b => b -> b) -> Literal -> Literal
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
forall u. (forall d. Data d => d -> u) -> Literal -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
$cNumber :: Constr
$cString :: Constr
$cBool :: Constr
$cNull :: Constr
$tLiteral :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapMp :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapM :: (forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapQi :: Int -> (forall d. Data d => d -> u) -> Literal -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
gmapQ :: (forall d. Data d => d -> u) -> Literal -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Literal -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
gmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
$cgmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Literal)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
dataTypeOf :: Literal -> DataType
$cdataTypeOf :: Literal -> DataType
toConstr :: Literal -> Constr
$ctoConstr :: Literal -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
$cp1Data :: Typeable Literal
Data)

makeClosedAlpha ''Literal

instance Binary Literal

instance Subst a Literal where
  subst :: Name a -> a -> Literal -> Literal
subst Name a
_ a
_ = Literal -> Literal
forall a. a -> a
id
  substs :: [(Name a, a)] -> Literal -> Literal
substs [(Name a, a)]
_ = Literal -> Literal
forall a. a -> a
id

data Prim
  = UnyOp UnyOp
  | BinOp BinOp
  | Cond
  deriving (Int -> Prim -> ShowS
[Prim] -> ShowS
Prim -> String
(Int -> Prim -> ShowS)
-> (Prim -> String) -> ([Prim] -> ShowS) -> Show Prim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prim] -> ShowS
$cshowList :: [Prim] -> ShowS
show :: Prim -> String
$cshow :: Prim -> String
showsPrec :: Int -> Prim -> ShowS
$cshowsPrec :: Int -> Prim -> ShowS
Show, Prim -> Prim -> Bool
(Prim -> Prim -> Bool) -> (Prim -> Prim -> Bool) -> Eq Prim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prim -> Prim -> Bool
$c/= :: Prim -> Prim -> Bool
== :: Prim -> Prim -> Bool
$c== :: Prim -> Prim -> Bool
Eq, (forall x. Prim -> Rep Prim x)
-> (forall x. Rep Prim x -> Prim) -> Generic Prim
forall x. Rep Prim x -> Prim
forall x. Prim -> Rep Prim x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Prim x -> Prim
$cfrom :: forall x. Prim -> Rep Prim x
Generic, Typeable, Typeable Prim
DataType
Constr
Typeable Prim
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Prim -> c Prim)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Prim)
-> (Prim -> Constr)
-> (Prim -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Prim))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prim))
-> ((forall b. Data b => b -> b) -> Prim -> Prim)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prim -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prim -> r)
-> (forall u. (forall d. Data d => d -> u) -> Prim -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Prim -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Prim -> m Prim)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Prim -> m Prim)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Prim -> m Prim)
-> Data Prim
Prim -> DataType
Prim -> Constr
(forall b. Data b => b -> b) -> Prim -> Prim
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prim -> c Prim
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prim
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Prim -> u
forall u. (forall d. Data d => d -> u) -> Prim -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prim -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prim -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Prim -> m Prim
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prim -> m Prim
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prim
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prim -> c Prim
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Prim)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prim)
$cCond :: Constr
$cBinOp :: Constr
$cUnyOp :: Constr
$tPrim :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Prim -> m Prim
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prim -> m Prim
gmapMp :: (forall d. Data d => d -> m d) -> Prim -> m Prim
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prim -> m Prim
gmapM :: (forall d. Data d => d -> m d) -> Prim -> m Prim
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Prim -> m Prim
gmapQi :: Int -> (forall d. Data d => d -> u) -> Prim -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Prim -> u
gmapQ :: (forall d. Data d => d -> u) -> Prim -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Prim -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prim -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prim -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prim -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prim -> r
gmapT :: (forall b. Data b => b -> b) -> Prim -> Prim
$cgmapT :: (forall b. Data b => b -> b) -> Prim -> Prim
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prim)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prim)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Prim)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Prim)
dataTypeOf :: Prim -> DataType
$cdataTypeOf :: Prim -> DataType
toConstr :: Prim -> Constr
$ctoConstr :: Prim -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prim
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prim
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prim -> c Prim
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prim -> c Prim
$cp1Data :: Typeable Prim
Data)

instance Alpha Prim

instance Binary Prim

data BinOp
  = Add
  | Sub
  | Mul
  | Div
  | Mod
  | Lt
  | Le
  | Gt
  | Ge
  | Eq
  | Ne
  | And
  | Or
  | Xor
  | ShiftL
  | ShiftR
  | LAnd
  | LOr
  | In
  | Lookup
  deriving (Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> String
(Int -> BinOp -> ShowS)
-> (BinOp -> String) -> ([BinOp] -> ShowS) -> Show BinOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinOp] -> ShowS
$cshowList :: [BinOp] -> ShowS
show :: BinOp -> String
$cshow :: BinOp -> String
showsPrec :: Int -> BinOp -> ShowS
$cshowsPrec :: Int -> BinOp -> ShowS
Show, BinOp -> BinOp -> Bool
(BinOp -> BinOp -> Bool) -> (BinOp -> BinOp -> Bool) -> Eq BinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinOp -> BinOp -> Bool
$c/= :: BinOp -> BinOp -> Bool
== :: BinOp -> BinOp -> Bool
$c== :: BinOp -> BinOp -> Bool
Eq, (forall x. BinOp -> Rep BinOp x)
-> (forall x. Rep BinOp x -> BinOp) -> Generic BinOp
forall x. Rep BinOp x -> BinOp
forall x. BinOp -> Rep BinOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinOp x -> BinOp
$cfrom :: forall x. BinOp -> Rep BinOp x
Generic, Typeable, Typeable BinOp
DataType
Constr
Typeable BinOp
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BinOp -> c BinOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BinOp)
-> (BinOp -> Constr)
-> (BinOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BinOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp))
-> ((forall b. Data b => b -> b) -> BinOp -> BinOp)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> BinOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> BinOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BinOp -> m BinOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BinOp -> m BinOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BinOp -> m BinOp)
-> Data BinOp
BinOp -> DataType
BinOp -> Constr
(forall b. Data b => b -> b) -> BinOp -> BinOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinOp -> c BinOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinOp
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BinOp -> u
forall u. (forall d. Data d => d -> u) -> BinOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinOp -> c BinOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp)
$cLookup :: Constr
$cIn :: Constr
$cLOr :: Constr
$cLAnd :: Constr
$cShiftR :: Constr
$cShiftL :: Constr
$cXor :: Constr
$cOr :: Constr
$cAnd :: Constr
$cNe :: Constr
$cEq :: Constr
$cGe :: Constr
$cGt :: Constr
$cLe :: Constr
$cLt :: Constr
$cMod :: Constr
$cDiv :: Constr
$cMul :: Constr
$cSub :: Constr
$cAdd :: Constr
$tBinOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BinOp -> m BinOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
gmapMp :: (forall d. Data d => d -> m d) -> BinOp -> m BinOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
gmapM :: (forall d. Data d => d -> m d) -> BinOp -> m BinOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinOp -> m BinOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> BinOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BinOp -> u
gmapQ :: (forall d. Data d => d -> u) -> BinOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BinOp -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinOp -> r
gmapT :: (forall b. Data b => b -> b) -> BinOp -> BinOp
$cgmapT :: (forall b. Data b => b -> b) -> BinOp -> BinOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c BinOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinOp)
dataTypeOf :: BinOp -> DataType
$cdataTypeOf :: BinOp -> DataType
toConstr :: BinOp -> Constr
$ctoConstr :: BinOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinOp -> c BinOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinOp -> c BinOp
$cp1Data :: Typeable BinOp
Data)

instance Alpha BinOp

instance Binary BinOp

data UnyOp
  = Compl
  | LNot
  | Plus
  | Minus
  | Err
  deriving (Int -> UnyOp -> ShowS
[UnyOp] -> ShowS
UnyOp -> String
(Int -> UnyOp -> ShowS)
-> (UnyOp -> String) -> ([UnyOp] -> ShowS) -> Show UnyOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnyOp] -> ShowS
$cshowList :: [UnyOp] -> ShowS
show :: UnyOp -> String
$cshow :: UnyOp -> String
showsPrec :: Int -> UnyOp -> ShowS
$cshowsPrec :: Int -> UnyOp -> ShowS
Show, UnyOp -> UnyOp -> Bool
(UnyOp -> UnyOp -> Bool) -> (UnyOp -> UnyOp -> Bool) -> Eq UnyOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnyOp -> UnyOp -> Bool
$c/= :: UnyOp -> UnyOp -> Bool
== :: UnyOp -> UnyOp -> Bool
$c== :: UnyOp -> UnyOp -> Bool
Eq, (forall x. UnyOp -> Rep UnyOp x)
-> (forall x. Rep UnyOp x -> UnyOp) -> Generic UnyOp
forall x. Rep UnyOp x -> UnyOp
forall x. UnyOp -> Rep UnyOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnyOp x -> UnyOp
$cfrom :: forall x. UnyOp -> Rep UnyOp x
Generic, Typeable, Typeable UnyOp
DataType
Constr
Typeable UnyOp
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UnyOp -> c UnyOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UnyOp)
-> (UnyOp -> Constr)
-> (UnyOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UnyOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnyOp))
-> ((forall b. Data b => b -> b) -> UnyOp -> UnyOp)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnyOp -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnyOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> UnyOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UnyOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UnyOp -> m UnyOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnyOp -> m UnyOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnyOp -> m UnyOp)
-> Data UnyOp
UnyOp -> DataType
UnyOp -> Constr
(forall b. Data b => b -> b) -> UnyOp -> UnyOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnyOp -> c UnyOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnyOp
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UnyOp -> u
forall u. (forall d. Data d => d -> u) -> UnyOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnyOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnyOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnyOp -> m UnyOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnyOp -> m UnyOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnyOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnyOp -> c UnyOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnyOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnyOp)
$cErr :: Constr
$cMinus :: Constr
$cPlus :: Constr
$cLNot :: Constr
$cCompl :: Constr
$tUnyOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UnyOp -> m UnyOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnyOp -> m UnyOp
gmapMp :: (forall d. Data d => d -> m d) -> UnyOp -> m UnyOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnyOp -> m UnyOp
gmapM :: (forall d. Data d => d -> m d) -> UnyOp -> m UnyOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnyOp -> m UnyOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> UnyOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnyOp -> u
gmapQ :: (forall d. Data d => d -> u) -> UnyOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnyOp -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnyOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnyOp -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnyOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnyOp -> r
gmapT :: (forall b. Data b => b -> b) -> UnyOp -> UnyOp
$cgmapT :: (forall b. Data b => b -> b) -> UnyOp -> UnyOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnyOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnyOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UnyOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnyOp)
dataTypeOf :: UnyOp -> DataType
$cdataTypeOf :: UnyOp -> DataType
toConstr :: UnyOp -> Constr
$ctoConstr :: UnyOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnyOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnyOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnyOp -> c UnyOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnyOp -> c UnyOp
$cp1Data :: Typeable UnyOp
Data)

instance Alpha UnyOp

instance Binary UnyOp

data Strictness = Strict | Lazy
  deriving (Strictness -> Strictness -> Bool
(Strictness -> Strictness -> Bool)
-> (Strictness -> Strictness -> Bool) -> Eq Strictness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Strictness -> Strictness -> Bool
$c/= :: Strictness -> Strictness -> Bool
== :: Strictness -> Strictness -> Bool
$c== :: Strictness -> Strictness -> Bool
Eq, ReadPrec [Strictness]
ReadPrec Strictness
Int -> ReadS Strictness
ReadS [Strictness]
(Int -> ReadS Strictness)
-> ReadS [Strictness]
-> ReadPrec Strictness
-> ReadPrec [Strictness]
-> Read Strictness
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Strictness]
$creadListPrec :: ReadPrec [Strictness]
readPrec :: ReadPrec Strictness
$creadPrec :: ReadPrec Strictness
readList :: ReadS [Strictness]
$creadList :: ReadS [Strictness]
readsPrec :: Int -> ReadS Strictness
$creadsPrec :: Int -> ReadS Strictness
Read, Int -> Strictness -> ShowS
[Strictness] -> ShowS
Strictness -> String
(Int -> Strictness -> ShowS)
-> (Strictness -> String)
-> ([Strictness] -> ShowS)
-> Show Strictness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Strictness] -> ShowS
$cshowList :: [Strictness] -> ShowS
show :: Strictness -> String
$cshow :: Strictness -> String
showsPrec :: Int -> Strictness -> ShowS
$cshowsPrec :: Int -> Strictness -> ShowS
Show, (forall x. Strictness -> Rep Strictness x)
-> (forall x. Rep Strictness x -> Strictness) -> Generic Strictness
forall x. Rep Strictness x -> Strictness
forall x. Strictness -> Rep Strictness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Strictness x -> Strictness
$cfrom :: forall x. Strictness -> Rep Strictness x
Generic, Typeable, Typeable Strictness
DataType
Constr
Typeable Strictness
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Strictness -> c Strictness)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Strictness)
-> (Strictness -> Constr)
-> (Strictness -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Strictness))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Strictness))
-> ((forall b. Data b => b -> b) -> Strictness -> Strictness)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Strictness -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Strictness -> r)
-> (forall u. (forall d. Data d => d -> u) -> Strictness -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Strictness -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Strictness -> m Strictness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Strictness -> m Strictness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Strictness -> m Strictness)
-> Data Strictness
Strictness -> DataType
Strictness -> Constr
(forall b. Data b => b -> b) -> Strictness -> Strictness
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strictness -> c Strictness
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strictness
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Strictness -> u
forall u. (forall d. Data d => d -> u) -> Strictness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strictness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strictness -> c Strictness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Strictness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strictness)
$cLazy :: Constr
$cStrict :: Constr
$tStrictness :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Strictness -> m Strictness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness
gmapMp :: (forall d. Data d => d -> m d) -> Strictness -> m Strictness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness
gmapM :: (forall d. Data d => d -> m d) -> Strictness -> m Strictness
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Strictness -> m Strictness
gmapQi :: Int -> (forall d. Data d => d -> u) -> Strictness -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Strictness -> u
gmapQ :: (forall d. Data d => d -> u) -> Strictness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Strictness -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Strictness -> r
gmapT :: (forall b. Data b => b -> b) -> Strictness -> Strictness
$cgmapT :: (forall b. Data b => b -> b) -> Strictness -> Strictness
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strictness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strictness)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Strictness)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Strictness)
dataTypeOf :: Strictness -> DataType
$cdataTypeOf :: Strictness -> DataType
toConstr :: Strictness -> Constr
$ctoConstr :: Strictness -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strictness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strictness
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strictness -> c Strictness
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strictness -> c Strictness
$cp1Data :: Typeable Strictness
Data)

instance Alpha Strictness

instance Binary Strictness

data Arg a = Pos a | Named String a
  deriving
    ( Arg a -> Arg a -> Bool
(Arg a -> Arg a -> Bool) -> (Arg a -> Arg a -> Bool) -> Eq (Arg a)
forall a. Eq a => Arg a -> Arg a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arg a -> Arg a -> Bool
$c/= :: forall a. Eq a => Arg a -> Arg a -> Bool
== :: Arg a -> Arg a -> Bool
$c== :: forall a. Eq a => Arg a -> Arg a -> Bool
Eq,
      ReadPrec [Arg a]
ReadPrec (Arg a)
Int -> ReadS (Arg a)
ReadS [Arg a]
(Int -> ReadS (Arg a))
-> ReadS [Arg a]
-> ReadPrec (Arg a)
-> ReadPrec [Arg a]
-> Read (Arg a)
forall a. Read a => ReadPrec [Arg a]
forall a. Read a => ReadPrec (Arg a)
forall a. Read a => Int -> ReadS (Arg a)
forall a. Read a => ReadS [Arg a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Arg a]
$creadListPrec :: forall a. Read a => ReadPrec [Arg a]
readPrec :: ReadPrec (Arg a)
$creadPrec :: forall a. Read a => ReadPrec (Arg a)
readList :: ReadS [Arg a]
$creadList :: forall a. Read a => ReadS [Arg a]
readsPrec :: Int -> ReadS (Arg a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Arg a)
Read,
      Int -> Arg a -> ShowS
[Arg a] -> ShowS
Arg a -> String
(Int -> Arg a -> ShowS)
-> (Arg a -> String) -> ([Arg a] -> ShowS) -> Show (Arg a)
forall a. Show a => Int -> Arg a -> ShowS
forall a. Show a => [Arg a] -> ShowS
forall a. Show a => Arg a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arg a] -> ShowS
$cshowList :: forall a. Show a => [Arg a] -> ShowS
show :: Arg a -> String
$cshow :: forall a. Show a => Arg a -> String
showsPrec :: Int -> Arg a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Arg a -> ShowS
Show,
      Typeable,
      Typeable (Arg a)
DataType
Constr
Typeable (Arg a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Arg a -> c (Arg a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Arg a))
-> (Arg a -> Constr)
-> (Arg a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Arg a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Arg a)))
-> ((forall b. Data b => b -> b) -> Arg a -> Arg a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Arg a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Arg a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Arg a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Arg a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Arg a -> m (Arg a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Arg a -> m (Arg a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Arg a -> m (Arg a))
-> Data (Arg a)
Arg a -> DataType
Arg a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Arg a))
(forall b. Data b => b -> b) -> Arg a -> Arg a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg a -> c (Arg a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg a)
forall a. Data a => Typeable (Arg a)
forall a. Data a => Arg a -> DataType
forall a. Data a => Arg a -> Constr
forall a. Data a => (forall b. Data b => b -> b) -> Arg a -> Arg a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Arg a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Arg a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Arg a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Arg a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Arg a -> m (Arg a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Arg a -> m (Arg a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg a -> c (Arg a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Arg a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Arg a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Arg a -> u
forall u. (forall d. Data d => d -> u) -> Arg a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Arg a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Arg a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Arg a -> m (Arg a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Arg a -> m (Arg a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg a -> c (Arg a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Arg a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Arg a))
$cNamed :: Constr
$cPos :: Constr
$tArg :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Arg a -> m (Arg a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Arg a -> m (Arg a)
gmapMp :: (forall d. Data d => d -> m d) -> Arg a -> m (Arg a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Arg a -> m (Arg a)
gmapM :: (forall d. Data d => d -> m d) -> Arg a -> m (Arg a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Arg a -> m (Arg a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Arg a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Arg a -> u
gmapQ :: (forall d. Data d => d -> u) -> Arg a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Arg a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Arg a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Arg a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Arg a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Arg a -> r
gmapT :: (forall b. Data b => b -> b) -> Arg a -> Arg a
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Arg a -> Arg a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Arg a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Arg a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Arg a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Arg a))
dataTypeOf :: Arg a -> DataType
$cdataTypeOf :: forall a. Data a => Arg a -> DataType
toConstr :: Arg a -> Constr
$ctoConstr :: forall a. Data a => Arg a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg a -> c (Arg a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg a -> c (Arg a)
$cp1Data :: forall a. Data a => Typeable (Arg a)
Data,
      (forall x. Arg a -> Rep (Arg a) x)
-> (forall x. Rep (Arg a) x -> Arg a) -> Generic (Arg a)
forall x. Rep (Arg a) x -> Arg a
forall x. Arg a -> Rep (Arg a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Arg a) x -> Arg a
forall a x. Arg a -> Rep (Arg a) x
$cto :: forall a x. Rep (Arg a) x -> Arg a
$cfrom :: forall a x. Arg a -> Rep (Arg a) x
Generic,
      (forall a. Arg a -> Rep1 Arg a)
-> (forall a. Rep1 Arg a -> Arg a) -> Generic1 Arg
forall a. Rep1 Arg a -> Arg a
forall a. Arg a -> Rep1 Arg a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Arg a -> Arg a
$cfrom1 :: forall a. Arg a -> Rep1 Arg a
Generic1,
      a -> Arg b -> Arg a
(a -> b) -> Arg a -> Arg b
(forall a b. (a -> b) -> Arg a -> Arg b)
-> (forall a b. a -> Arg b -> Arg a) -> Functor Arg
forall a b. a -> Arg b -> Arg a
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Arg b -> Arg a
$c<$ :: forall a b. a -> Arg b -> Arg a
fmap :: (a -> b) -> Arg a -> Arg b
$cfmap :: forall a b. (a -> b) -> Arg a -> Arg b
Functor,
      Arg a -> Bool
(a -> m) -> Arg a -> m
(a -> b -> b) -> b -> Arg a -> b
(forall m. Monoid m => Arg m -> m)
-> (forall m a. Monoid m => (a -> m) -> Arg a -> m)
-> (forall m a. Monoid m => (a -> m) -> Arg a -> m)
-> (forall a b. (a -> b -> b) -> b -> Arg a -> b)
-> (forall a b. (a -> b -> b) -> b -> Arg a -> b)
-> (forall b a. (b -> a -> b) -> b -> Arg a -> b)
-> (forall b a. (b -> a -> b) -> b -> Arg a -> b)
-> (forall a. (a -> a -> a) -> Arg a -> a)
-> (forall a. (a -> a -> a) -> Arg a -> a)
-> (forall a. Arg a -> [a])
-> (forall a. Arg a -> Bool)
-> (forall a. Arg a -> Int)
-> (forall a. Eq a => a -> Arg a -> Bool)
-> (forall a. Ord a => Arg a -> a)
-> (forall a. Ord a => Arg a -> a)
-> (forall a. Num a => Arg a -> a)
-> (forall a. Num a => Arg a -> a)
-> Foldable Arg
forall a. Eq a => a -> Arg a -> Bool
forall a. Num a => Arg a -> a
forall a. Ord a => Arg a -> a
forall m. Monoid m => Arg m -> m
forall a. Arg a -> Bool
forall a. Arg a -> Int
forall a. Arg a -> [a]
forall a. (a -> a -> a) -> Arg a -> a
forall m a. Monoid m => (a -> m) -> Arg a -> m
forall b a. (b -> a -> b) -> b -> Arg a -> b
forall a b. (a -> b -> b) -> b -> Arg a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Arg a -> a
$cproduct :: forall a. Num a => Arg a -> a
sum :: Arg a -> a
$csum :: forall a. Num a => Arg a -> a
minimum :: Arg a -> a
$cminimum :: forall a. Ord a => Arg a -> a
maximum :: Arg a -> a
$cmaximum :: forall a. Ord a => Arg a -> a
elem :: a -> Arg a -> Bool
$celem :: forall a. Eq a => a -> Arg a -> Bool
length :: Arg a -> Int
$clength :: forall a. Arg a -> Int
null :: Arg a -> Bool
$cnull :: forall a. Arg a -> Bool
toList :: Arg a -> [a]
$ctoList :: forall a. Arg a -> [a]
foldl1 :: (a -> a -> a) -> Arg a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Arg a -> a
foldr1 :: (a -> a -> a) -> Arg a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Arg a -> a
foldl' :: (b -> a -> b) -> b -> Arg a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Arg a -> b
foldl :: (b -> a -> b) -> b -> Arg a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Arg a -> b
foldr' :: (a -> b -> b) -> b -> Arg a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Arg a -> b
foldr :: (a -> b -> b) -> b -> Arg a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Arg a -> b
foldMap' :: (a -> m) -> Arg a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Arg a -> m
foldMap :: (a -> m) -> Arg a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Arg a -> m
fold :: Arg m -> m
$cfold :: forall m. Monoid m => Arg m -> m
Foldable,
      Functor Arg
Foldable Arg
Functor Arg
-> Foldable Arg
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Arg a -> f (Arg b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Arg (f a) -> f (Arg a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Arg a -> m (Arg b))
-> (forall (m :: * -> *) a. Monad m => Arg (m a) -> m (Arg a))
-> Traversable Arg
(a -> f b) -> Arg a -> f (Arg b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Arg (m a) -> m (Arg a)
forall (f :: * -> *) a. Applicative f => Arg (f a) -> f (Arg a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Arg a -> m (Arg b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arg a -> f (Arg b)
sequence :: Arg (m a) -> m (Arg a)
$csequence :: forall (m :: * -> *) a. Monad m => Arg (m a) -> m (Arg a)
mapM :: (a -> m b) -> Arg a -> m (Arg b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Arg a -> m (Arg b)
sequenceA :: Arg (f a) -> f (Arg a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Arg (f a) -> f (Arg a)
traverse :: (a -> f b) -> Arg a -> f (Arg b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arg a -> f (Arg b)
$cp2Traversable :: Foldable Arg
$cp1Traversable :: Functor Arg
Traversable
    )

deriveShow1 ''Arg

instance Alpha a => Alpha (Arg a)

instance Binary a => Binary (Arg a)

data Args a = Args
  { Args a -> [Arg a]
args :: [Arg a],
    Args a -> Strictness
strictness :: Strictness
  }
  deriving
    ( Args a -> Args a -> Bool
(Args a -> Args a -> Bool)
-> (Args a -> Args a -> Bool) -> Eq (Args a)
forall a. Eq a => Args a -> Args a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Args a -> Args a -> Bool
$c/= :: forall a. Eq a => Args a -> Args a -> Bool
== :: Args a -> Args a -> Bool
$c== :: forall a. Eq a => Args a -> Args a -> Bool
Eq,
      ReadPrec [Args a]
ReadPrec (Args a)
Int -> ReadS (Args a)
ReadS [Args a]
(Int -> ReadS (Args a))
-> ReadS [Args a]
-> ReadPrec (Args a)
-> ReadPrec [Args a]
-> Read (Args a)
forall a. Read a => ReadPrec [Args a]
forall a. Read a => ReadPrec (Args a)
forall a. Read a => Int -> ReadS (Args a)
forall a. Read a => ReadS [Args a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Args a]
$creadListPrec :: forall a. Read a => ReadPrec [Args a]
readPrec :: ReadPrec (Args a)
$creadPrec :: forall a. Read a => ReadPrec (Args a)
readList :: ReadS [Args a]
$creadList :: forall a. Read a => ReadS [Args a]
readsPrec :: Int -> ReadS (Args a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Args a)
Read,
      Int -> Args a -> ShowS
[Args a] -> ShowS
Args a -> String
(Int -> Args a -> ShowS)
-> (Args a -> String) -> ([Args a] -> ShowS) -> Show (Args a)
forall a. Show a => Int -> Args a -> ShowS
forall a. Show a => [Args a] -> ShowS
forall a. Show a => Args a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Args a] -> ShowS
$cshowList :: forall a. Show a => [Args a] -> ShowS
show :: Args a -> String
$cshow :: forall a. Show a => Args a -> String
showsPrec :: Int -> Args a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Args a -> ShowS
Show,
      Typeable,
      Typeable (Args a)
DataType
Constr
Typeable (Args a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Args a -> c (Args a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Args a))
-> (Args a -> Constr)
-> (Args a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Args a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Args a)))
-> ((forall b. Data b => b -> b) -> Args a -> Args a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Args a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Args a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Args a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Args a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Args a -> m (Args a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Args a -> m (Args a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Args a -> m (Args a))
-> Data (Args a)
Args a -> DataType
Args a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Args a))
(forall b. Data b => b -> b) -> Args a -> Args a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args a -> c (Args a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Args a)
forall a. Data a => Typeable (Args a)
forall a. Data a => Args a -> DataType
forall a. Data a => Args a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Args a -> Args a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Args a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Args a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Args a -> m (Args a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Args a -> m (Args a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Args a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args a -> c (Args a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Args a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Args a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Args a -> u
forall u. (forall d. Data d => d -> u) -> Args a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Args a -> m (Args a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Args a -> m (Args a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Args a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args a -> c (Args a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Args a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Args a))
$cArgs :: Constr
$tArgs :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Args a -> m (Args a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Args a -> m (Args a)
gmapMp :: (forall d. Data d => d -> m d) -> Args a -> m (Args a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Args a -> m (Args a)
gmapM :: (forall d. Data d => d -> m d) -> Args a -> m (Args a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Args a -> m (Args a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Args a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Args a -> u
gmapQ :: (forall d. Data d => d -> u) -> Args a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Args a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args a -> r
gmapT :: (forall b. Data b => b -> b) -> Args a -> Args a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Args a -> Args a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Args a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Args a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Args a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Args a))
dataTypeOf :: Args a -> DataType
$cdataTypeOf :: forall a. Data a => Args a -> DataType
toConstr :: Args a -> Constr
$ctoConstr :: forall a. Data a => Args a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Args a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Args a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args a -> c (Args a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Args a -> c (Args a)
$cp1Data :: forall a. Data a => Typeable (Args a)
Data,
      (forall x. Args a -> Rep (Args a) x)
-> (forall x. Rep (Args a) x -> Args a) -> Generic (Args a)
forall x. Rep (Args a) x -> Args a
forall x. Args a -> Rep (Args a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Args a) x -> Args a
forall a x. Args a -> Rep (Args a) x
$cto :: forall a x. Rep (Args a) x -> Args a
$cfrom :: forall a x. Args a -> Rep (Args a) x
Generic,
      a -> Args b -> Args a
(a -> b) -> Args a -> Args b
(forall a b. (a -> b) -> Args a -> Args b)
-> (forall a b. a -> Args b -> Args a) -> Functor Args
forall a b. a -> Args b -> Args a
forall a b. (a -> b) -> Args a -> Args b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Args b -> Args a
$c<$ :: forall a b. a -> Args b -> Args a
fmap :: (a -> b) -> Args a -> Args b
$cfmap :: forall a b. (a -> b) -> Args a -> Args b
Functor,
      Args a -> Bool
(a -> m) -> Args a -> m
(a -> b -> b) -> b -> Args a -> b
(forall m. Monoid m => Args m -> m)
-> (forall m a. Monoid m => (a -> m) -> Args a -> m)
-> (forall m a. Monoid m => (a -> m) -> Args a -> m)
-> (forall a b. (a -> b -> b) -> b -> Args a -> b)
-> (forall a b. (a -> b -> b) -> b -> Args a -> b)
-> (forall b a. (b -> a -> b) -> b -> Args a -> b)
-> (forall b a. (b -> a -> b) -> b -> Args a -> b)
-> (forall a. (a -> a -> a) -> Args a -> a)
-> (forall a. (a -> a -> a) -> Args a -> a)
-> (forall a. Args a -> [a])
-> (forall a. Args a -> Bool)
-> (forall a. Args a -> Int)
-> (forall a. Eq a => a -> Args a -> Bool)
-> (forall a. Ord a => Args a -> a)
-> (forall a. Ord a => Args a -> a)
-> (forall a. Num a => Args a -> a)
-> (forall a. Num a => Args a -> a)
-> Foldable Args
forall a. Eq a => a -> Args a -> Bool
forall a. Num a => Args a -> a
forall a. Ord a => Args a -> a
forall m. Monoid m => Args m -> m
forall a. Args a -> Bool
forall a. Args a -> Int
forall a. Args a -> [a]
forall a. (a -> a -> a) -> Args a -> a
forall m a. Monoid m => (a -> m) -> Args a -> m
forall b a. (b -> a -> b) -> b -> Args a -> b
forall a b. (a -> b -> b) -> b -> Args a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Args a -> a
$cproduct :: forall a. Num a => Args a -> a
sum :: Args a -> a
$csum :: forall a. Num a => Args a -> a
minimum :: Args a -> a
$cminimum :: forall a. Ord a => Args a -> a
maximum :: Args a -> a
$cmaximum :: forall a. Ord a => Args a -> a
elem :: a -> Args a -> Bool
$celem :: forall a. Eq a => a -> Args a -> Bool
length :: Args a -> Int
$clength :: forall a. Args a -> Int
null :: Args a -> Bool
$cnull :: forall a. Args a -> Bool
toList :: Args a -> [a]
$ctoList :: forall a. Args a -> [a]
foldl1 :: (a -> a -> a) -> Args a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Args a -> a
foldr1 :: (a -> a -> a) -> Args a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Args a -> a
foldl' :: (b -> a -> b) -> b -> Args a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Args a -> b
foldl :: (b -> a -> b) -> b -> Args a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Args a -> b
foldr' :: (a -> b -> b) -> b -> Args a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Args a -> b
foldr :: (a -> b -> b) -> b -> Args a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Args a -> b
foldMap' :: (a -> m) -> Args a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Args a -> m
foldMap :: (a -> m) -> Args a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Args a -> m
fold :: Args m -> m
$cfold :: forall m. Monoid m => Args m -> m
Foldable,
      Functor Args
Foldable Args
Functor Args
-> Foldable Args
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Args a -> f (Args b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Args (f a) -> f (Args a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Args a -> m (Args b))
-> (forall (m :: * -> *) a. Monad m => Args (m a) -> m (Args a))
-> Traversable Args
(a -> f b) -> Args a -> f (Args b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Args (m a) -> m (Args a)
forall (f :: * -> *) a. Applicative f => Args (f a) -> f (Args a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Args a -> m (Args b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Args a -> f (Args b)
sequence :: Args (m a) -> m (Args a)
$csequence :: forall (m :: * -> *) a. Monad m => Args (m a) -> m (Args a)
mapM :: (a -> m b) -> Args a -> m (Args b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Args a -> m (Args b)
sequenceA :: Args (f a) -> f (Args a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Args (f a) -> f (Args a)
traverse :: (a -> f b) -> Args a -> f (Args b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Args a -> f (Args b)
$cp2Traversable :: Foldable Args
$cp1Traversable :: Functor Args
Traversable
    )

deriveShow1 ''Args

instance Alpha a => Alpha (Args a)

instance Binary a => Binary (Args a)

data Assert a = Assert
  { Assert a -> a
cond :: a,
    Assert a -> Maybe a
msg :: Maybe a,
    Assert a -> a
expr :: a
  }
  deriving
    ( Assert a -> Assert a -> Bool
(Assert a -> Assert a -> Bool)
-> (Assert a -> Assert a -> Bool) -> Eq (Assert a)
forall a. Eq a => Assert a -> Assert a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assert a -> Assert a -> Bool
$c/= :: forall a. Eq a => Assert a -> Assert a -> Bool
== :: Assert a -> Assert a -> Bool
$c== :: forall a. Eq a => Assert a -> Assert a -> Bool
Eq,
      ReadPrec [Assert a]
ReadPrec (Assert a)
Int -> ReadS (Assert a)
ReadS [Assert a]
(Int -> ReadS (Assert a))
-> ReadS [Assert a]
-> ReadPrec (Assert a)
-> ReadPrec [Assert a]
-> Read (Assert a)
forall a. Read a => ReadPrec [Assert a]
forall a. Read a => ReadPrec (Assert a)
forall a. Read a => Int -> ReadS (Assert a)
forall a. Read a => ReadS [Assert a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Assert a]
$creadListPrec :: forall a. Read a => ReadPrec [Assert a]
readPrec :: ReadPrec (Assert a)
$creadPrec :: forall a. Read a => ReadPrec (Assert a)
readList :: ReadS [Assert a]
$creadList :: forall a. Read a => ReadS [Assert a]
readsPrec :: Int -> ReadS (Assert a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Assert a)
Read,
      Int -> Assert a -> ShowS
[Assert a] -> ShowS
Assert a -> String
(Int -> Assert a -> ShowS)
-> (Assert a -> String) -> ([Assert a] -> ShowS) -> Show (Assert a)
forall a. Show a => Int -> Assert a -> ShowS
forall a. Show a => [Assert a] -> ShowS
forall a. Show a => Assert a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assert a] -> ShowS
$cshowList :: forall a. Show a => [Assert a] -> ShowS
show :: Assert a -> String
$cshow :: forall a. Show a => Assert a -> String
showsPrec :: Int -> Assert a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Assert a -> ShowS
Show,
      Typeable,
      Typeable (Assert a)
DataType
Constr
Typeable (Assert a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Assert a -> c (Assert a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Assert a))
-> (Assert a -> Constr)
-> (Assert a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Assert a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Assert a)))
-> ((forall b. Data b => b -> b) -> Assert a -> Assert a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Assert a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Assert a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Assert a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Assert a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Assert a -> m (Assert a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Assert a -> m (Assert a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Assert a -> m (Assert a))
-> Data (Assert a)
Assert a -> DataType
Assert a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Assert a))
(forall b. Data b => b -> b) -> Assert a -> Assert a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assert a -> c (Assert a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Assert a)
forall a. Data a => Typeable (Assert a)
forall a. Data a => Assert a -> DataType
forall a. Data a => Assert a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Assert a -> Assert a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Assert a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Assert a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Assert a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Assert a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Assert a -> m (Assert a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Assert a -> m (Assert a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Assert a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assert a -> c (Assert a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Assert a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Assert a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Assert a -> u
forall u. (forall d. Data d => d -> u) -> Assert a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Assert a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Assert a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Assert a -> m (Assert a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Assert a -> m (Assert a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Assert a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assert a -> c (Assert a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Assert a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Assert a))
$cAssert :: Constr
$tAssert :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Assert a -> m (Assert a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Assert a -> m (Assert a)
gmapMp :: (forall d. Data d => d -> m d) -> Assert a -> m (Assert a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Assert a -> m (Assert a)
gmapM :: (forall d. Data d => d -> m d) -> Assert a -> m (Assert a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Assert a -> m (Assert a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Assert a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Assert a -> u
gmapQ :: (forall d. Data d => d -> u) -> Assert a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Assert a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Assert a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Assert a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Assert a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Assert a -> r
gmapT :: (forall b. Data b => b -> b) -> Assert a -> Assert a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Assert a -> Assert a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Assert a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Assert a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Assert a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Assert a))
dataTypeOf :: Assert a -> DataType
$cdataTypeOf :: forall a. Data a => Assert a -> DataType
toConstr :: Assert a -> Constr
$ctoConstr :: forall a. Data a => Assert a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Assert a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Assert a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assert a -> c (Assert a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assert a -> c (Assert a)
$cp1Data :: forall a. Data a => Typeable (Assert a)
Data,
      (forall x. Assert a -> Rep (Assert a) x)
-> (forall x. Rep (Assert a) x -> Assert a) -> Generic (Assert a)
forall x. Rep (Assert a) x -> Assert a
forall x. Assert a -> Rep (Assert a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Assert a) x -> Assert a
forall a x. Assert a -> Rep (Assert a) x
$cto :: forall a x. Rep (Assert a) x -> Assert a
$cfrom :: forall a x. Assert a -> Rep (Assert a) x
Generic,
      a -> Assert b -> Assert a
(a -> b) -> Assert a -> Assert b
(forall a b. (a -> b) -> Assert a -> Assert b)
-> (forall a b. a -> Assert b -> Assert a) -> Functor Assert
forall a b. a -> Assert b -> Assert a
forall a b. (a -> b) -> Assert a -> Assert b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Assert b -> Assert a
$c<$ :: forall a b. a -> Assert b -> Assert a
fmap :: (a -> b) -> Assert a -> Assert b
$cfmap :: forall a b. (a -> b) -> Assert a -> Assert b
Functor,
      Assert a -> Bool
(a -> m) -> Assert a -> m
(a -> b -> b) -> b -> Assert a -> b
(forall m. Monoid m => Assert m -> m)
-> (forall m a. Monoid m => (a -> m) -> Assert a -> m)
-> (forall m a. Monoid m => (a -> m) -> Assert a -> m)
-> (forall a b. (a -> b -> b) -> b -> Assert a -> b)
-> (forall a b. (a -> b -> b) -> b -> Assert a -> b)
-> (forall b a. (b -> a -> b) -> b -> Assert a -> b)
-> (forall b a. (b -> a -> b) -> b -> Assert a -> b)
-> (forall a. (a -> a -> a) -> Assert a -> a)
-> (forall a. (a -> a -> a) -> Assert a -> a)
-> (forall a. Assert a -> [a])
-> (forall a. Assert a -> Bool)
-> (forall a. Assert a -> Int)
-> (forall a. Eq a => a -> Assert a -> Bool)
-> (forall a. Ord a => Assert a -> a)
-> (forall a. Ord a => Assert a -> a)
-> (forall a. Num a => Assert a -> a)
-> (forall a. Num a => Assert a -> a)
-> Foldable Assert
forall a. Eq a => a -> Assert a -> Bool
forall a. Num a => Assert a -> a
forall a. Ord a => Assert a -> a
forall m. Monoid m => Assert m -> m
forall a. Assert a -> Bool
forall a. Assert a -> Int
forall a. Assert a -> [a]
forall a. (a -> a -> a) -> Assert a -> a
forall m a. Monoid m => (a -> m) -> Assert a -> m
forall b a. (b -> a -> b) -> b -> Assert a -> b
forall a b. (a -> b -> b) -> b -> Assert a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Assert a -> a
$cproduct :: forall a. Num a => Assert a -> a
sum :: Assert a -> a
$csum :: forall a. Num a => Assert a -> a
minimum :: Assert a -> a
$cminimum :: forall a. Ord a => Assert a -> a
maximum :: Assert a -> a
$cmaximum :: forall a. Ord a => Assert a -> a
elem :: a -> Assert a -> Bool
$celem :: forall a. Eq a => a -> Assert a -> Bool
length :: Assert a -> Int
$clength :: forall a. Assert a -> Int
null :: Assert a -> Bool
$cnull :: forall a. Assert a -> Bool
toList :: Assert a -> [a]
$ctoList :: forall a. Assert a -> [a]
foldl1 :: (a -> a -> a) -> Assert a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Assert a -> a
foldr1 :: (a -> a -> a) -> Assert a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Assert a -> a
foldl' :: (b -> a -> b) -> b -> Assert a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Assert a -> b
foldl :: (b -> a -> b) -> b -> Assert a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Assert a -> b
foldr' :: (a -> b -> b) -> b -> Assert a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Assert a -> b
foldr :: (a -> b -> b) -> b -> Assert a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Assert a -> b
foldMap' :: (a -> m) -> Assert a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Assert a -> m
foldMap :: (a -> m) -> Assert a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Assert a -> m
fold :: Assert m -> m
$cfold :: forall m. Monoid m => Assert m -> m
Foldable,
      Functor Assert
Foldable Assert
Functor Assert
-> Foldable Assert
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Assert a -> f (Assert b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Assert (f a) -> f (Assert a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Assert a -> m (Assert b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Assert (m a) -> m (Assert a))
-> Traversable Assert
(a -> f b) -> Assert a -> f (Assert b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Assert (m a) -> m (Assert a)
forall (f :: * -> *) a.
Applicative f =>
Assert (f a) -> f (Assert a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Assert a -> m (Assert b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Assert a -> f (Assert b)
sequence :: Assert (m a) -> m (Assert a)
$csequence :: forall (m :: * -> *) a. Monad m => Assert (m a) -> m (Assert a)
mapM :: (a -> m b) -> Assert a -> m (Assert b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Assert a -> m (Assert b)
sequenceA :: Assert (f a) -> f (Assert a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Assert (f a) -> f (Assert a)
traverse :: (a -> f b) -> Assert a -> f (Assert b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Assert a -> f (Assert b)
$cp2Traversable :: Foldable Assert
$cp1Traversable :: Functor Assert
Traversable
    )

instance Alpha a => Alpha (Assert a)

deriveShow1 ''Assert

data CompSpec a = CompSpec
  { CompSpec a -> String
var :: String,
    CompSpec a -> a
forspec :: a,
    CompSpec a -> Maybe a
ifspec :: Maybe a
  }
  deriving
    ( CompSpec a -> CompSpec a -> Bool
(CompSpec a -> CompSpec a -> Bool)
-> (CompSpec a -> CompSpec a -> Bool) -> Eq (CompSpec a)
forall a. Eq a => CompSpec a -> CompSpec a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompSpec a -> CompSpec a -> Bool
$c/= :: forall a. Eq a => CompSpec a -> CompSpec a -> Bool
== :: CompSpec a -> CompSpec a -> Bool
$c== :: forall a. Eq a => CompSpec a -> CompSpec a -> Bool
Eq,
      ReadPrec [CompSpec a]
ReadPrec (CompSpec a)
Int -> ReadS (CompSpec a)
ReadS [CompSpec a]
(Int -> ReadS (CompSpec a))
-> ReadS [CompSpec a]
-> ReadPrec (CompSpec a)
-> ReadPrec [CompSpec a]
-> Read (CompSpec a)
forall a. Read a => ReadPrec [CompSpec a]
forall a. Read a => ReadPrec (CompSpec a)
forall a. Read a => Int -> ReadS (CompSpec a)
forall a. Read a => ReadS [CompSpec a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompSpec a]
$creadListPrec :: forall a. Read a => ReadPrec [CompSpec a]
readPrec :: ReadPrec (CompSpec a)
$creadPrec :: forall a. Read a => ReadPrec (CompSpec a)
readList :: ReadS [CompSpec a]
$creadList :: forall a. Read a => ReadS [CompSpec a]
readsPrec :: Int -> ReadS (CompSpec a)
$creadsPrec :: forall a. Read a => Int -> ReadS (CompSpec a)
Read,
      Int -> CompSpec a -> ShowS
[CompSpec a] -> ShowS
CompSpec a -> String
(Int -> CompSpec a -> ShowS)
-> (CompSpec a -> String)
-> ([CompSpec a] -> ShowS)
-> Show (CompSpec a)
forall a. Show a => Int -> CompSpec a -> ShowS
forall a. Show a => [CompSpec a] -> ShowS
forall a. Show a => CompSpec a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompSpec a] -> ShowS
$cshowList :: forall a. Show a => [CompSpec a] -> ShowS
show :: CompSpec a -> String
$cshow :: forall a. Show a => CompSpec a -> String
showsPrec :: Int -> CompSpec a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CompSpec a -> ShowS
Show,
      Typeable,
      Typeable (CompSpec a)
DataType
Constr
Typeable (CompSpec a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CompSpec a -> c (CompSpec a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (CompSpec a))
-> (CompSpec a -> Constr)
-> (CompSpec a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (CompSpec a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (CompSpec a)))
-> ((forall b. Data b => b -> b) -> CompSpec a -> CompSpec a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CompSpec a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CompSpec a -> r)
-> (forall u. (forall d. Data d => d -> u) -> CompSpec a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CompSpec a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a))
-> Data (CompSpec a)
CompSpec a -> DataType
CompSpec a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (CompSpec a))
(forall b. Data b => b -> b) -> CompSpec a -> CompSpec a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompSpec a -> c (CompSpec a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompSpec a)
forall a. Data a => Typeable (CompSpec a)
forall a. Data a => CompSpec a -> DataType
forall a. Data a => CompSpec a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> CompSpec a -> CompSpec a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> CompSpec a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> CompSpec a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompSpec a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompSpec a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompSpec a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompSpec a -> c (CompSpec a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CompSpec a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompSpec a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CompSpec a -> u
forall u. (forall d. Data d => d -> u) -> CompSpec a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompSpec a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompSpec a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompSpec a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompSpec a -> c (CompSpec a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (CompSpec a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompSpec a))
$cCompSpec :: Constr
$tCompSpec :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a)
gmapMp :: (forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a)
gmapM :: (forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> CompSpec a -> m (CompSpec a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> CompSpec a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> CompSpec a -> u
gmapQ :: (forall d. Data d => d -> u) -> CompSpec a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> CompSpec a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompSpec a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompSpec a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompSpec a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompSpec a -> r
gmapT :: (forall b. Data b => b -> b) -> CompSpec a -> CompSpec a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> CompSpec a -> CompSpec a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompSpec a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (CompSpec a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (CompSpec a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (CompSpec a))
dataTypeOf :: CompSpec a -> DataType
$cdataTypeOf :: forall a. Data a => CompSpec a -> DataType
toConstr :: CompSpec a -> Constr
$ctoConstr :: forall a. Data a => CompSpec a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompSpec a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (CompSpec a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompSpec a -> c (CompSpec a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompSpec a -> c (CompSpec a)
$cp1Data :: forall a. Data a => Typeable (CompSpec a)
Data,
      (forall x. CompSpec a -> Rep (CompSpec a) x)
-> (forall x. Rep (CompSpec a) x -> CompSpec a)
-> Generic (CompSpec a)
forall x. Rep (CompSpec a) x -> CompSpec a
forall x. CompSpec a -> Rep (CompSpec a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CompSpec a) x -> CompSpec a
forall a x. CompSpec a -> Rep (CompSpec a) x
$cto :: forall a x. Rep (CompSpec a) x -> CompSpec a
$cfrom :: forall a x. CompSpec a -> Rep (CompSpec a) x
Generic,
      a -> CompSpec b -> CompSpec a
(a -> b) -> CompSpec a -> CompSpec b
(forall a b. (a -> b) -> CompSpec a -> CompSpec b)
-> (forall a b. a -> CompSpec b -> CompSpec a) -> Functor CompSpec
forall a b. a -> CompSpec b -> CompSpec a
forall a b. (a -> b) -> CompSpec a -> CompSpec b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CompSpec b -> CompSpec a
$c<$ :: forall a b. a -> CompSpec b -> CompSpec a
fmap :: (a -> b) -> CompSpec a -> CompSpec b
$cfmap :: forall a b. (a -> b) -> CompSpec a -> CompSpec b
Functor,
      CompSpec a -> Bool
(a -> m) -> CompSpec a -> m
(a -> b -> b) -> b -> CompSpec a -> b
(forall m. Monoid m => CompSpec m -> m)
-> (forall m a. Monoid m => (a -> m) -> CompSpec a -> m)
-> (forall m a. Monoid m => (a -> m) -> CompSpec a -> m)
-> (forall a b. (a -> b -> b) -> b -> CompSpec a -> b)
-> (forall a b. (a -> b -> b) -> b -> CompSpec a -> b)
-> (forall b a. (b -> a -> b) -> b -> CompSpec a -> b)
-> (forall b a. (b -> a -> b) -> b -> CompSpec a -> b)
-> (forall a. (a -> a -> a) -> CompSpec a -> a)
-> (forall a. (a -> a -> a) -> CompSpec a -> a)
-> (forall a. CompSpec a -> [a])
-> (forall a. CompSpec a -> Bool)
-> (forall a. CompSpec a -> Int)
-> (forall a. Eq a => a -> CompSpec a -> Bool)
-> (forall a. Ord a => CompSpec a -> a)
-> (forall a. Ord a => CompSpec a -> a)
-> (forall a. Num a => CompSpec a -> a)
-> (forall a. Num a => CompSpec a -> a)
-> Foldable CompSpec
forall a. Eq a => a -> CompSpec a -> Bool
forall a. Num a => CompSpec a -> a
forall a. Ord a => CompSpec a -> a
forall m. Monoid m => CompSpec m -> m
forall a. CompSpec a -> Bool
forall a. CompSpec a -> Int
forall a. CompSpec a -> [a]
forall a. (a -> a -> a) -> CompSpec a -> a
forall m a. Monoid m => (a -> m) -> CompSpec a -> m
forall b a. (b -> a -> b) -> b -> CompSpec a -> b
forall a b. (a -> b -> b) -> b -> CompSpec a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: CompSpec a -> a
$cproduct :: forall a. Num a => CompSpec a -> a
sum :: CompSpec a -> a
$csum :: forall a. Num a => CompSpec a -> a
minimum :: CompSpec a -> a
$cminimum :: forall a. Ord a => CompSpec a -> a
maximum :: CompSpec a -> a
$cmaximum :: forall a. Ord a => CompSpec a -> a
elem :: a -> CompSpec a -> Bool
$celem :: forall a. Eq a => a -> CompSpec a -> Bool
length :: CompSpec a -> Int
$clength :: forall a. CompSpec a -> Int
null :: CompSpec a -> Bool
$cnull :: forall a. CompSpec a -> Bool
toList :: CompSpec a -> [a]
$ctoList :: forall a. CompSpec a -> [a]
foldl1 :: (a -> a -> a) -> CompSpec a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CompSpec a -> a
foldr1 :: (a -> a -> a) -> CompSpec a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CompSpec a -> a
foldl' :: (b -> a -> b) -> b -> CompSpec a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CompSpec a -> b
foldl :: (b -> a -> b) -> b -> CompSpec a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CompSpec a -> b
foldr' :: (a -> b -> b) -> b -> CompSpec a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CompSpec a -> b
foldr :: (a -> b -> b) -> b -> CompSpec a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CompSpec a -> b
foldMap' :: (a -> m) -> CompSpec a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CompSpec a -> m
foldMap :: (a -> m) -> CompSpec a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CompSpec a -> m
fold :: CompSpec m -> m
$cfold :: forall m. Monoid m => CompSpec m -> m
Foldable,
      Functor CompSpec
Foldable CompSpec
Functor CompSpec
-> Foldable CompSpec
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> CompSpec a -> f (CompSpec b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    CompSpec (f a) -> f (CompSpec a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> CompSpec a -> m (CompSpec b))
-> (forall (m :: * -> *) a.
    Monad m =>
    CompSpec (m a) -> m (CompSpec a))
-> Traversable CompSpec
(a -> f b) -> CompSpec a -> f (CompSpec b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => CompSpec (m a) -> m (CompSpec a)
forall (f :: * -> *) a.
Applicative f =>
CompSpec (f a) -> f (CompSpec a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CompSpec a -> m (CompSpec b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CompSpec a -> f (CompSpec b)
sequence :: CompSpec (m a) -> m (CompSpec a)
$csequence :: forall (m :: * -> *) a. Monad m => CompSpec (m a) -> m (CompSpec a)
mapM :: (a -> m b) -> CompSpec a -> m (CompSpec b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CompSpec a -> m (CompSpec b)
sequenceA :: CompSpec (f a) -> f (CompSpec a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CompSpec (f a) -> f (CompSpec a)
traverse :: (a -> f b) -> CompSpec a -> f (CompSpec b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CompSpec a -> f (CompSpec b)
$cp2Traversable :: Foldable CompSpec
$cp1Traversable :: Functor CompSpec
Traversable
    )

deriveShow1 ''CompSpec

instance Alpha a => Alpha (CompSpec a)

data StackFrame a = StackFrame
  { StackFrame a -> Name a
name :: Name a,
    StackFrame a -> SrcSpan
span :: SrcSpan
  }
  deriving (StackFrame a -> StackFrame a -> Bool
(StackFrame a -> StackFrame a -> Bool)
-> (StackFrame a -> StackFrame a -> Bool) -> Eq (StackFrame a)
forall a. StackFrame a -> StackFrame a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackFrame a -> StackFrame a -> Bool
$c/= :: forall a. StackFrame a -> StackFrame a -> Bool
== :: StackFrame a -> StackFrame a -> Bool
$c== :: forall a. StackFrame a -> StackFrame a -> Bool
Eq, Int -> StackFrame a -> ShowS
[StackFrame a] -> ShowS
StackFrame a -> String
(Int -> StackFrame a -> ShowS)
-> (StackFrame a -> String)
-> ([StackFrame a] -> ShowS)
-> Show (StackFrame a)
forall a. Int -> StackFrame a -> ShowS
forall a. [StackFrame a] -> ShowS
forall a. StackFrame a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackFrame a] -> ShowS
$cshowList :: forall a. [StackFrame a] -> ShowS
show :: StackFrame a -> String
$cshow :: forall a. StackFrame a -> String
showsPrec :: Int -> StackFrame a -> ShowS
$cshowsPrec :: forall a. Int -> StackFrame a -> ShowS
Show)

newtype Backtrace a = Backtrace [StackFrame a]
  deriving (Backtrace a -> Backtrace a -> Bool
(Backtrace a -> Backtrace a -> Bool)
-> (Backtrace a -> Backtrace a -> Bool) -> Eq (Backtrace a)
forall a. Backtrace a -> Backtrace a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Backtrace a -> Backtrace a -> Bool
$c/= :: forall a. Backtrace a -> Backtrace a -> Bool
== :: Backtrace a -> Backtrace a -> Bool
$c== :: forall a. Backtrace a -> Backtrace a -> Bool
Eq, Int -> Backtrace a -> ShowS
[Backtrace a] -> ShowS
Backtrace a -> String
(Int -> Backtrace a -> ShowS)
-> (Backtrace a -> String)
-> ([Backtrace a] -> ShowS)
-> Show (Backtrace a)
forall a. Int -> Backtrace a -> ShowS
forall a. [Backtrace a] -> ShowS
forall a. Backtrace a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Backtrace a] -> ShowS
$cshowList :: forall a. [Backtrace a] -> ShowS
show :: Backtrace a -> String
$cshow :: forall a. Backtrace a -> String
showsPrec :: Int -> Backtrace a -> ShowS
$cshowsPrec :: forall a. Int -> Backtrace a -> ShowS
Show)

data Visibility = Visible | Hidden | Forced
  deriving
    ( Visibility -> Visibility -> Bool
(Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool) -> Eq Visibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c== :: Visibility -> Visibility -> Bool
Eq,
      ReadPrec [Visibility]
ReadPrec Visibility
Int -> ReadS Visibility
ReadS [Visibility]
(Int -> ReadS Visibility)
-> ReadS [Visibility]
-> ReadPrec Visibility
-> ReadPrec [Visibility]
-> Read Visibility
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Visibility]
$creadListPrec :: ReadPrec [Visibility]
readPrec :: ReadPrec Visibility
$creadPrec :: ReadPrec Visibility
readList :: ReadS [Visibility]
$creadList :: ReadS [Visibility]
readsPrec :: Int -> ReadS Visibility
$creadsPrec :: Int -> ReadS Visibility
Read,
      Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
(Int -> Visibility -> ShowS)
-> (Visibility -> String)
-> ([Visibility] -> ShowS)
-> Show Visibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Visibility] -> ShowS
$cshowList :: [Visibility] -> ShowS
show :: Visibility -> String
$cshow :: Visibility -> String
showsPrec :: Int -> Visibility -> ShowS
$cshowsPrec :: Int -> Visibility -> ShowS
Show,
      (forall x. Visibility -> Rep Visibility x)
-> (forall x. Rep Visibility x -> Visibility) -> Generic Visibility
forall x. Rep Visibility x -> Visibility
forall x. Visibility -> Rep Visibility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Visibility x -> Visibility
$cfrom :: forall x. Visibility -> Rep Visibility x
Generic,
      Typeable,
      Typeable Visibility
DataType
Constr
Typeable Visibility
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Visibility -> c Visibility)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Visibility)
-> (Visibility -> Constr)
-> (Visibility -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Visibility))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Visibility))
-> ((forall b. Data b => b -> b) -> Visibility -> Visibility)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Visibility -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Visibility -> r)
-> (forall u. (forall d. Data d => d -> u) -> Visibility -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Visibility -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Visibility -> m Visibility)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Visibility -> m Visibility)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Visibility -> m Visibility)
-> Data Visibility
Visibility -> DataType
Visibility -> Constr
(forall b. Data b => b -> b) -> Visibility -> Visibility
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Visibility -> c Visibility
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Visibility
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Visibility -> u
forall u. (forall d. Data d => d -> u) -> Visibility -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Visibility -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Visibility -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Visibility -> m Visibility
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Visibility -> m Visibility
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Visibility
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Visibility -> c Visibility
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Visibility)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Visibility)
$cForced :: Constr
$cHidden :: Constr
$cVisible :: Constr
$tVisibility :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Visibility -> m Visibility
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Visibility -> m Visibility
gmapMp :: (forall d. Data d => d -> m d) -> Visibility -> m Visibility
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Visibility -> m Visibility
gmapM :: (forall d. Data d => d -> m d) -> Visibility -> m Visibility
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Visibility -> m Visibility
gmapQi :: Int -> (forall d. Data d => d -> u) -> Visibility -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Visibility -> u
gmapQ :: (forall d. Data d => d -> u) -> Visibility -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Visibility -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Visibility -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Visibility -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Visibility -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Visibility -> r
gmapT :: (forall b. Data b => b -> b) -> Visibility -> Visibility
$cgmapT :: (forall b. Data b => b -> b) -> Visibility -> Visibility
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Visibility)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Visibility)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Visibility)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Visibility)
dataTypeOf :: Visibility -> DataType
$cdataTypeOf :: Visibility -> DataType
toConstr :: Visibility -> Constr
$ctoConstr :: Visibility -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Visibility
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Visibility
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Visibility -> c Visibility
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Visibility -> c Visibility
$cp1Data :: Typeable Visibility
Data
    )

instance Alpha Visibility

instance Binary Visibility

class HasVisibility a where
  visible :: a -> Bool
  forced :: a -> Bool
  hidden :: a -> Bool