-- | A Haskell syntax model, loosely based on Language.Haskell.Tools.AST

module Hydra.Ext.Haskell.Ast where

import qualified Hydra.Core as Core
import Data.List
import Data.Map
import Data.Set

-- | A pattern-matching alternative
data Alternative = 
  Alternative {
    Alternative -> Pattern
alternativePattern :: Pattern,
    Alternative -> CaseRhs
alternativeRhs :: CaseRhs,
    Alternative -> Maybe LocalBindings
alternativeBinds :: (Maybe LocalBindings)}
  deriving (Alternative -> Alternative -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alternative -> Alternative -> Bool
$c/= :: Alternative -> Alternative -> Bool
== :: Alternative -> Alternative -> Bool
$c== :: Alternative -> Alternative -> Bool
Eq, Eq Alternative
Alternative -> Alternative -> Bool
Alternative -> Alternative -> Ordering
Alternative -> Alternative -> Alternative
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 :: Alternative -> Alternative -> Alternative
$cmin :: Alternative -> Alternative -> Alternative
max :: Alternative -> Alternative -> Alternative
$cmax :: Alternative -> Alternative -> Alternative
>= :: Alternative -> Alternative -> Bool
$c>= :: Alternative -> Alternative -> Bool
> :: Alternative -> Alternative -> Bool
$c> :: Alternative -> Alternative -> Bool
<= :: Alternative -> Alternative -> Bool
$c<= :: Alternative -> Alternative -> Bool
< :: Alternative -> Alternative -> Bool
$c< :: Alternative -> Alternative -> Bool
compare :: Alternative -> Alternative -> Ordering
$ccompare :: Alternative -> Alternative -> Ordering
Ord, ReadPrec [Alternative]
ReadPrec Alternative
Int -> ReadS Alternative
ReadS [Alternative]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Alternative]
$creadListPrec :: ReadPrec [Alternative]
readPrec :: ReadPrec Alternative
$creadPrec :: ReadPrec Alternative
readList :: ReadS [Alternative]
$creadList :: ReadS [Alternative]
readsPrec :: Int -> ReadS Alternative
$creadsPrec :: Int -> ReadS Alternative
Read, Int -> Alternative -> ShowS
[Alternative] -> ShowS
Alternative -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alternative] -> ShowS
$cshowList :: [Alternative] -> ShowS
show :: Alternative -> String
$cshow :: Alternative -> String
showsPrec :: Int -> Alternative -> ShowS
$cshowsPrec :: Int -> Alternative -> ShowS
Show)

_Alternative :: Name
_Alternative = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Alternative")

_Alternative_pattern :: FieldName
_Alternative_pattern = (String -> FieldName
Core.FieldName String
"pattern")

_Alternative_rhs :: FieldName
_Alternative_rhs = (String -> FieldName
Core.FieldName String
"rhs")

_Alternative_binds :: FieldName
_Alternative_binds = (String -> FieldName
Core.FieldName String
"binds")

-- | A type assertion
data Assertion = 
  Assertion {
    Assertion -> Name
assertionName :: Name,
    Assertion -> [Type]
assertionTypes :: [Type]}
  deriving (Assertion -> Assertion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assertion -> Assertion -> Bool
$c/= :: Assertion -> Assertion -> Bool
== :: Assertion -> Assertion -> Bool
$c== :: Assertion -> Assertion -> Bool
Eq, Eq Assertion
Assertion -> Assertion -> Bool
Assertion -> Assertion -> Ordering
Assertion -> Assertion -> Assertion
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 :: Assertion -> Assertion -> Assertion
$cmin :: Assertion -> Assertion -> Assertion
max :: Assertion -> Assertion -> Assertion
$cmax :: Assertion -> Assertion -> Assertion
>= :: Assertion -> Assertion -> Bool
$c>= :: Assertion -> Assertion -> Bool
> :: Assertion -> Assertion -> Bool
$c> :: Assertion -> Assertion -> Bool
<= :: Assertion -> Assertion -> Bool
$c<= :: Assertion -> Assertion -> Bool
< :: Assertion -> Assertion -> Bool
$c< :: Assertion -> Assertion -> Bool
compare :: Assertion -> Assertion -> Ordering
$ccompare :: Assertion -> Assertion -> Ordering
Ord, ReadPrec [Assertion]
ReadPrec Assertion
Int -> ReadS Assertion
ReadS [Assertion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Assertion]
$creadListPrec :: ReadPrec [Assertion]
readPrec :: ReadPrec Assertion
$creadPrec :: ReadPrec Assertion
readList :: ReadS [Assertion]
$creadList :: ReadS [Assertion]
readsPrec :: Int -> ReadS Assertion
$creadsPrec :: Int -> ReadS Assertion
Read, Int -> Assertion -> ShowS
[Assertion] -> ShowS
Assertion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assertion] -> ShowS
$cshowList :: [Assertion] -> ShowS
show :: Assertion -> String
$cshow :: Assertion -> String
showsPrec :: Int -> Assertion -> ShowS
$cshowsPrec :: Int -> Assertion -> ShowS
Show)

_Assertion :: Name
_Assertion = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Assertion")

_Assertion_name :: FieldName
_Assertion_name = (String -> FieldName
Core.FieldName String
"name")

_Assertion_types :: FieldName
_Assertion_types = (String -> FieldName
Core.FieldName String
"types")

-- | The right-hand side of a pattern-matching alternative
newtype CaseRhs = 
  CaseRhs {
    -- | The right-hand side of a pattern-matching alternative
    CaseRhs -> Expression
unCaseRhs :: Expression}
  deriving (CaseRhs -> CaseRhs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaseRhs -> CaseRhs -> Bool
$c/= :: CaseRhs -> CaseRhs -> Bool
== :: CaseRhs -> CaseRhs -> Bool
$c== :: CaseRhs -> CaseRhs -> Bool
Eq, Eq CaseRhs
CaseRhs -> CaseRhs -> Bool
CaseRhs -> CaseRhs -> Ordering
CaseRhs -> CaseRhs -> CaseRhs
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 :: CaseRhs -> CaseRhs -> CaseRhs
$cmin :: CaseRhs -> CaseRhs -> CaseRhs
max :: CaseRhs -> CaseRhs -> CaseRhs
$cmax :: CaseRhs -> CaseRhs -> CaseRhs
>= :: CaseRhs -> CaseRhs -> Bool
$c>= :: CaseRhs -> CaseRhs -> Bool
> :: CaseRhs -> CaseRhs -> Bool
$c> :: CaseRhs -> CaseRhs -> Bool
<= :: CaseRhs -> CaseRhs -> Bool
$c<= :: CaseRhs -> CaseRhs -> Bool
< :: CaseRhs -> CaseRhs -> Bool
$c< :: CaseRhs -> CaseRhs -> Bool
compare :: CaseRhs -> CaseRhs -> Ordering
$ccompare :: CaseRhs -> CaseRhs -> Ordering
Ord, ReadPrec [CaseRhs]
ReadPrec CaseRhs
Int -> ReadS CaseRhs
ReadS [CaseRhs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CaseRhs]
$creadListPrec :: ReadPrec [CaseRhs]
readPrec :: ReadPrec CaseRhs
$creadPrec :: ReadPrec CaseRhs
readList :: ReadS [CaseRhs]
$creadList :: ReadS [CaseRhs]
readsPrec :: Int -> ReadS CaseRhs
$creadsPrec :: Int -> ReadS CaseRhs
Read, Int -> CaseRhs -> ShowS
[CaseRhs] -> ShowS
CaseRhs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaseRhs] -> ShowS
$cshowList :: [CaseRhs] -> ShowS
show :: CaseRhs -> String
$cshow :: CaseRhs -> String
showsPrec :: Int -> CaseRhs -> ShowS
$cshowsPrec :: Int -> CaseRhs -> ShowS
Show)

_CaseRhs :: Name
_CaseRhs = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.CaseRhs")

-- | A data constructor
data Constructor = 
  ConstructorOrdinary Constructor_Ordinary |
  ConstructorRecord Constructor_Record
  deriving (Constructor -> Constructor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constructor -> Constructor -> Bool
$c/= :: Constructor -> Constructor -> Bool
== :: Constructor -> Constructor -> Bool
$c== :: Constructor -> Constructor -> Bool
Eq, Eq Constructor
Constructor -> Constructor -> Bool
Constructor -> Constructor -> Ordering
Constructor -> Constructor -> Constructor
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 :: Constructor -> Constructor -> Constructor
$cmin :: Constructor -> Constructor -> Constructor
max :: Constructor -> Constructor -> Constructor
$cmax :: Constructor -> Constructor -> Constructor
>= :: Constructor -> Constructor -> Bool
$c>= :: Constructor -> Constructor -> Bool
> :: Constructor -> Constructor -> Bool
$c> :: Constructor -> Constructor -> Bool
<= :: Constructor -> Constructor -> Bool
$c<= :: Constructor -> Constructor -> Bool
< :: Constructor -> Constructor -> Bool
$c< :: Constructor -> Constructor -> Bool
compare :: Constructor -> Constructor -> Ordering
$ccompare :: Constructor -> Constructor -> Ordering
Ord, ReadPrec [Constructor]
ReadPrec Constructor
Int -> ReadS Constructor
ReadS [Constructor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Constructor]
$creadListPrec :: ReadPrec [Constructor]
readPrec :: ReadPrec Constructor
$creadPrec :: ReadPrec Constructor
readList :: ReadS [Constructor]
$creadList :: ReadS [Constructor]
readsPrec :: Int -> ReadS Constructor
$creadsPrec :: Int -> ReadS Constructor
Read, Int -> Constructor -> ShowS
[Constructor] -> ShowS
Constructor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constructor] -> ShowS
$cshowList :: [Constructor] -> ShowS
show :: Constructor -> String
$cshow :: Constructor -> String
showsPrec :: Int -> Constructor -> ShowS
$cshowsPrec :: Int -> Constructor -> ShowS
Show)

_Constructor :: Name
_Constructor = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Constructor")

_Constructor_ordinary :: FieldName
_Constructor_ordinary = (String -> FieldName
Core.FieldName String
"ordinary")

_Constructor_record :: FieldName
_Constructor_record = (String -> FieldName
Core.FieldName String
"record")

-- | An ordinary (positional) data constructor
data Constructor_Ordinary = 
  Constructor_Ordinary {
    Constructor_Ordinary -> Name
constructor_OrdinaryName :: Name,
    Constructor_Ordinary -> [Type]
constructor_OrdinaryFields :: [Type]}
  deriving (Constructor_Ordinary -> Constructor_Ordinary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
$c/= :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
== :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
$c== :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
Eq, Eq Constructor_Ordinary
Constructor_Ordinary -> Constructor_Ordinary -> Bool
Constructor_Ordinary -> Constructor_Ordinary -> Ordering
Constructor_Ordinary
-> Constructor_Ordinary -> Constructor_Ordinary
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 :: Constructor_Ordinary
-> Constructor_Ordinary -> Constructor_Ordinary
$cmin :: Constructor_Ordinary
-> Constructor_Ordinary -> Constructor_Ordinary
max :: Constructor_Ordinary
-> Constructor_Ordinary -> Constructor_Ordinary
$cmax :: Constructor_Ordinary
-> Constructor_Ordinary -> Constructor_Ordinary
>= :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
$c>= :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
> :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
$c> :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
<= :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
$c<= :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
< :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
$c< :: Constructor_Ordinary -> Constructor_Ordinary -> Bool
compare :: Constructor_Ordinary -> Constructor_Ordinary -> Ordering
$ccompare :: Constructor_Ordinary -> Constructor_Ordinary -> Ordering
Ord, ReadPrec [Constructor_Ordinary]
ReadPrec Constructor_Ordinary
Int -> ReadS Constructor_Ordinary
ReadS [Constructor_Ordinary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Constructor_Ordinary]
$creadListPrec :: ReadPrec [Constructor_Ordinary]
readPrec :: ReadPrec Constructor_Ordinary
$creadPrec :: ReadPrec Constructor_Ordinary
readList :: ReadS [Constructor_Ordinary]
$creadList :: ReadS [Constructor_Ordinary]
readsPrec :: Int -> ReadS Constructor_Ordinary
$creadsPrec :: Int -> ReadS Constructor_Ordinary
Read, Int -> Constructor_Ordinary -> ShowS
[Constructor_Ordinary] -> ShowS
Constructor_Ordinary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constructor_Ordinary] -> ShowS
$cshowList :: [Constructor_Ordinary] -> ShowS
show :: Constructor_Ordinary -> String
$cshow :: Constructor_Ordinary -> String
showsPrec :: Int -> Constructor_Ordinary -> ShowS
$cshowsPrec :: Int -> Constructor_Ordinary -> ShowS
Show)

_Constructor_Ordinary :: Name
_Constructor_Ordinary = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Constructor.Ordinary")

_Constructor_Ordinary_name :: FieldName
_Constructor_Ordinary_name = (String -> FieldName
Core.FieldName String
"name")

_Constructor_Ordinary_fields :: FieldName
_Constructor_Ordinary_fields = (String -> FieldName
Core.FieldName String
"fields")

-- | A record-style data constructor
data Constructor_Record = 
  Constructor_Record {
    Constructor_Record -> Name
constructor_RecordName :: Name,
    Constructor_Record -> [FieldWithComments]
constructor_RecordFields :: [FieldWithComments]}
  deriving (Constructor_Record -> Constructor_Record -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constructor_Record -> Constructor_Record -> Bool
$c/= :: Constructor_Record -> Constructor_Record -> Bool
== :: Constructor_Record -> Constructor_Record -> Bool
$c== :: Constructor_Record -> Constructor_Record -> Bool
Eq, Eq Constructor_Record
Constructor_Record -> Constructor_Record -> Bool
Constructor_Record -> Constructor_Record -> Ordering
Constructor_Record -> Constructor_Record -> Constructor_Record
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 :: Constructor_Record -> Constructor_Record -> Constructor_Record
$cmin :: Constructor_Record -> Constructor_Record -> Constructor_Record
max :: Constructor_Record -> Constructor_Record -> Constructor_Record
$cmax :: Constructor_Record -> Constructor_Record -> Constructor_Record
>= :: Constructor_Record -> Constructor_Record -> Bool
$c>= :: Constructor_Record -> Constructor_Record -> Bool
> :: Constructor_Record -> Constructor_Record -> Bool
$c> :: Constructor_Record -> Constructor_Record -> Bool
<= :: Constructor_Record -> Constructor_Record -> Bool
$c<= :: Constructor_Record -> Constructor_Record -> Bool
< :: Constructor_Record -> Constructor_Record -> Bool
$c< :: Constructor_Record -> Constructor_Record -> Bool
compare :: Constructor_Record -> Constructor_Record -> Ordering
$ccompare :: Constructor_Record -> Constructor_Record -> Ordering
Ord, ReadPrec [Constructor_Record]
ReadPrec Constructor_Record
Int -> ReadS Constructor_Record
ReadS [Constructor_Record]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Constructor_Record]
$creadListPrec :: ReadPrec [Constructor_Record]
readPrec :: ReadPrec Constructor_Record
$creadPrec :: ReadPrec Constructor_Record
readList :: ReadS [Constructor_Record]
$creadList :: ReadS [Constructor_Record]
readsPrec :: Int -> ReadS Constructor_Record
$creadsPrec :: Int -> ReadS Constructor_Record
Read, Int -> Constructor_Record -> ShowS
[Constructor_Record] -> ShowS
Constructor_Record -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constructor_Record] -> ShowS
$cshowList :: [Constructor_Record] -> ShowS
show :: Constructor_Record -> String
$cshow :: Constructor_Record -> String
showsPrec :: Int -> Constructor_Record -> ShowS
$cshowsPrec :: Int -> Constructor_Record -> ShowS
Show)

_Constructor_Record :: Name
_Constructor_Record = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Constructor.Record")

_Constructor_Record_name :: FieldName
_Constructor_Record_name = (String -> FieldName
Core.FieldName String
"name")

_Constructor_Record_fields :: FieldName
_Constructor_Record_fields = (String -> FieldName
Core.FieldName String
"fields")

-- | A data constructor together with any comments
data ConstructorWithComments = 
  ConstructorWithComments {
    ConstructorWithComments -> Constructor
constructorWithCommentsBody :: Constructor,
    ConstructorWithComments -> Maybe String
constructorWithCommentsComments :: (Maybe String)}
  deriving (ConstructorWithComments -> ConstructorWithComments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstructorWithComments -> ConstructorWithComments -> Bool
$c/= :: ConstructorWithComments -> ConstructorWithComments -> Bool
== :: ConstructorWithComments -> ConstructorWithComments -> Bool
$c== :: ConstructorWithComments -> ConstructorWithComments -> Bool
Eq, Eq ConstructorWithComments
ConstructorWithComments -> ConstructorWithComments -> Bool
ConstructorWithComments -> ConstructorWithComments -> Ordering
ConstructorWithComments
-> ConstructorWithComments -> ConstructorWithComments
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 :: ConstructorWithComments
-> ConstructorWithComments -> ConstructorWithComments
$cmin :: ConstructorWithComments
-> ConstructorWithComments -> ConstructorWithComments
max :: ConstructorWithComments
-> ConstructorWithComments -> ConstructorWithComments
$cmax :: ConstructorWithComments
-> ConstructorWithComments -> ConstructorWithComments
>= :: ConstructorWithComments -> ConstructorWithComments -> Bool
$c>= :: ConstructorWithComments -> ConstructorWithComments -> Bool
> :: ConstructorWithComments -> ConstructorWithComments -> Bool
$c> :: ConstructorWithComments -> ConstructorWithComments -> Bool
<= :: ConstructorWithComments -> ConstructorWithComments -> Bool
$c<= :: ConstructorWithComments -> ConstructorWithComments -> Bool
< :: ConstructorWithComments -> ConstructorWithComments -> Bool
$c< :: ConstructorWithComments -> ConstructorWithComments -> Bool
compare :: ConstructorWithComments -> ConstructorWithComments -> Ordering
$ccompare :: ConstructorWithComments -> ConstructorWithComments -> Ordering
Ord, ReadPrec [ConstructorWithComments]
ReadPrec ConstructorWithComments
Int -> ReadS ConstructorWithComments
ReadS [ConstructorWithComments]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConstructorWithComments]
$creadListPrec :: ReadPrec [ConstructorWithComments]
readPrec :: ReadPrec ConstructorWithComments
$creadPrec :: ReadPrec ConstructorWithComments
readList :: ReadS [ConstructorWithComments]
$creadList :: ReadS [ConstructorWithComments]
readsPrec :: Int -> ReadS ConstructorWithComments
$creadsPrec :: Int -> ReadS ConstructorWithComments
Read, Int -> ConstructorWithComments -> ShowS
[ConstructorWithComments] -> ShowS
ConstructorWithComments -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstructorWithComments] -> ShowS
$cshowList :: [ConstructorWithComments] -> ShowS
show :: ConstructorWithComments -> String
$cshow :: ConstructorWithComments -> String
showsPrec :: Int -> ConstructorWithComments -> ShowS
$cshowsPrec :: Int -> ConstructorWithComments -> ShowS
Show)

_ConstructorWithComments :: Name
_ConstructorWithComments = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.ConstructorWithComments")

_ConstructorWithComments_body :: FieldName
_ConstructorWithComments_body = (String -> FieldName
Core.FieldName String
"body")

_ConstructorWithComments_comments :: FieldName
_ConstructorWithComments_comments = (String -> FieldName
Core.FieldName String
"comments")

-- | A data type declaration
data DataDeclaration = 
  DataDeclaration {
    DataDeclaration -> DataDeclaration_Keyword
dataDeclarationKeyword :: DataDeclaration_Keyword,
    DataDeclaration -> [Assertion]
dataDeclarationContext :: [Assertion],
    DataDeclaration -> DeclarationHead
dataDeclarationHead :: DeclarationHead,
    DataDeclaration -> [ConstructorWithComments]
dataDeclarationConstructors :: [ConstructorWithComments],
    DataDeclaration -> [Deriving]
dataDeclarationDeriving :: [Deriving]}
  deriving (DataDeclaration -> DataDeclaration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataDeclaration -> DataDeclaration -> Bool
$c/= :: DataDeclaration -> DataDeclaration -> Bool
== :: DataDeclaration -> DataDeclaration -> Bool
$c== :: DataDeclaration -> DataDeclaration -> Bool
Eq, Eq DataDeclaration
DataDeclaration -> DataDeclaration -> Bool
DataDeclaration -> DataDeclaration -> Ordering
DataDeclaration -> DataDeclaration -> DataDeclaration
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 :: DataDeclaration -> DataDeclaration -> DataDeclaration
$cmin :: DataDeclaration -> DataDeclaration -> DataDeclaration
max :: DataDeclaration -> DataDeclaration -> DataDeclaration
$cmax :: DataDeclaration -> DataDeclaration -> DataDeclaration
>= :: DataDeclaration -> DataDeclaration -> Bool
$c>= :: DataDeclaration -> DataDeclaration -> Bool
> :: DataDeclaration -> DataDeclaration -> Bool
$c> :: DataDeclaration -> DataDeclaration -> Bool
<= :: DataDeclaration -> DataDeclaration -> Bool
$c<= :: DataDeclaration -> DataDeclaration -> Bool
< :: DataDeclaration -> DataDeclaration -> Bool
$c< :: DataDeclaration -> DataDeclaration -> Bool
compare :: DataDeclaration -> DataDeclaration -> Ordering
$ccompare :: DataDeclaration -> DataDeclaration -> Ordering
Ord, ReadPrec [DataDeclaration]
ReadPrec DataDeclaration
Int -> ReadS DataDeclaration
ReadS [DataDeclaration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DataDeclaration]
$creadListPrec :: ReadPrec [DataDeclaration]
readPrec :: ReadPrec DataDeclaration
$creadPrec :: ReadPrec DataDeclaration
readList :: ReadS [DataDeclaration]
$creadList :: ReadS [DataDeclaration]
readsPrec :: Int -> ReadS DataDeclaration
$creadsPrec :: Int -> ReadS DataDeclaration
Read, Int -> DataDeclaration -> ShowS
[DataDeclaration] -> ShowS
DataDeclaration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataDeclaration] -> ShowS
$cshowList :: [DataDeclaration] -> ShowS
show :: DataDeclaration -> String
$cshow :: DataDeclaration -> String
showsPrec :: Int -> DataDeclaration -> ShowS
$cshowsPrec :: Int -> DataDeclaration -> ShowS
Show)

_DataDeclaration :: Name
_DataDeclaration = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.DataDeclaration")

_DataDeclaration_keyword :: FieldName
_DataDeclaration_keyword = (String -> FieldName
Core.FieldName String
"keyword")

_DataDeclaration_context :: FieldName
_DataDeclaration_context = (String -> FieldName
Core.FieldName String
"context")

_DataDeclaration_head :: FieldName
_DataDeclaration_head = (String -> FieldName
Core.FieldName String
"head")

_DataDeclaration_constructors :: FieldName
_DataDeclaration_constructors = (String -> FieldName
Core.FieldName String
"constructors")

_DataDeclaration_deriving :: FieldName
_DataDeclaration_deriving = (String -> FieldName
Core.FieldName String
"deriving")

-- | The 'data' versus 'newtype keyword
data DataDeclaration_Keyword = 
  DataDeclaration_KeywordData  |
  DataDeclaration_KeywordNewtype 
  deriving (DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
$c/= :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
== :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
$c== :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
Eq, Eq DataDeclaration_Keyword
DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
DataDeclaration_Keyword -> DataDeclaration_Keyword -> Ordering
DataDeclaration_Keyword
-> DataDeclaration_Keyword -> DataDeclaration_Keyword
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 :: DataDeclaration_Keyword
-> DataDeclaration_Keyword -> DataDeclaration_Keyword
$cmin :: DataDeclaration_Keyword
-> DataDeclaration_Keyword -> DataDeclaration_Keyword
max :: DataDeclaration_Keyword
-> DataDeclaration_Keyword -> DataDeclaration_Keyword
$cmax :: DataDeclaration_Keyword
-> DataDeclaration_Keyword -> DataDeclaration_Keyword
>= :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
$c>= :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
> :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
$c> :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
<= :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
$c<= :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
< :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
$c< :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Bool
compare :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Ordering
$ccompare :: DataDeclaration_Keyword -> DataDeclaration_Keyword -> Ordering
Ord, ReadPrec [DataDeclaration_Keyword]
ReadPrec DataDeclaration_Keyword
Int -> ReadS DataDeclaration_Keyword
ReadS [DataDeclaration_Keyword]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DataDeclaration_Keyword]
$creadListPrec :: ReadPrec [DataDeclaration_Keyword]
readPrec :: ReadPrec DataDeclaration_Keyword
$creadPrec :: ReadPrec DataDeclaration_Keyword
readList :: ReadS [DataDeclaration_Keyword]
$creadList :: ReadS [DataDeclaration_Keyword]
readsPrec :: Int -> ReadS DataDeclaration_Keyword
$creadsPrec :: Int -> ReadS DataDeclaration_Keyword
Read, Int -> DataDeclaration_Keyword -> ShowS
[DataDeclaration_Keyword] -> ShowS
DataDeclaration_Keyword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataDeclaration_Keyword] -> ShowS
$cshowList :: [DataDeclaration_Keyword] -> ShowS
show :: DataDeclaration_Keyword -> String
$cshow :: DataDeclaration_Keyword -> String
showsPrec :: Int -> DataDeclaration_Keyword -> ShowS
$cshowsPrec :: Int -> DataDeclaration_Keyword -> ShowS
Show)

_DataDeclaration_Keyword :: Name
_DataDeclaration_Keyword = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.DataDeclaration.Keyword")

_DataDeclaration_Keyword_data :: FieldName
_DataDeclaration_Keyword_data = (String -> FieldName
Core.FieldName String
"data")

_DataDeclaration_Keyword_newtype :: FieldName
_DataDeclaration_Keyword_newtype = (String -> FieldName
Core.FieldName String
"newtype")

-- | A data declaration together with any comments
data DeclarationWithComments = 
  DeclarationWithComments {
    DeclarationWithComments -> Declaration
declarationWithCommentsBody :: Declaration,
    DeclarationWithComments -> Maybe String
declarationWithCommentsComments :: (Maybe String)}
  deriving (DeclarationWithComments -> DeclarationWithComments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeclarationWithComments -> DeclarationWithComments -> Bool
$c/= :: DeclarationWithComments -> DeclarationWithComments -> Bool
== :: DeclarationWithComments -> DeclarationWithComments -> Bool
$c== :: DeclarationWithComments -> DeclarationWithComments -> Bool
Eq, Eq DeclarationWithComments
DeclarationWithComments -> DeclarationWithComments -> Bool
DeclarationWithComments -> DeclarationWithComments -> Ordering
DeclarationWithComments
-> DeclarationWithComments -> DeclarationWithComments
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 :: DeclarationWithComments
-> DeclarationWithComments -> DeclarationWithComments
$cmin :: DeclarationWithComments
-> DeclarationWithComments -> DeclarationWithComments
max :: DeclarationWithComments
-> DeclarationWithComments -> DeclarationWithComments
$cmax :: DeclarationWithComments
-> DeclarationWithComments -> DeclarationWithComments
>= :: DeclarationWithComments -> DeclarationWithComments -> Bool
$c>= :: DeclarationWithComments -> DeclarationWithComments -> Bool
> :: DeclarationWithComments -> DeclarationWithComments -> Bool
$c> :: DeclarationWithComments -> DeclarationWithComments -> Bool
<= :: DeclarationWithComments -> DeclarationWithComments -> Bool
$c<= :: DeclarationWithComments -> DeclarationWithComments -> Bool
< :: DeclarationWithComments -> DeclarationWithComments -> Bool
$c< :: DeclarationWithComments -> DeclarationWithComments -> Bool
compare :: DeclarationWithComments -> DeclarationWithComments -> Ordering
$ccompare :: DeclarationWithComments -> DeclarationWithComments -> Ordering
Ord, ReadPrec [DeclarationWithComments]
ReadPrec DeclarationWithComments
Int -> ReadS DeclarationWithComments
ReadS [DeclarationWithComments]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeclarationWithComments]
$creadListPrec :: ReadPrec [DeclarationWithComments]
readPrec :: ReadPrec DeclarationWithComments
$creadPrec :: ReadPrec DeclarationWithComments
readList :: ReadS [DeclarationWithComments]
$creadList :: ReadS [DeclarationWithComments]
readsPrec :: Int -> ReadS DeclarationWithComments
$creadsPrec :: Int -> ReadS DeclarationWithComments
Read, Int -> DeclarationWithComments -> ShowS
[DeclarationWithComments] -> ShowS
DeclarationWithComments -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeclarationWithComments] -> ShowS
$cshowList :: [DeclarationWithComments] -> ShowS
show :: DeclarationWithComments -> String
$cshow :: DeclarationWithComments -> String
showsPrec :: Int -> DeclarationWithComments -> ShowS
$cshowsPrec :: Int -> DeclarationWithComments -> ShowS
Show)

_DeclarationWithComments :: Name
_DeclarationWithComments = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.DeclarationWithComments")

_DeclarationWithComments_body :: FieldName
_DeclarationWithComments_body = (String -> FieldName
Core.FieldName String
"body")

_DeclarationWithComments_comments :: FieldName
_DeclarationWithComments_comments = (String -> FieldName
Core.FieldName String
"comments")

-- | A data or value declaration
data Declaration = 
  DeclarationData DataDeclaration |
  DeclarationType TypeDeclaration |
  DeclarationValueBinding ValueBinding |
  DeclarationTypedBinding TypedBinding
  deriving (Declaration -> Declaration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Declaration -> Declaration -> Bool
$c/= :: Declaration -> Declaration -> Bool
== :: Declaration -> Declaration -> Bool
$c== :: Declaration -> Declaration -> Bool
Eq, Eq Declaration
Declaration -> Declaration -> Bool
Declaration -> Declaration -> Ordering
Declaration -> Declaration -> Declaration
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 :: Declaration -> Declaration -> Declaration
$cmin :: Declaration -> Declaration -> Declaration
max :: Declaration -> Declaration -> Declaration
$cmax :: Declaration -> Declaration -> Declaration
>= :: Declaration -> Declaration -> Bool
$c>= :: Declaration -> Declaration -> Bool
> :: Declaration -> Declaration -> Bool
$c> :: Declaration -> Declaration -> Bool
<= :: Declaration -> Declaration -> Bool
$c<= :: Declaration -> Declaration -> Bool
< :: Declaration -> Declaration -> Bool
$c< :: Declaration -> Declaration -> Bool
compare :: Declaration -> Declaration -> Ordering
$ccompare :: Declaration -> Declaration -> Ordering
Ord, ReadPrec [Declaration]
ReadPrec Declaration
Int -> ReadS Declaration
ReadS [Declaration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Declaration]
$creadListPrec :: ReadPrec [Declaration]
readPrec :: ReadPrec Declaration
$creadPrec :: ReadPrec Declaration
readList :: ReadS [Declaration]
$creadList :: ReadS [Declaration]
readsPrec :: Int -> ReadS Declaration
$creadsPrec :: Int -> ReadS Declaration
Read, Int -> Declaration -> ShowS
[Declaration] -> ShowS
Declaration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Declaration] -> ShowS
$cshowList :: [Declaration] -> ShowS
show :: Declaration -> String
$cshow :: Declaration -> String
showsPrec :: Int -> Declaration -> ShowS
$cshowsPrec :: Int -> Declaration -> ShowS
Show)

_Declaration :: Name
_Declaration = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Declaration")

_Declaration_data :: FieldName
_Declaration_data = (String -> FieldName
Core.FieldName String
"data")

_Declaration_type :: FieldName
_Declaration_type = (String -> FieldName
Core.FieldName String
"type")

_Declaration_valueBinding :: FieldName
_Declaration_valueBinding = (String -> FieldName
Core.FieldName String
"valueBinding")

_Declaration_typedBinding :: FieldName
_Declaration_typedBinding = (String -> FieldName
Core.FieldName String
"typedBinding")

-- | The left-hand side of a declaration
data DeclarationHead = 
  DeclarationHeadApplication DeclarationHead_Application |
  DeclarationHeadParens DeclarationHead |
  DeclarationHeadSimple Name
  deriving (DeclarationHead -> DeclarationHead -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeclarationHead -> DeclarationHead -> Bool
$c/= :: DeclarationHead -> DeclarationHead -> Bool
== :: DeclarationHead -> DeclarationHead -> Bool
$c== :: DeclarationHead -> DeclarationHead -> Bool
Eq, Eq DeclarationHead
DeclarationHead -> DeclarationHead -> Bool
DeclarationHead -> DeclarationHead -> Ordering
DeclarationHead -> DeclarationHead -> DeclarationHead
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 :: DeclarationHead -> DeclarationHead -> DeclarationHead
$cmin :: DeclarationHead -> DeclarationHead -> DeclarationHead
max :: DeclarationHead -> DeclarationHead -> DeclarationHead
$cmax :: DeclarationHead -> DeclarationHead -> DeclarationHead
>= :: DeclarationHead -> DeclarationHead -> Bool
$c>= :: DeclarationHead -> DeclarationHead -> Bool
> :: DeclarationHead -> DeclarationHead -> Bool
$c> :: DeclarationHead -> DeclarationHead -> Bool
<= :: DeclarationHead -> DeclarationHead -> Bool
$c<= :: DeclarationHead -> DeclarationHead -> Bool
< :: DeclarationHead -> DeclarationHead -> Bool
$c< :: DeclarationHead -> DeclarationHead -> Bool
compare :: DeclarationHead -> DeclarationHead -> Ordering
$ccompare :: DeclarationHead -> DeclarationHead -> Ordering
Ord, ReadPrec [DeclarationHead]
ReadPrec DeclarationHead
Int -> ReadS DeclarationHead
ReadS [DeclarationHead]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeclarationHead]
$creadListPrec :: ReadPrec [DeclarationHead]
readPrec :: ReadPrec DeclarationHead
$creadPrec :: ReadPrec DeclarationHead
readList :: ReadS [DeclarationHead]
$creadList :: ReadS [DeclarationHead]
readsPrec :: Int -> ReadS DeclarationHead
$creadsPrec :: Int -> ReadS DeclarationHead
Read, Int -> DeclarationHead -> ShowS
[DeclarationHead] -> ShowS
DeclarationHead -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeclarationHead] -> ShowS
$cshowList :: [DeclarationHead] -> ShowS
show :: DeclarationHead -> String
$cshow :: DeclarationHead -> String
showsPrec :: Int -> DeclarationHead -> ShowS
$cshowsPrec :: Int -> DeclarationHead -> ShowS
Show)

_DeclarationHead :: Name
_DeclarationHead = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.DeclarationHead")

_DeclarationHead_application :: FieldName
_DeclarationHead_application = (String -> FieldName
Core.FieldName String
"application")

_DeclarationHead_parens :: FieldName
_DeclarationHead_parens = (String -> FieldName
Core.FieldName String
"parens")

_DeclarationHead_simple :: FieldName
_DeclarationHead_simple = (String -> FieldName
Core.FieldName String
"simple")

-- | An application-style declaration head
data DeclarationHead_Application = 
  DeclarationHead_Application {
    DeclarationHead_Application -> DeclarationHead
declarationHead_ApplicationFunction :: DeclarationHead,
    DeclarationHead_Application -> Variable
declarationHead_ApplicationOperand :: Variable}
  deriving (DeclarationHead_Application -> DeclarationHead_Application -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
$c/= :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
== :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
$c== :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
Eq, Eq DeclarationHead_Application
DeclarationHead_Application -> DeclarationHead_Application -> Bool
DeclarationHead_Application
-> DeclarationHead_Application -> Ordering
DeclarationHead_Application
-> DeclarationHead_Application -> DeclarationHead_Application
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 :: DeclarationHead_Application
-> DeclarationHead_Application -> DeclarationHead_Application
$cmin :: DeclarationHead_Application
-> DeclarationHead_Application -> DeclarationHead_Application
max :: DeclarationHead_Application
-> DeclarationHead_Application -> DeclarationHead_Application
$cmax :: DeclarationHead_Application
-> DeclarationHead_Application -> DeclarationHead_Application
>= :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
$c>= :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
> :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
$c> :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
<= :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
$c<= :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
< :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
$c< :: DeclarationHead_Application -> DeclarationHead_Application -> Bool
compare :: DeclarationHead_Application
-> DeclarationHead_Application -> Ordering
$ccompare :: DeclarationHead_Application
-> DeclarationHead_Application -> Ordering
Ord, ReadPrec [DeclarationHead_Application]
ReadPrec DeclarationHead_Application
Int -> ReadS DeclarationHead_Application
ReadS [DeclarationHead_Application]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeclarationHead_Application]
$creadListPrec :: ReadPrec [DeclarationHead_Application]
readPrec :: ReadPrec DeclarationHead_Application
$creadPrec :: ReadPrec DeclarationHead_Application
readList :: ReadS [DeclarationHead_Application]
$creadList :: ReadS [DeclarationHead_Application]
readsPrec :: Int -> ReadS DeclarationHead_Application
$creadsPrec :: Int -> ReadS DeclarationHead_Application
Read, Int -> DeclarationHead_Application -> ShowS
[DeclarationHead_Application] -> ShowS
DeclarationHead_Application -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeclarationHead_Application] -> ShowS
$cshowList :: [DeclarationHead_Application] -> ShowS
show :: DeclarationHead_Application -> String
$cshow :: DeclarationHead_Application -> String
showsPrec :: Int -> DeclarationHead_Application -> ShowS
$cshowsPrec :: Int -> DeclarationHead_Application -> ShowS
Show)

_DeclarationHead_Application :: Name
_DeclarationHead_Application = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.DeclarationHead.Application")

_DeclarationHead_Application_function :: FieldName
_DeclarationHead_Application_function = (String -> FieldName
Core.FieldName String
"function")

_DeclarationHead_Application_operand :: FieldName
_DeclarationHead_Application_operand = (String -> FieldName
Core.FieldName String
"operand")

-- | A 'deriving' statement
newtype Deriving = 
  Deriving {
    -- | A 'deriving' statement
    Deriving -> [Name]
unDeriving :: [Name]}
  deriving (Deriving -> Deriving -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Deriving -> Deriving -> Bool
$c/= :: Deriving -> Deriving -> Bool
== :: Deriving -> Deriving -> Bool
$c== :: Deriving -> Deriving -> Bool
Eq, Eq Deriving
Deriving -> Deriving -> Bool
Deriving -> Deriving -> Ordering
Deriving -> Deriving -> Deriving
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 :: Deriving -> Deriving -> Deriving
$cmin :: Deriving -> Deriving -> Deriving
max :: Deriving -> Deriving -> Deriving
$cmax :: Deriving -> Deriving -> Deriving
>= :: Deriving -> Deriving -> Bool
$c>= :: Deriving -> Deriving -> Bool
> :: Deriving -> Deriving -> Bool
$c> :: Deriving -> Deriving -> Bool
<= :: Deriving -> Deriving -> Bool
$c<= :: Deriving -> Deriving -> Bool
< :: Deriving -> Deriving -> Bool
$c< :: Deriving -> Deriving -> Bool
compare :: Deriving -> Deriving -> Ordering
$ccompare :: Deriving -> Deriving -> Ordering
Ord, ReadPrec [Deriving]
ReadPrec Deriving
Int -> ReadS Deriving
ReadS [Deriving]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Deriving]
$creadListPrec :: ReadPrec [Deriving]
readPrec :: ReadPrec Deriving
$creadPrec :: ReadPrec Deriving
readList :: ReadS [Deriving]
$creadList :: ReadS [Deriving]
readsPrec :: Int -> ReadS Deriving
$creadsPrec :: Int -> ReadS Deriving
Read, Int -> Deriving -> ShowS
[Deriving] -> ShowS
Deriving -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Deriving] -> ShowS
$cshowList :: [Deriving] -> ShowS
show :: Deriving -> String
$cshow :: Deriving -> String
showsPrec :: Int -> Deriving -> ShowS
$cshowsPrec :: Int -> Deriving -> ShowS
Show)

_Deriving :: Name
_Deriving = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Deriving")

-- | An export statement
data Export = 
  ExportDeclaration ImportExportSpec |
  ExportModule ModuleName
  deriving (Export -> Export -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Export -> Export -> Bool
$c/= :: Export -> Export -> Bool
== :: Export -> Export -> Bool
$c== :: Export -> Export -> Bool
Eq, Eq Export
Export -> Export -> Bool
Export -> Export -> Ordering
Export -> Export -> Export
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 :: Export -> Export -> Export
$cmin :: Export -> Export -> Export
max :: Export -> Export -> Export
$cmax :: Export -> Export -> Export
>= :: Export -> Export -> Bool
$c>= :: Export -> Export -> Bool
> :: Export -> Export -> Bool
$c> :: Export -> Export -> Bool
<= :: Export -> Export -> Bool
$c<= :: Export -> Export -> Bool
< :: Export -> Export -> Bool
$c< :: Export -> Export -> Bool
compare :: Export -> Export -> Ordering
$ccompare :: Export -> Export -> Ordering
Ord, ReadPrec [Export]
ReadPrec Export
Int -> ReadS Export
ReadS [Export]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Export]
$creadListPrec :: ReadPrec [Export]
readPrec :: ReadPrec Export
$creadPrec :: ReadPrec Export
readList :: ReadS [Export]
$creadList :: ReadS [Export]
readsPrec :: Int -> ReadS Export
$creadsPrec :: Int -> ReadS Export
Read, Int -> Export -> ShowS
[Export] -> ShowS
Export -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Export] -> ShowS
$cshowList :: [Export] -> ShowS
show :: Export -> String
$cshow :: Export -> String
showsPrec :: Int -> Export -> ShowS
$cshowsPrec :: Int -> Export -> ShowS
Show)

_Export :: Name
_Export = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Export")

_Export_declaration :: FieldName
_Export_declaration = (String -> FieldName
Core.FieldName String
"declaration")

_Export_module :: FieldName
_Export_module = (String -> FieldName
Core.FieldName String
"module")

-- | A data expression
data Expression = 
  ExpressionApplication Expression_Application |
  ExpressionCase Expression_Case |
  ExpressionConstructRecord Expression_ConstructRecord |
  ExpressionDo [Statement] |
  ExpressionIf Expression_If |
  ExpressionInfixApplication Expression_InfixApplication |
  ExpressionLiteral Literal |
  ExpressionLambda Expression_Lambda |
  ExpressionLeftSection Expression_Section |
  ExpressionLet Expression_Let |
  ExpressionList [Expression] |
  ExpressionParens Expression |
  ExpressionPrefixApplication Expression_PrefixApplication |
  ExpressionRightSection Expression_Section |
  ExpressionTuple [Expression] |
  ExpressionTypeSignature Expression_TypeSignature |
  ExpressionUpdateRecord Expression_UpdateRecord |
  ExpressionVariable Name
  deriving (Expression -> Expression -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c== :: Expression -> Expression -> Bool
Eq, Eq Expression
Expression -> Expression -> Bool
Expression -> Expression -> Ordering
Expression -> Expression -> Expression
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 :: Expression -> Expression -> Expression
$cmin :: Expression -> Expression -> Expression
max :: Expression -> Expression -> Expression
$cmax :: Expression -> Expression -> Expression
>= :: Expression -> Expression -> Bool
$c>= :: Expression -> Expression -> Bool
> :: Expression -> Expression -> Bool
$c> :: Expression -> Expression -> Bool
<= :: Expression -> Expression -> Bool
$c<= :: Expression -> Expression -> Bool
< :: Expression -> Expression -> Bool
$c< :: Expression -> Expression -> Bool
compare :: Expression -> Expression -> Ordering
$ccompare :: Expression -> Expression -> Ordering
Ord, ReadPrec [Expression]
ReadPrec Expression
Int -> ReadS Expression
ReadS [Expression]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression]
$creadListPrec :: ReadPrec [Expression]
readPrec :: ReadPrec Expression
$creadPrec :: ReadPrec Expression
readList :: ReadS [Expression]
$creadList :: ReadS [Expression]
readsPrec :: Int -> ReadS Expression
$creadsPrec :: Int -> ReadS Expression
Read, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression] -> ShowS
$cshowList :: [Expression] -> ShowS
show :: Expression -> String
$cshow :: Expression -> String
showsPrec :: Int -> Expression -> ShowS
$cshowsPrec :: Int -> Expression -> ShowS
Show)

_Expression :: Name
_Expression = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression")

_Expression_application :: FieldName
_Expression_application = (String -> FieldName
Core.FieldName String
"application")

_Expression_case :: FieldName
_Expression_case = (String -> FieldName
Core.FieldName String
"case")

_Expression_constructRecord :: FieldName
_Expression_constructRecord = (String -> FieldName
Core.FieldName String
"constructRecord")

_Expression_do :: FieldName
_Expression_do = (String -> FieldName
Core.FieldName String
"do")

_Expression_if :: FieldName
_Expression_if = (String -> FieldName
Core.FieldName String
"if")

_Expression_infixApplication :: FieldName
_Expression_infixApplication = (String -> FieldName
Core.FieldName String
"infixApplication")

_Expression_literal :: FieldName
_Expression_literal = (String -> FieldName
Core.FieldName String
"literal")

_Expression_lambda :: FieldName
_Expression_lambda = (String -> FieldName
Core.FieldName String
"lambda")

_Expression_leftSection :: FieldName
_Expression_leftSection = (String -> FieldName
Core.FieldName String
"leftSection")

_Expression_let :: FieldName
_Expression_let = (String -> FieldName
Core.FieldName String
"let")

_Expression_list :: FieldName
_Expression_list = (String -> FieldName
Core.FieldName String
"list")

_Expression_parens :: FieldName
_Expression_parens = (String -> FieldName
Core.FieldName String
"parens")

_Expression_prefixApplication :: FieldName
_Expression_prefixApplication = (String -> FieldName
Core.FieldName String
"prefixApplication")

_Expression_rightSection :: FieldName
_Expression_rightSection = (String -> FieldName
Core.FieldName String
"rightSection")

_Expression_tuple :: FieldName
_Expression_tuple = (String -> FieldName
Core.FieldName String
"tuple")

_Expression_typeSignature :: FieldName
_Expression_typeSignature = (String -> FieldName
Core.FieldName String
"typeSignature")

_Expression_updateRecord :: FieldName
_Expression_updateRecord = (String -> FieldName
Core.FieldName String
"updateRecord")

_Expression_variable :: FieldName
_Expression_variable = (String -> FieldName
Core.FieldName String
"variable")

-- | An application expression
data Expression_Application = 
  Expression_Application {
    Expression_Application -> Expression
expression_ApplicationFunction :: Expression,
    Expression_Application -> Expression
expression_ApplicationArgument :: Expression}
  deriving (Expression_Application -> Expression_Application -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression_Application -> Expression_Application -> Bool
$c/= :: Expression_Application -> Expression_Application -> Bool
== :: Expression_Application -> Expression_Application -> Bool
$c== :: Expression_Application -> Expression_Application -> Bool
Eq, Eq Expression_Application
Expression_Application -> Expression_Application -> Bool
Expression_Application -> Expression_Application -> Ordering
Expression_Application
-> Expression_Application -> Expression_Application
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 :: Expression_Application
-> Expression_Application -> Expression_Application
$cmin :: Expression_Application
-> Expression_Application -> Expression_Application
max :: Expression_Application
-> Expression_Application -> Expression_Application
$cmax :: Expression_Application
-> Expression_Application -> Expression_Application
>= :: Expression_Application -> Expression_Application -> Bool
$c>= :: Expression_Application -> Expression_Application -> Bool
> :: Expression_Application -> Expression_Application -> Bool
$c> :: Expression_Application -> Expression_Application -> Bool
<= :: Expression_Application -> Expression_Application -> Bool
$c<= :: Expression_Application -> Expression_Application -> Bool
< :: Expression_Application -> Expression_Application -> Bool
$c< :: Expression_Application -> Expression_Application -> Bool
compare :: Expression_Application -> Expression_Application -> Ordering
$ccompare :: Expression_Application -> Expression_Application -> Ordering
Ord, ReadPrec [Expression_Application]
ReadPrec Expression_Application
Int -> ReadS Expression_Application
ReadS [Expression_Application]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression_Application]
$creadListPrec :: ReadPrec [Expression_Application]
readPrec :: ReadPrec Expression_Application
$creadPrec :: ReadPrec Expression_Application
readList :: ReadS [Expression_Application]
$creadList :: ReadS [Expression_Application]
readsPrec :: Int -> ReadS Expression_Application
$creadsPrec :: Int -> ReadS Expression_Application
Read, Int -> Expression_Application -> ShowS
[Expression_Application] -> ShowS
Expression_Application -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression_Application] -> ShowS
$cshowList :: [Expression_Application] -> ShowS
show :: Expression_Application -> String
$cshow :: Expression_Application -> String
showsPrec :: Int -> Expression_Application -> ShowS
$cshowsPrec :: Int -> Expression_Application -> ShowS
Show)

_Expression_Application :: Name
_Expression_Application = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression.Application")

_Expression_Application_function :: FieldName
_Expression_Application_function = (String -> FieldName
Core.FieldName String
"function")

_Expression_Application_argument :: FieldName
_Expression_Application_argument = (String -> FieldName
Core.FieldName String
"argument")

-- | A case expression
data Expression_Case = 
  Expression_Case {
    Expression_Case -> Expression
expression_CaseCase :: Expression,
    Expression_Case -> [Alternative]
expression_CaseAlternatives :: [Alternative]}
  deriving (Expression_Case -> Expression_Case -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression_Case -> Expression_Case -> Bool
$c/= :: Expression_Case -> Expression_Case -> Bool
== :: Expression_Case -> Expression_Case -> Bool
$c== :: Expression_Case -> Expression_Case -> Bool
Eq, Eq Expression_Case
Expression_Case -> Expression_Case -> Bool
Expression_Case -> Expression_Case -> Ordering
Expression_Case -> Expression_Case -> Expression_Case
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 :: Expression_Case -> Expression_Case -> Expression_Case
$cmin :: Expression_Case -> Expression_Case -> Expression_Case
max :: Expression_Case -> Expression_Case -> Expression_Case
$cmax :: Expression_Case -> Expression_Case -> Expression_Case
>= :: Expression_Case -> Expression_Case -> Bool
$c>= :: Expression_Case -> Expression_Case -> Bool
> :: Expression_Case -> Expression_Case -> Bool
$c> :: Expression_Case -> Expression_Case -> Bool
<= :: Expression_Case -> Expression_Case -> Bool
$c<= :: Expression_Case -> Expression_Case -> Bool
< :: Expression_Case -> Expression_Case -> Bool
$c< :: Expression_Case -> Expression_Case -> Bool
compare :: Expression_Case -> Expression_Case -> Ordering
$ccompare :: Expression_Case -> Expression_Case -> Ordering
Ord, ReadPrec [Expression_Case]
ReadPrec Expression_Case
Int -> ReadS Expression_Case
ReadS [Expression_Case]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression_Case]
$creadListPrec :: ReadPrec [Expression_Case]
readPrec :: ReadPrec Expression_Case
$creadPrec :: ReadPrec Expression_Case
readList :: ReadS [Expression_Case]
$creadList :: ReadS [Expression_Case]
readsPrec :: Int -> ReadS Expression_Case
$creadsPrec :: Int -> ReadS Expression_Case
Read, Int -> Expression_Case -> ShowS
[Expression_Case] -> ShowS
Expression_Case -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression_Case] -> ShowS
$cshowList :: [Expression_Case] -> ShowS
show :: Expression_Case -> String
$cshow :: Expression_Case -> String
showsPrec :: Int -> Expression_Case -> ShowS
$cshowsPrec :: Int -> Expression_Case -> ShowS
Show)

_Expression_Case :: Name
_Expression_Case = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression.Case")

_Expression_Case_case :: FieldName
_Expression_Case_case = (String -> FieldName
Core.FieldName String
"case")

_Expression_Case_alternatives :: FieldName
_Expression_Case_alternatives = (String -> FieldName
Core.FieldName String
"alternatives")

-- | A record constructor expression
data Expression_ConstructRecord = 
  Expression_ConstructRecord {
    Expression_ConstructRecord -> Name
expression_ConstructRecordName :: Name,
    Expression_ConstructRecord -> [FieldUpdate]
expression_ConstructRecordFields :: [FieldUpdate]}
  deriving (Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
$c/= :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
== :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
$c== :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
Eq, Eq Expression_ConstructRecord
Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
Expression_ConstructRecord
-> Expression_ConstructRecord -> Ordering
Expression_ConstructRecord
-> Expression_ConstructRecord -> Expression_ConstructRecord
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 :: Expression_ConstructRecord
-> Expression_ConstructRecord -> Expression_ConstructRecord
$cmin :: Expression_ConstructRecord
-> Expression_ConstructRecord -> Expression_ConstructRecord
max :: Expression_ConstructRecord
-> Expression_ConstructRecord -> Expression_ConstructRecord
$cmax :: Expression_ConstructRecord
-> Expression_ConstructRecord -> Expression_ConstructRecord
>= :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
$c>= :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
> :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
$c> :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
<= :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
$c<= :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
< :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
$c< :: Expression_ConstructRecord -> Expression_ConstructRecord -> Bool
compare :: Expression_ConstructRecord
-> Expression_ConstructRecord -> Ordering
$ccompare :: Expression_ConstructRecord
-> Expression_ConstructRecord -> Ordering
Ord, ReadPrec [Expression_ConstructRecord]
ReadPrec Expression_ConstructRecord
Int -> ReadS Expression_ConstructRecord
ReadS [Expression_ConstructRecord]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression_ConstructRecord]
$creadListPrec :: ReadPrec [Expression_ConstructRecord]
readPrec :: ReadPrec Expression_ConstructRecord
$creadPrec :: ReadPrec Expression_ConstructRecord
readList :: ReadS [Expression_ConstructRecord]
$creadList :: ReadS [Expression_ConstructRecord]
readsPrec :: Int -> ReadS Expression_ConstructRecord
$creadsPrec :: Int -> ReadS Expression_ConstructRecord
Read, Int -> Expression_ConstructRecord -> ShowS
[Expression_ConstructRecord] -> ShowS
Expression_ConstructRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression_ConstructRecord] -> ShowS
$cshowList :: [Expression_ConstructRecord] -> ShowS
show :: Expression_ConstructRecord -> String
$cshow :: Expression_ConstructRecord -> String
showsPrec :: Int -> Expression_ConstructRecord -> ShowS
$cshowsPrec :: Int -> Expression_ConstructRecord -> ShowS
Show)

_Expression_ConstructRecord :: Name
_Expression_ConstructRecord = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression.ConstructRecord")

_Expression_ConstructRecord_name :: FieldName
_Expression_ConstructRecord_name = (String -> FieldName
Core.FieldName String
"name")

_Expression_ConstructRecord_fields :: FieldName
_Expression_ConstructRecord_fields = (String -> FieldName
Core.FieldName String
"fields")

-- | An 'if' expression
data Expression_If = 
  Expression_If {
    Expression_If -> Expression
expression_IfCondition :: Expression,
    Expression_If -> Expression
expression_IfThen :: Expression,
    Expression_If -> Expression
expression_IfElse :: Expression}
  deriving (Expression_If -> Expression_If -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression_If -> Expression_If -> Bool
$c/= :: Expression_If -> Expression_If -> Bool
== :: Expression_If -> Expression_If -> Bool
$c== :: Expression_If -> Expression_If -> Bool
Eq, Eq Expression_If
Expression_If -> Expression_If -> Bool
Expression_If -> Expression_If -> Ordering
Expression_If -> Expression_If -> Expression_If
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 :: Expression_If -> Expression_If -> Expression_If
$cmin :: Expression_If -> Expression_If -> Expression_If
max :: Expression_If -> Expression_If -> Expression_If
$cmax :: Expression_If -> Expression_If -> Expression_If
>= :: Expression_If -> Expression_If -> Bool
$c>= :: Expression_If -> Expression_If -> Bool
> :: Expression_If -> Expression_If -> Bool
$c> :: Expression_If -> Expression_If -> Bool
<= :: Expression_If -> Expression_If -> Bool
$c<= :: Expression_If -> Expression_If -> Bool
< :: Expression_If -> Expression_If -> Bool
$c< :: Expression_If -> Expression_If -> Bool
compare :: Expression_If -> Expression_If -> Ordering
$ccompare :: Expression_If -> Expression_If -> Ordering
Ord, ReadPrec [Expression_If]
ReadPrec Expression_If
Int -> ReadS Expression_If
ReadS [Expression_If]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression_If]
$creadListPrec :: ReadPrec [Expression_If]
readPrec :: ReadPrec Expression_If
$creadPrec :: ReadPrec Expression_If
readList :: ReadS [Expression_If]
$creadList :: ReadS [Expression_If]
readsPrec :: Int -> ReadS Expression_If
$creadsPrec :: Int -> ReadS Expression_If
Read, Int -> Expression_If -> ShowS
[Expression_If] -> ShowS
Expression_If -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression_If] -> ShowS
$cshowList :: [Expression_If] -> ShowS
show :: Expression_If -> String
$cshow :: Expression_If -> String
showsPrec :: Int -> Expression_If -> ShowS
$cshowsPrec :: Int -> Expression_If -> ShowS
Show)

_Expression_If :: Name
_Expression_If = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression.If")

_Expression_If_condition :: FieldName
_Expression_If_condition = (String -> FieldName
Core.FieldName String
"condition")

_Expression_If_then :: FieldName
_Expression_If_then = (String -> FieldName
Core.FieldName String
"then")

_Expression_If_else :: FieldName
_Expression_If_else = (String -> FieldName
Core.FieldName String
"else")

-- | An infix application expression
data Expression_InfixApplication = 
  Expression_InfixApplication {
    Expression_InfixApplication -> Expression
expression_InfixApplicationLhs :: Expression,
    Expression_InfixApplication -> Operator
expression_InfixApplicationOperator :: Operator,
    Expression_InfixApplication -> Expression
expression_InfixApplicationRhs :: Expression}
  deriving (Expression_InfixApplication -> Expression_InfixApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
$c/= :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
== :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
$c== :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
Eq, Eq Expression_InfixApplication
Expression_InfixApplication -> Expression_InfixApplication -> Bool
Expression_InfixApplication
-> Expression_InfixApplication -> Ordering
Expression_InfixApplication
-> Expression_InfixApplication -> Expression_InfixApplication
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 :: Expression_InfixApplication
-> Expression_InfixApplication -> Expression_InfixApplication
$cmin :: Expression_InfixApplication
-> Expression_InfixApplication -> Expression_InfixApplication
max :: Expression_InfixApplication
-> Expression_InfixApplication -> Expression_InfixApplication
$cmax :: Expression_InfixApplication
-> Expression_InfixApplication -> Expression_InfixApplication
>= :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
$c>= :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
> :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
$c> :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
<= :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
$c<= :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
< :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
$c< :: Expression_InfixApplication -> Expression_InfixApplication -> Bool
compare :: Expression_InfixApplication
-> Expression_InfixApplication -> Ordering
$ccompare :: Expression_InfixApplication
-> Expression_InfixApplication -> Ordering
Ord, ReadPrec [Expression_InfixApplication]
ReadPrec Expression_InfixApplication
Int -> ReadS Expression_InfixApplication
ReadS [Expression_InfixApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression_InfixApplication]
$creadListPrec :: ReadPrec [Expression_InfixApplication]
readPrec :: ReadPrec Expression_InfixApplication
$creadPrec :: ReadPrec Expression_InfixApplication
readList :: ReadS [Expression_InfixApplication]
$creadList :: ReadS [Expression_InfixApplication]
readsPrec :: Int -> ReadS Expression_InfixApplication
$creadsPrec :: Int -> ReadS Expression_InfixApplication
Read, Int -> Expression_InfixApplication -> ShowS
[Expression_InfixApplication] -> ShowS
Expression_InfixApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression_InfixApplication] -> ShowS
$cshowList :: [Expression_InfixApplication] -> ShowS
show :: Expression_InfixApplication -> String
$cshow :: Expression_InfixApplication -> String
showsPrec :: Int -> Expression_InfixApplication -> ShowS
$cshowsPrec :: Int -> Expression_InfixApplication -> ShowS
Show)

_Expression_InfixApplication :: Name
_Expression_InfixApplication = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression.InfixApplication")

_Expression_InfixApplication_lhs :: FieldName
_Expression_InfixApplication_lhs = (String -> FieldName
Core.FieldName String
"lhs")

_Expression_InfixApplication_operator :: FieldName
_Expression_InfixApplication_operator = (String -> FieldName
Core.FieldName String
"operator")

_Expression_InfixApplication_rhs :: FieldName
_Expression_InfixApplication_rhs = (String -> FieldName
Core.FieldName String
"rhs")

-- | A lambda expression
data Expression_Lambda = 
  Expression_Lambda {
    Expression_Lambda -> [Pattern]
expression_LambdaBindings :: [Pattern],
    Expression_Lambda -> Expression
expression_LambdaInner :: Expression}
  deriving (Expression_Lambda -> Expression_Lambda -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression_Lambda -> Expression_Lambda -> Bool
$c/= :: Expression_Lambda -> Expression_Lambda -> Bool
== :: Expression_Lambda -> Expression_Lambda -> Bool
$c== :: Expression_Lambda -> Expression_Lambda -> Bool
Eq, Eq Expression_Lambda
Expression_Lambda -> Expression_Lambda -> Bool
Expression_Lambda -> Expression_Lambda -> Ordering
Expression_Lambda -> Expression_Lambda -> Expression_Lambda
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 :: Expression_Lambda -> Expression_Lambda -> Expression_Lambda
$cmin :: Expression_Lambda -> Expression_Lambda -> Expression_Lambda
max :: Expression_Lambda -> Expression_Lambda -> Expression_Lambda
$cmax :: Expression_Lambda -> Expression_Lambda -> Expression_Lambda
>= :: Expression_Lambda -> Expression_Lambda -> Bool
$c>= :: Expression_Lambda -> Expression_Lambda -> Bool
> :: Expression_Lambda -> Expression_Lambda -> Bool
$c> :: Expression_Lambda -> Expression_Lambda -> Bool
<= :: Expression_Lambda -> Expression_Lambda -> Bool
$c<= :: Expression_Lambda -> Expression_Lambda -> Bool
< :: Expression_Lambda -> Expression_Lambda -> Bool
$c< :: Expression_Lambda -> Expression_Lambda -> Bool
compare :: Expression_Lambda -> Expression_Lambda -> Ordering
$ccompare :: Expression_Lambda -> Expression_Lambda -> Ordering
Ord, ReadPrec [Expression_Lambda]
ReadPrec Expression_Lambda
Int -> ReadS Expression_Lambda
ReadS [Expression_Lambda]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression_Lambda]
$creadListPrec :: ReadPrec [Expression_Lambda]
readPrec :: ReadPrec Expression_Lambda
$creadPrec :: ReadPrec Expression_Lambda
readList :: ReadS [Expression_Lambda]
$creadList :: ReadS [Expression_Lambda]
readsPrec :: Int -> ReadS Expression_Lambda
$creadsPrec :: Int -> ReadS Expression_Lambda
Read, Int -> Expression_Lambda -> ShowS
[Expression_Lambda] -> ShowS
Expression_Lambda -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression_Lambda] -> ShowS
$cshowList :: [Expression_Lambda] -> ShowS
show :: Expression_Lambda -> String
$cshow :: Expression_Lambda -> String
showsPrec :: Int -> Expression_Lambda -> ShowS
$cshowsPrec :: Int -> Expression_Lambda -> ShowS
Show)

_Expression_Lambda :: Name
_Expression_Lambda = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression.Lambda")

_Expression_Lambda_bindings :: FieldName
_Expression_Lambda_bindings = (String -> FieldName
Core.FieldName String
"bindings")

_Expression_Lambda_inner :: FieldName
_Expression_Lambda_inner = (String -> FieldName
Core.FieldName String
"inner")

-- | A 'let' expression
data Expression_Let = 
  Expression_Let {
    Expression_Let -> [Pattern]
expression_LetBindings :: [Pattern],
    Expression_Let -> Expression
expression_LetInner :: Expression}
  deriving (Expression_Let -> Expression_Let -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression_Let -> Expression_Let -> Bool
$c/= :: Expression_Let -> Expression_Let -> Bool
== :: Expression_Let -> Expression_Let -> Bool
$c== :: Expression_Let -> Expression_Let -> Bool
Eq, Eq Expression_Let
Expression_Let -> Expression_Let -> Bool
Expression_Let -> Expression_Let -> Ordering
Expression_Let -> Expression_Let -> Expression_Let
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 :: Expression_Let -> Expression_Let -> Expression_Let
$cmin :: Expression_Let -> Expression_Let -> Expression_Let
max :: Expression_Let -> Expression_Let -> Expression_Let
$cmax :: Expression_Let -> Expression_Let -> Expression_Let
>= :: Expression_Let -> Expression_Let -> Bool
$c>= :: Expression_Let -> Expression_Let -> Bool
> :: Expression_Let -> Expression_Let -> Bool
$c> :: Expression_Let -> Expression_Let -> Bool
<= :: Expression_Let -> Expression_Let -> Bool
$c<= :: Expression_Let -> Expression_Let -> Bool
< :: Expression_Let -> Expression_Let -> Bool
$c< :: Expression_Let -> Expression_Let -> Bool
compare :: Expression_Let -> Expression_Let -> Ordering
$ccompare :: Expression_Let -> Expression_Let -> Ordering
Ord, ReadPrec [Expression_Let]
ReadPrec Expression_Let
Int -> ReadS Expression_Let
ReadS [Expression_Let]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression_Let]
$creadListPrec :: ReadPrec [Expression_Let]
readPrec :: ReadPrec Expression_Let
$creadPrec :: ReadPrec Expression_Let
readList :: ReadS [Expression_Let]
$creadList :: ReadS [Expression_Let]
readsPrec :: Int -> ReadS Expression_Let
$creadsPrec :: Int -> ReadS Expression_Let
Read, Int -> Expression_Let -> ShowS
[Expression_Let] -> ShowS
Expression_Let -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression_Let] -> ShowS
$cshowList :: [Expression_Let] -> ShowS
show :: Expression_Let -> String
$cshow :: Expression_Let -> String
showsPrec :: Int -> Expression_Let -> ShowS
$cshowsPrec :: Int -> Expression_Let -> ShowS
Show)

_Expression_Let :: Name
_Expression_Let = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression.Let")

_Expression_Let_bindings :: FieldName
_Expression_Let_bindings = (String -> FieldName
Core.FieldName String
"bindings")

_Expression_Let_inner :: FieldName
_Expression_Let_inner = (String -> FieldName
Core.FieldName String
"inner")

-- | A prefix expression
data Expression_PrefixApplication = 
  Expression_PrefixApplication {
    Expression_PrefixApplication -> Operator
expression_PrefixApplicationOperator :: Operator,
    Expression_PrefixApplication -> Expression
expression_PrefixApplicationRhs :: Expression}
  deriving (Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
$c/= :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
== :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
$c== :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
Eq, Eq Expression_PrefixApplication
Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
Expression_PrefixApplication
-> Expression_PrefixApplication -> Ordering
Expression_PrefixApplication
-> Expression_PrefixApplication -> Expression_PrefixApplication
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 :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Expression_PrefixApplication
$cmin :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Expression_PrefixApplication
max :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Expression_PrefixApplication
$cmax :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Expression_PrefixApplication
>= :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
$c>= :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
> :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
$c> :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
<= :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
$c<= :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
< :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
$c< :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Bool
compare :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Ordering
$ccompare :: Expression_PrefixApplication
-> Expression_PrefixApplication -> Ordering
Ord, ReadPrec [Expression_PrefixApplication]
ReadPrec Expression_PrefixApplication
Int -> ReadS Expression_PrefixApplication
ReadS [Expression_PrefixApplication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression_PrefixApplication]
$creadListPrec :: ReadPrec [Expression_PrefixApplication]
readPrec :: ReadPrec Expression_PrefixApplication
$creadPrec :: ReadPrec Expression_PrefixApplication
readList :: ReadS [Expression_PrefixApplication]
$creadList :: ReadS [Expression_PrefixApplication]
readsPrec :: Int -> ReadS Expression_PrefixApplication
$creadsPrec :: Int -> ReadS Expression_PrefixApplication
Read, Int -> Expression_PrefixApplication -> ShowS
[Expression_PrefixApplication] -> ShowS
Expression_PrefixApplication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression_PrefixApplication] -> ShowS
$cshowList :: [Expression_PrefixApplication] -> ShowS
show :: Expression_PrefixApplication -> String
$cshow :: Expression_PrefixApplication -> String
showsPrec :: Int -> Expression_PrefixApplication -> ShowS
$cshowsPrec :: Int -> Expression_PrefixApplication -> ShowS
Show)

_Expression_PrefixApplication :: Name
_Expression_PrefixApplication = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression.PrefixApplication")

_Expression_PrefixApplication_operator :: FieldName
_Expression_PrefixApplication_operator = (String -> FieldName
Core.FieldName String
"operator")

_Expression_PrefixApplication_rhs :: FieldName
_Expression_PrefixApplication_rhs = (String -> FieldName
Core.FieldName String
"rhs")

-- | A section expression
data Expression_Section = 
  Expression_Section {
    Expression_Section -> Operator
expression_SectionOperator :: Operator,
    Expression_Section -> Expression
expression_SectionExpression :: Expression}
  deriving (Expression_Section -> Expression_Section -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression_Section -> Expression_Section -> Bool
$c/= :: Expression_Section -> Expression_Section -> Bool
== :: Expression_Section -> Expression_Section -> Bool
$c== :: Expression_Section -> Expression_Section -> Bool
Eq, Eq Expression_Section
Expression_Section -> Expression_Section -> Bool
Expression_Section -> Expression_Section -> Ordering
Expression_Section -> Expression_Section -> Expression_Section
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 :: Expression_Section -> Expression_Section -> Expression_Section
$cmin :: Expression_Section -> Expression_Section -> Expression_Section
max :: Expression_Section -> Expression_Section -> Expression_Section
$cmax :: Expression_Section -> Expression_Section -> Expression_Section
>= :: Expression_Section -> Expression_Section -> Bool
$c>= :: Expression_Section -> Expression_Section -> Bool
> :: Expression_Section -> Expression_Section -> Bool
$c> :: Expression_Section -> Expression_Section -> Bool
<= :: Expression_Section -> Expression_Section -> Bool
$c<= :: Expression_Section -> Expression_Section -> Bool
< :: Expression_Section -> Expression_Section -> Bool
$c< :: Expression_Section -> Expression_Section -> Bool
compare :: Expression_Section -> Expression_Section -> Ordering
$ccompare :: Expression_Section -> Expression_Section -> Ordering
Ord, ReadPrec [Expression_Section]
ReadPrec Expression_Section
Int -> ReadS Expression_Section
ReadS [Expression_Section]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression_Section]
$creadListPrec :: ReadPrec [Expression_Section]
readPrec :: ReadPrec Expression_Section
$creadPrec :: ReadPrec Expression_Section
readList :: ReadS [Expression_Section]
$creadList :: ReadS [Expression_Section]
readsPrec :: Int -> ReadS Expression_Section
$creadsPrec :: Int -> ReadS Expression_Section
Read, Int -> Expression_Section -> ShowS
[Expression_Section] -> ShowS
Expression_Section -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression_Section] -> ShowS
$cshowList :: [Expression_Section] -> ShowS
show :: Expression_Section -> String
$cshow :: Expression_Section -> String
showsPrec :: Int -> Expression_Section -> ShowS
$cshowsPrec :: Int -> Expression_Section -> ShowS
Show)

_Expression_Section :: Name
_Expression_Section = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression.Section")

_Expression_Section_operator :: FieldName
_Expression_Section_operator = (String -> FieldName
Core.FieldName String
"operator")

_Expression_Section_expression :: FieldName
_Expression_Section_expression = (String -> FieldName
Core.FieldName String
"expression")

-- | A type signature expression
data Expression_TypeSignature = 
  Expression_TypeSignature {
    Expression_TypeSignature -> Expression
expression_TypeSignatureInner :: Expression,
    Expression_TypeSignature -> Type
expression_TypeSignatureType :: Type}
  deriving (Expression_TypeSignature -> Expression_TypeSignature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
$c/= :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
== :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
$c== :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
Eq, Eq Expression_TypeSignature
Expression_TypeSignature -> Expression_TypeSignature -> Bool
Expression_TypeSignature -> Expression_TypeSignature -> Ordering
Expression_TypeSignature
-> Expression_TypeSignature -> Expression_TypeSignature
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 :: Expression_TypeSignature
-> Expression_TypeSignature -> Expression_TypeSignature
$cmin :: Expression_TypeSignature
-> Expression_TypeSignature -> Expression_TypeSignature
max :: Expression_TypeSignature
-> Expression_TypeSignature -> Expression_TypeSignature
$cmax :: Expression_TypeSignature
-> Expression_TypeSignature -> Expression_TypeSignature
>= :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
$c>= :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
> :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
$c> :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
<= :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
$c<= :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
< :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
$c< :: Expression_TypeSignature -> Expression_TypeSignature -> Bool
compare :: Expression_TypeSignature -> Expression_TypeSignature -> Ordering
$ccompare :: Expression_TypeSignature -> Expression_TypeSignature -> Ordering
Ord, ReadPrec [Expression_TypeSignature]
ReadPrec Expression_TypeSignature
Int -> ReadS Expression_TypeSignature
ReadS [Expression_TypeSignature]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression_TypeSignature]
$creadListPrec :: ReadPrec [Expression_TypeSignature]
readPrec :: ReadPrec Expression_TypeSignature
$creadPrec :: ReadPrec Expression_TypeSignature
readList :: ReadS [Expression_TypeSignature]
$creadList :: ReadS [Expression_TypeSignature]
readsPrec :: Int -> ReadS Expression_TypeSignature
$creadsPrec :: Int -> ReadS Expression_TypeSignature
Read, Int -> Expression_TypeSignature -> ShowS
[Expression_TypeSignature] -> ShowS
Expression_TypeSignature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression_TypeSignature] -> ShowS
$cshowList :: [Expression_TypeSignature] -> ShowS
show :: Expression_TypeSignature -> String
$cshow :: Expression_TypeSignature -> String
showsPrec :: Int -> Expression_TypeSignature -> ShowS
$cshowsPrec :: Int -> Expression_TypeSignature -> ShowS
Show)

_Expression_TypeSignature :: Name
_Expression_TypeSignature = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression.TypeSignature")

_Expression_TypeSignature_inner :: FieldName
_Expression_TypeSignature_inner = (String -> FieldName
Core.FieldName String
"inner")

_Expression_TypeSignature_type :: FieldName
_Expression_TypeSignature_type = (String -> FieldName
Core.FieldName String
"type")

-- | An update record expression
data Expression_UpdateRecord = 
  Expression_UpdateRecord {
    Expression_UpdateRecord -> Expression
expression_UpdateRecordInner :: Expression,
    Expression_UpdateRecord -> [FieldUpdate]
expression_UpdateRecordFields :: [FieldUpdate]}
  deriving (Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
$c/= :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
== :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
$c== :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
Eq, Eq Expression_UpdateRecord
Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
Expression_UpdateRecord -> Expression_UpdateRecord -> Ordering
Expression_UpdateRecord
-> Expression_UpdateRecord -> Expression_UpdateRecord
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 :: Expression_UpdateRecord
-> Expression_UpdateRecord -> Expression_UpdateRecord
$cmin :: Expression_UpdateRecord
-> Expression_UpdateRecord -> Expression_UpdateRecord
max :: Expression_UpdateRecord
-> Expression_UpdateRecord -> Expression_UpdateRecord
$cmax :: Expression_UpdateRecord
-> Expression_UpdateRecord -> Expression_UpdateRecord
>= :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
$c>= :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
> :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
$c> :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
<= :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
$c<= :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
< :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
$c< :: Expression_UpdateRecord -> Expression_UpdateRecord -> Bool
compare :: Expression_UpdateRecord -> Expression_UpdateRecord -> Ordering
$ccompare :: Expression_UpdateRecord -> Expression_UpdateRecord -> Ordering
Ord, ReadPrec [Expression_UpdateRecord]
ReadPrec Expression_UpdateRecord
Int -> ReadS Expression_UpdateRecord
ReadS [Expression_UpdateRecord]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Expression_UpdateRecord]
$creadListPrec :: ReadPrec [Expression_UpdateRecord]
readPrec :: ReadPrec Expression_UpdateRecord
$creadPrec :: ReadPrec Expression_UpdateRecord
readList :: ReadS [Expression_UpdateRecord]
$creadList :: ReadS [Expression_UpdateRecord]
readsPrec :: Int -> ReadS Expression_UpdateRecord
$creadsPrec :: Int -> ReadS Expression_UpdateRecord
Read, Int -> Expression_UpdateRecord -> ShowS
[Expression_UpdateRecord] -> ShowS
Expression_UpdateRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression_UpdateRecord] -> ShowS
$cshowList :: [Expression_UpdateRecord] -> ShowS
show :: Expression_UpdateRecord -> String
$cshow :: Expression_UpdateRecord -> String
showsPrec :: Int -> Expression_UpdateRecord -> ShowS
$cshowsPrec :: Int -> Expression_UpdateRecord -> ShowS
Show)

_Expression_UpdateRecord :: Name
_Expression_UpdateRecord = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Expression.UpdateRecord")

_Expression_UpdateRecord_inner :: FieldName
_Expression_UpdateRecord_inner = (String -> FieldName
Core.FieldName String
"inner")

_Expression_UpdateRecord_fields :: FieldName
_Expression_UpdateRecord_fields = (String -> FieldName
Core.FieldName String
"fields")

-- | A field (name/type pair)
data Field = 
  Field {
    Field -> Name
fieldName :: Name,
    Field -> Type
fieldType :: Type}
  deriving (Field -> Field -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, Eq Field
Field -> Field -> Bool
Field -> Field -> Ordering
Field -> Field -> Field
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 :: Field -> Field -> Field
$cmin :: Field -> Field -> Field
max :: Field -> Field -> Field
$cmax :: Field -> Field -> Field
>= :: Field -> Field -> Bool
$c>= :: Field -> Field -> Bool
> :: Field -> Field -> Bool
$c> :: Field -> Field -> Bool
<= :: Field -> Field -> Bool
$c<= :: Field -> Field -> Bool
< :: Field -> Field -> Bool
$c< :: Field -> Field -> Bool
compare :: Field -> Field -> Ordering
$ccompare :: Field -> Field -> Ordering
Ord, ReadPrec [Field]
ReadPrec Field
Int -> ReadS Field
ReadS [Field]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Field]
$creadListPrec :: ReadPrec [Field]
readPrec :: ReadPrec Field
$creadPrec :: ReadPrec Field
readList :: ReadS [Field]
$creadList :: ReadS [Field]
readsPrec :: Int -> ReadS Field
$creadsPrec :: Int -> ReadS Field
Read, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show)

_Field :: Name
_Field = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Field")

_Field_name :: FieldName
_Field_name = (String -> FieldName
Core.FieldName String
"name")

_Field_type :: FieldName
_Field_type = (String -> FieldName
Core.FieldName String
"type")

-- | A field together with any comments
data FieldWithComments = 
  FieldWithComments {
    FieldWithComments -> Field
fieldWithCommentsField :: Field,
    FieldWithComments -> Maybe String
fieldWithCommentsComments :: (Maybe String)}
  deriving (FieldWithComments -> FieldWithComments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldWithComments -> FieldWithComments -> Bool
$c/= :: FieldWithComments -> FieldWithComments -> Bool
== :: FieldWithComments -> FieldWithComments -> Bool
$c== :: FieldWithComments -> FieldWithComments -> Bool
Eq, Eq FieldWithComments
FieldWithComments -> FieldWithComments -> Bool
FieldWithComments -> FieldWithComments -> Ordering
FieldWithComments -> FieldWithComments -> FieldWithComments
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 :: FieldWithComments -> FieldWithComments -> FieldWithComments
$cmin :: FieldWithComments -> FieldWithComments -> FieldWithComments
max :: FieldWithComments -> FieldWithComments -> FieldWithComments
$cmax :: FieldWithComments -> FieldWithComments -> FieldWithComments
>= :: FieldWithComments -> FieldWithComments -> Bool
$c>= :: FieldWithComments -> FieldWithComments -> Bool
> :: FieldWithComments -> FieldWithComments -> Bool
$c> :: FieldWithComments -> FieldWithComments -> Bool
<= :: FieldWithComments -> FieldWithComments -> Bool
$c<= :: FieldWithComments -> FieldWithComments -> Bool
< :: FieldWithComments -> FieldWithComments -> Bool
$c< :: FieldWithComments -> FieldWithComments -> Bool
compare :: FieldWithComments -> FieldWithComments -> Ordering
$ccompare :: FieldWithComments -> FieldWithComments -> Ordering
Ord, ReadPrec [FieldWithComments]
ReadPrec FieldWithComments
Int -> ReadS FieldWithComments
ReadS [FieldWithComments]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldWithComments]
$creadListPrec :: ReadPrec [FieldWithComments]
readPrec :: ReadPrec FieldWithComments
$creadPrec :: ReadPrec FieldWithComments
readList :: ReadS [FieldWithComments]
$creadList :: ReadS [FieldWithComments]
readsPrec :: Int -> ReadS FieldWithComments
$creadsPrec :: Int -> ReadS FieldWithComments
Read, Int -> FieldWithComments -> ShowS
[FieldWithComments] -> ShowS
FieldWithComments -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldWithComments] -> ShowS
$cshowList :: [FieldWithComments] -> ShowS
show :: FieldWithComments -> String
$cshow :: FieldWithComments -> String
showsPrec :: Int -> FieldWithComments -> ShowS
$cshowsPrec :: Int -> FieldWithComments -> ShowS
Show)

_FieldWithComments :: Name
_FieldWithComments = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.FieldWithComments")

_FieldWithComments_field :: FieldName
_FieldWithComments_field = (String -> FieldName
Core.FieldName String
"field")

_FieldWithComments_comments :: FieldName
_FieldWithComments_comments = (String -> FieldName
Core.FieldName String
"comments")

-- | A field name and value
data FieldUpdate = 
  FieldUpdate {
    FieldUpdate -> Name
fieldUpdateName :: Name,
    FieldUpdate -> Expression
fieldUpdateValue :: Expression}
  deriving (FieldUpdate -> FieldUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldUpdate -> FieldUpdate -> Bool
$c/= :: FieldUpdate -> FieldUpdate -> Bool
== :: FieldUpdate -> FieldUpdate -> Bool
$c== :: FieldUpdate -> FieldUpdate -> Bool
Eq, Eq FieldUpdate
FieldUpdate -> FieldUpdate -> Bool
FieldUpdate -> FieldUpdate -> Ordering
FieldUpdate -> FieldUpdate -> FieldUpdate
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 :: FieldUpdate -> FieldUpdate -> FieldUpdate
$cmin :: FieldUpdate -> FieldUpdate -> FieldUpdate
max :: FieldUpdate -> FieldUpdate -> FieldUpdate
$cmax :: FieldUpdate -> FieldUpdate -> FieldUpdate
>= :: FieldUpdate -> FieldUpdate -> Bool
$c>= :: FieldUpdate -> FieldUpdate -> Bool
> :: FieldUpdate -> FieldUpdate -> Bool
$c> :: FieldUpdate -> FieldUpdate -> Bool
<= :: FieldUpdate -> FieldUpdate -> Bool
$c<= :: FieldUpdate -> FieldUpdate -> Bool
< :: FieldUpdate -> FieldUpdate -> Bool
$c< :: FieldUpdate -> FieldUpdate -> Bool
compare :: FieldUpdate -> FieldUpdate -> Ordering
$ccompare :: FieldUpdate -> FieldUpdate -> Ordering
Ord, ReadPrec [FieldUpdate]
ReadPrec FieldUpdate
Int -> ReadS FieldUpdate
ReadS [FieldUpdate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldUpdate]
$creadListPrec :: ReadPrec [FieldUpdate]
readPrec :: ReadPrec FieldUpdate
$creadPrec :: ReadPrec FieldUpdate
readList :: ReadS [FieldUpdate]
$creadList :: ReadS [FieldUpdate]
readsPrec :: Int -> ReadS FieldUpdate
$creadsPrec :: Int -> ReadS FieldUpdate
Read, Int -> FieldUpdate -> ShowS
[FieldUpdate] -> ShowS
FieldUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldUpdate] -> ShowS
$cshowList :: [FieldUpdate] -> ShowS
show :: FieldUpdate -> String
$cshow :: FieldUpdate -> String
showsPrec :: Int -> FieldUpdate -> ShowS
$cshowsPrec :: Int -> FieldUpdate -> ShowS
Show)

_FieldUpdate :: Name
_FieldUpdate = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.FieldUpdate")

_FieldUpdate_name :: FieldName
_FieldUpdate_name = (String -> FieldName
Core.FieldName String
"name")

_FieldUpdate_value :: FieldName
_FieldUpdate_value = (String -> FieldName
Core.FieldName String
"value")

-- | An import statement
data Import = 
  Import {
    Import -> Bool
importQualified :: Bool,
    Import -> ModuleName
importModule :: ModuleName,
    Import -> Maybe ModuleName
importAs :: (Maybe ModuleName),
    Import -> Maybe Import_Spec
importSpec :: (Maybe Import_Spec)}
  deriving (Import -> Import -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Import -> Import -> Bool
$c/= :: Import -> Import -> Bool
== :: Import -> Import -> Bool
$c== :: Import -> Import -> Bool
Eq, Eq Import
Import -> Import -> Bool
Import -> Import -> Ordering
Import -> Import -> Import
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 :: Import -> Import -> Import
$cmin :: Import -> Import -> Import
max :: Import -> Import -> Import
$cmax :: Import -> Import -> Import
>= :: Import -> Import -> Bool
$c>= :: Import -> Import -> Bool
> :: Import -> Import -> Bool
$c> :: Import -> Import -> Bool
<= :: Import -> Import -> Bool
$c<= :: Import -> Import -> Bool
< :: Import -> Import -> Bool
$c< :: Import -> Import -> Bool
compare :: Import -> Import -> Ordering
$ccompare :: Import -> Import -> Ordering
Ord, ReadPrec [Import]
ReadPrec Import
Int -> ReadS Import
ReadS [Import]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Import]
$creadListPrec :: ReadPrec [Import]
readPrec :: ReadPrec Import
$creadPrec :: ReadPrec Import
readList :: ReadS [Import]
$creadList :: ReadS [Import]
readsPrec :: Int -> ReadS Import
$creadsPrec :: Int -> ReadS Import
Read, Int -> Import -> ShowS
[Import] -> ShowS
Import -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Import] -> ShowS
$cshowList :: [Import] -> ShowS
show :: Import -> String
$cshow :: Import -> String
showsPrec :: Int -> Import -> ShowS
$cshowsPrec :: Int -> Import -> ShowS
Show)

_Import :: Name
_Import = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Import")

_Import_qualified :: FieldName
_Import_qualified = (String -> FieldName
Core.FieldName String
"qualified")

_Import_module :: FieldName
_Import_module = (String -> FieldName
Core.FieldName String
"module")

_Import_as :: FieldName
_Import_as = (String -> FieldName
Core.FieldName String
"as")

_Import_spec :: FieldName
_Import_spec = (String -> FieldName
Core.FieldName String
"spec")

-- | An import specification
data Import_Spec = 
  Import_SpecList [ImportExportSpec] |
  Import_SpecHiding [ImportExportSpec]
  deriving (Import_Spec -> Import_Spec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Import_Spec -> Import_Spec -> Bool
$c/= :: Import_Spec -> Import_Spec -> Bool
== :: Import_Spec -> Import_Spec -> Bool
$c== :: Import_Spec -> Import_Spec -> Bool
Eq, Eq Import_Spec
Import_Spec -> Import_Spec -> Bool
Import_Spec -> Import_Spec -> Ordering
Import_Spec -> Import_Spec -> Import_Spec
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 :: Import_Spec -> Import_Spec -> Import_Spec
$cmin :: Import_Spec -> Import_Spec -> Import_Spec
max :: Import_Spec -> Import_Spec -> Import_Spec
$cmax :: Import_Spec -> Import_Spec -> Import_Spec
>= :: Import_Spec -> Import_Spec -> Bool
$c>= :: Import_Spec -> Import_Spec -> Bool
> :: Import_Spec -> Import_Spec -> Bool
$c> :: Import_Spec -> Import_Spec -> Bool
<= :: Import_Spec -> Import_Spec -> Bool
$c<= :: Import_Spec -> Import_Spec -> Bool
< :: Import_Spec -> Import_Spec -> Bool
$c< :: Import_Spec -> Import_Spec -> Bool
compare :: Import_Spec -> Import_Spec -> Ordering
$ccompare :: Import_Spec -> Import_Spec -> Ordering
Ord, ReadPrec [Import_Spec]
ReadPrec Import_Spec
Int -> ReadS Import_Spec
ReadS [Import_Spec]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Import_Spec]
$creadListPrec :: ReadPrec [Import_Spec]
readPrec :: ReadPrec Import_Spec
$creadPrec :: ReadPrec Import_Spec
readList :: ReadS [Import_Spec]
$creadList :: ReadS [Import_Spec]
readsPrec :: Int -> ReadS Import_Spec
$creadsPrec :: Int -> ReadS Import_Spec
Read, Int -> Import_Spec -> ShowS
[Import_Spec] -> ShowS
Import_Spec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Import_Spec] -> ShowS
$cshowList :: [Import_Spec] -> ShowS
show :: Import_Spec -> String
$cshow :: Import_Spec -> String
showsPrec :: Int -> Import_Spec -> ShowS
$cshowsPrec :: Int -> Import_Spec -> ShowS
Show)

_Import_Spec :: Name
_Import_Spec = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Import.Spec")

_Import_Spec_list :: FieldName
_Import_Spec_list = (String -> FieldName
Core.FieldName String
"list")

_Import_Spec_hiding :: FieldName
_Import_Spec_hiding = (String -> FieldName
Core.FieldName String
"hiding")

-- | An import modifier ('pattern' or 'type')
data ImportModifier = 
  ImportModifierPattern  |
  ImportModifierType 
  deriving (ImportModifier -> ImportModifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportModifier -> ImportModifier -> Bool
$c/= :: ImportModifier -> ImportModifier -> Bool
== :: ImportModifier -> ImportModifier -> Bool
$c== :: ImportModifier -> ImportModifier -> Bool
Eq, Eq ImportModifier
ImportModifier -> ImportModifier -> Bool
ImportModifier -> ImportModifier -> Ordering
ImportModifier -> ImportModifier -> ImportModifier
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 :: ImportModifier -> ImportModifier -> ImportModifier
$cmin :: ImportModifier -> ImportModifier -> ImportModifier
max :: ImportModifier -> ImportModifier -> ImportModifier
$cmax :: ImportModifier -> ImportModifier -> ImportModifier
>= :: ImportModifier -> ImportModifier -> Bool
$c>= :: ImportModifier -> ImportModifier -> Bool
> :: ImportModifier -> ImportModifier -> Bool
$c> :: ImportModifier -> ImportModifier -> Bool
<= :: ImportModifier -> ImportModifier -> Bool
$c<= :: ImportModifier -> ImportModifier -> Bool
< :: ImportModifier -> ImportModifier -> Bool
$c< :: ImportModifier -> ImportModifier -> Bool
compare :: ImportModifier -> ImportModifier -> Ordering
$ccompare :: ImportModifier -> ImportModifier -> Ordering
Ord, ReadPrec [ImportModifier]
ReadPrec ImportModifier
Int -> ReadS ImportModifier
ReadS [ImportModifier]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportModifier]
$creadListPrec :: ReadPrec [ImportModifier]
readPrec :: ReadPrec ImportModifier
$creadPrec :: ReadPrec ImportModifier
readList :: ReadS [ImportModifier]
$creadList :: ReadS [ImportModifier]
readsPrec :: Int -> ReadS ImportModifier
$creadsPrec :: Int -> ReadS ImportModifier
Read, Int -> ImportModifier -> ShowS
[ImportModifier] -> ShowS
ImportModifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportModifier] -> ShowS
$cshowList :: [ImportModifier] -> ShowS
show :: ImportModifier -> String
$cshow :: ImportModifier -> String
showsPrec :: Int -> ImportModifier -> ShowS
$cshowsPrec :: Int -> ImportModifier -> ShowS
Show)

_ImportModifier :: Name
_ImportModifier = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.ImportModifier")

_ImportModifier_pattern :: FieldName
_ImportModifier_pattern = (String -> FieldName
Core.FieldName String
"pattern")

_ImportModifier_type :: FieldName
_ImportModifier_type = (String -> FieldName
Core.FieldName String
"type")

-- | An import or export specification
data ImportExportSpec = 
  ImportExportSpec {
    ImportExportSpec -> Maybe ImportModifier
importExportSpecModifier :: (Maybe ImportModifier),
    ImportExportSpec -> Name
importExportSpecName :: Name,
    ImportExportSpec -> Maybe ImportExportSpec_Subspec
importExportSpecSubspec :: (Maybe ImportExportSpec_Subspec)}
  deriving (ImportExportSpec -> ImportExportSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportExportSpec -> ImportExportSpec -> Bool
$c/= :: ImportExportSpec -> ImportExportSpec -> Bool
== :: ImportExportSpec -> ImportExportSpec -> Bool
$c== :: ImportExportSpec -> ImportExportSpec -> Bool
Eq, Eq ImportExportSpec
ImportExportSpec -> ImportExportSpec -> Bool
ImportExportSpec -> ImportExportSpec -> Ordering
ImportExportSpec -> ImportExportSpec -> ImportExportSpec
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 :: ImportExportSpec -> ImportExportSpec -> ImportExportSpec
$cmin :: ImportExportSpec -> ImportExportSpec -> ImportExportSpec
max :: ImportExportSpec -> ImportExportSpec -> ImportExportSpec
$cmax :: ImportExportSpec -> ImportExportSpec -> ImportExportSpec
>= :: ImportExportSpec -> ImportExportSpec -> Bool
$c>= :: ImportExportSpec -> ImportExportSpec -> Bool
> :: ImportExportSpec -> ImportExportSpec -> Bool
$c> :: ImportExportSpec -> ImportExportSpec -> Bool
<= :: ImportExportSpec -> ImportExportSpec -> Bool
$c<= :: ImportExportSpec -> ImportExportSpec -> Bool
< :: ImportExportSpec -> ImportExportSpec -> Bool
$c< :: ImportExportSpec -> ImportExportSpec -> Bool
compare :: ImportExportSpec -> ImportExportSpec -> Ordering
$ccompare :: ImportExportSpec -> ImportExportSpec -> Ordering
Ord, ReadPrec [ImportExportSpec]
ReadPrec ImportExportSpec
Int -> ReadS ImportExportSpec
ReadS [ImportExportSpec]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportExportSpec]
$creadListPrec :: ReadPrec [ImportExportSpec]
readPrec :: ReadPrec ImportExportSpec
$creadPrec :: ReadPrec ImportExportSpec
readList :: ReadS [ImportExportSpec]
$creadList :: ReadS [ImportExportSpec]
readsPrec :: Int -> ReadS ImportExportSpec
$creadsPrec :: Int -> ReadS ImportExportSpec
Read, Int -> ImportExportSpec -> ShowS
[ImportExportSpec] -> ShowS
ImportExportSpec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportExportSpec] -> ShowS
$cshowList :: [ImportExportSpec] -> ShowS
show :: ImportExportSpec -> String
$cshow :: ImportExportSpec -> String
showsPrec :: Int -> ImportExportSpec -> ShowS
$cshowsPrec :: Int -> ImportExportSpec -> ShowS
Show)

_ImportExportSpec :: Name
_ImportExportSpec = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.ImportExportSpec")

_ImportExportSpec_modifier :: FieldName
_ImportExportSpec_modifier = (String -> FieldName
Core.FieldName String
"modifier")

_ImportExportSpec_name :: FieldName
_ImportExportSpec_name = (String -> FieldName
Core.FieldName String
"name")

_ImportExportSpec_subspec :: FieldName
_ImportExportSpec_subspec = (String -> FieldName
Core.FieldName String
"subspec")

data ImportExportSpec_Subspec = 
  ImportExportSpec_SubspecAll  |
  ImportExportSpec_SubspecList [Name]
  deriving (ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
$c/= :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
== :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
$c== :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
Eq, Eq ImportExportSpec_Subspec
ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Ordering
ImportExportSpec_Subspec
-> ImportExportSpec_Subspec -> ImportExportSpec_Subspec
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 :: ImportExportSpec_Subspec
-> ImportExportSpec_Subspec -> ImportExportSpec_Subspec
$cmin :: ImportExportSpec_Subspec
-> ImportExportSpec_Subspec -> ImportExportSpec_Subspec
max :: ImportExportSpec_Subspec
-> ImportExportSpec_Subspec -> ImportExportSpec_Subspec
$cmax :: ImportExportSpec_Subspec
-> ImportExportSpec_Subspec -> ImportExportSpec_Subspec
>= :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
$c>= :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
> :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
$c> :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
<= :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
$c<= :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
< :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
$c< :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Bool
compare :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Ordering
$ccompare :: ImportExportSpec_Subspec -> ImportExportSpec_Subspec -> Ordering
Ord, ReadPrec [ImportExportSpec_Subspec]
ReadPrec ImportExportSpec_Subspec
Int -> ReadS ImportExportSpec_Subspec
ReadS [ImportExportSpec_Subspec]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportExportSpec_Subspec]
$creadListPrec :: ReadPrec [ImportExportSpec_Subspec]
readPrec :: ReadPrec ImportExportSpec_Subspec
$creadPrec :: ReadPrec ImportExportSpec_Subspec
readList :: ReadS [ImportExportSpec_Subspec]
$creadList :: ReadS [ImportExportSpec_Subspec]
readsPrec :: Int -> ReadS ImportExportSpec_Subspec
$creadsPrec :: Int -> ReadS ImportExportSpec_Subspec
Read, Int -> ImportExportSpec_Subspec -> ShowS
[ImportExportSpec_Subspec] -> ShowS
ImportExportSpec_Subspec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportExportSpec_Subspec] -> ShowS
$cshowList :: [ImportExportSpec_Subspec] -> ShowS
show :: ImportExportSpec_Subspec -> String
$cshow :: ImportExportSpec_Subspec -> String
showsPrec :: Int -> ImportExportSpec_Subspec -> ShowS
$cshowsPrec :: Int -> ImportExportSpec_Subspec -> ShowS
Show)

_ImportExportSpec_Subspec :: Name
_ImportExportSpec_Subspec = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.ImportExportSpec.Subspec")

_ImportExportSpec_Subspec_all :: FieldName
_ImportExportSpec_Subspec_all = (String -> FieldName
Core.FieldName String
"all")

_ImportExportSpec_Subspec_list :: FieldName
_ImportExportSpec_Subspec_list = (String -> FieldName
Core.FieldName String
"list")

-- | A literal value
data Literal = 
  LiteralChar Int |
  LiteralDouble Double |
  LiteralFloat Float |
  LiteralInt Int |
  LiteralInteger Integer |
  LiteralString String
  deriving (Literal -> Literal -> Bool
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
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
Ord, ReadPrec [Literal]
ReadPrec Literal
Int -> ReadS Literal
ReadS [Literal]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Literal]
$creadListPrec :: ReadPrec [Literal]
readPrec :: ReadPrec Literal
$creadPrec :: ReadPrec Literal
readList :: ReadS [Literal]
$creadList :: ReadS [Literal]
readsPrec :: Int -> ReadS Literal
$creadsPrec :: Int -> ReadS Literal
Read, Int -> Literal -> ShowS
[Literal] -> ShowS
Literal -> String
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 :: Name
_Literal = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Literal")

_Literal_char :: FieldName
_Literal_char = (String -> FieldName
Core.FieldName String
"char")

_Literal_double :: FieldName
_Literal_double = (String -> FieldName
Core.FieldName String
"double")

_Literal_float :: FieldName
_Literal_float = (String -> FieldName
Core.FieldName String
"float")

_Literal_int :: FieldName
_Literal_int = (String -> FieldName
Core.FieldName String
"int")

_Literal_integer :: FieldName
_Literal_integer = (String -> FieldName
Core.FieldName String
"integer")

_Literal_string :: FieldName
_Literal_string = (String -> FieldName
Core.FieldName String
"string")

data LocalBinding = 
  LocalBindingSignature TypeSignature |
  LocalBindingValue ValueBinding
  deriving (LocalBinding -> LocalBinding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalBinding -> LocalBinding -> Bool
$c/= :: LocalBinding -> LocalBinding -> Bool
== :: LocalBinding -> LocalBinding -> Bool
$c== :: LocalBinding -> LocalBinding -> Bool
Eq, Eq LocalBinding
LocalBinding -> LocalBinding -> Bool
LocalBinding -> LocalBinding -> Ordering
LocalBinding -> LocalBinding -> LocalBinding
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 :: LocalBinding -> LocalBinding -> LocalBinding
$cmin :: LocalBinding -> LocalBinding -> LocalBinding
max :: LocalBinding -> LocalBinding -> LocalBinding
$cmax :: LocalBinding -> LocalBinding -> LocalBinding
>= :: LocalBinding -> LocalBinding -> Bool
$c>= :: LocalBinding -> LocalBinding -> Bool
> :: LocalBinding -> LocalBinding -> Bool
$c> :: LocalBinding -> LocalBinding -> Bool
<= :: LocalBinding -> LocalBinding -> Bool
$c<= :: LocalBinding -> LocalBinding -> Bool
< :: LocalBinding -> LocalBinding -> Bool
$c< :: LocalBinding -> LocalBinding -> Bool
compare :: LocalBinding -> LocalBinding -> Ordering
$ccompare :: LocalBinding -> LocalBinding -> Ordering
Ord, ReadPrec [LocalBinding]
ReadPrec LocalBinding
Int -> ReadS LocalBinding
ReadS [LocalBinding]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LocalBinding]
$creadListPrec :: ReadPrec [LocalBinding]
readPrec :: ReadPrec LocalBinding
$creadPrec :: ReadPrec LocalBinding
readList :: ReadS [LocalBinding]
$creadList :: ReadS [LocalBinding]
readsPrec :: Int -> ReadS LocalBinding
$creadsPrec :: Int -> ReadS LocalBinding
Read, Int -> LocalBinding -> ShowS
[LocalBinding] -> ShowS
LocalBinding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalBinding] -> ShowS
$cshowList :: [LocalBinding] -> ShowS
show :: LocalBinding -> String
$cshow :: LocalBinding -> String
showsPrec :: Int -> LocalBinding -> ShowS
$cshowsPrec :: Int -> LocalBinding -> ShowS
Show)

_LocalBinding :: Name
_LocalBinding = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.LocalBinding")

_LocalBinding_signature :: FieldName
_LocalBinding_signature = (String -> FieldName
Core.FieldName String
"signature")

_LocalBinding_value :: FieldName
_LocalBinding_value = (String -> FieldName
Core.FieldName String
"value")

newtype LocalBindings = 
  LocalBindings {
    LocalBindings -> [LocalBinding]
unLocalBindings :: [LocalBinding]}
  deriving (LocalBindings -> LocalBindings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalBindings -> LocalBindings -> Bool
$c/= :: LocalBindings -> LocalBindings -> Bool
== :: LocalBindings -> LocalBindings -> Bool
$c== :: LocalBindings -> LocalBindings -> Bool
Eq, Eq LocalBindings
LocalBindings -> LocalBindings -> Bool
LocalBindings -> LocalBindings -> Ordering
LocalBindings -> LocalBindings -> LocalBindings
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 :: LocalBindings -> LocalBindings -> LocalBindings
$cmin :: LocalBindings -> LocalBindings -> LocalBindings
max :: LocalBindings -> LocalBindings -> LocalBindings
$cmax :: LocalBindings -> LocalBindings -> LocalBindings
>= :: LocalBindings -> LocalBindings -> Bool
$c>= :: LocalBindings -> LocalBindings -> Bool
> :: LocalBindings -> LocalBindings -> Bool
$c> :: LocalBindings -> LocalBindings -> Bool
<= :: LocalBindings -> LocalBindings -> Bool
$c<= :: LocalBindings -> LocalBindings -> Bool
< :: LocalBindings -> LocalBindings -> Bool
$c< :: LocalBindings -> LocalBindings -> Bool
compare :: LocalBindings -> LocalBindings -> Ordering
$ccompare :: LocalBindings -> LocalBindings -> Ordering
Ord, ReadPrec [LocalBindings]
ReadPrec LocalBindings
Int -> ReadS LocalBindings
ReadS [LocalBindings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LocalBindings]
$creadListPrec :: ReadPrec [LocalBindings]
readPrec :: ReadPrec LocalBindings
$creadPrec :: ReadPrec LocalBindings
readList :: ReadS [LocalBindings]
$creadList :: ReadS [LocalBindings]
readsPrec :: Int -> ReadS LocalBindings
$creadsPrec :: Int -> ReadS LocalBindings
Read, Int -> LocalBindings -> ShowS
[LocalBindings] -> ShowS
LocalBindings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalBindings] -> ShowS
$cshowList :: [LocalBindings] -> ShowS
show :: LocalBindings -> String
$cshow :: LocalBindings -> String
showsPrec :: Int -> LocalBindings -> ShowS
$cshowsPrec :: Int -> LocalBindings -> ShowS
Show)

_LocalBindings :: Name
_LocalBindings = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.LocalBindings")

data Module = 
  Module {
    Module -> Maybe ModuleHead
moduleHead :: (Maybe ModuleHead),
    Module -> [Import]
moduleImports :: [Import],
    Module -> [DeclarationWithComments]
moduleDeclarations :: [DeclarationWithComments]}
  deriving (Module -> Module -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c== :: Module -> Module -> Bool
Eq, Eq Module
Module -> Module -> Bool
Module -> Module -> Ordering
Module -> Module -> Module
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 :: Module -> Module -> Module
$cmin :: Module -> Module -> Module
max :: Module -> Module -> Module
$cmax :: Module -> Module -> Module
>= :: Module -> Module -> Bool
$c>= :: Module -> Module -> Bool
> :: Module -> Module -> Bool
$c> :: Module -> Module -> Bool
<= :: Module -> Module -> Bool
$c<= :: Module -> Module -> Bool
< :: Module -> Module -> Bool
$c< :: Module -> Module -> Bool
compare :: Module -> Module -> Ordering
$ccompare :: Module -> Module -> Ordering
Ord, ReadPrec [Module]
ReadPrec Module
Int -> ReadS Module
ReadS [Module]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Module]
$creadListPrec :: ReadPrec [Module]
readPrec :: ReadPrec Module
$creadPrec :: ReadPrec Module
readList :: ReadS [Module]
$creadList :: ReadS [Module]
readsPrec :: Int -> ReadS Module
$creadsPrec :: Int -> ReadS Module
Read, Int -> Module -> ShowS
[Module] -> ShowS
Module -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Module] -> ShowS
$cshowList :: [Module] -> ShowS
show :: Module -> String
$cshow :: Module -> String
showsPrec :: Int -> Module -> ShowS
$cshowsPrec :: Int -> Module -> ShowS
Show)

_Module :: Name
_Module = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Module")

_Module_head :: FieldName
_Module_head = (String -> FieldName
Core.FieldName String
"head")

_Module_imports :: FieldName
_Module_imports = (String -> FieldName
Core.FieldName String
"imports")

_Module_declarations :: FieldName
_Module_declarations = (String -> FieldName
Core.FieldName String
"declarations")

data ModuleHead = 
  ModuleHead {
    ModuleHead -> Maybe String
moduleHeadComments :: (Maybe String),
    ModuleHead -> ModuleName
moduleHeadName :: ModuleName,
    ModuleHead -> [Export]
moduleHeadExports :: [Export]}
  deriving (ModuleHead -> ModuleHead -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleHead -> ModuleHead -> Bool
$c/= :: ModuleHead -> ModuleHead -> Bool
== :: ModuleHead -> ModuleHead -> Bool
$c== :: ModuleHead -> ModuleHead -> Bool
Eq, Eq ModuleHead
ModuleHead -> ModuleHead -> Bool
ModuleHead -> ModuleHead -> Ordering
ModuleHead -> ModuleHead -> ModuleHead
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 :: ModuleHead -> ModuleHead -> ModuleHead
$cmin :: ModuleHead -> ModuleHead -> ModuleHead
max :: ModuleHead -> ModuleHead -> ModuleHead
$cmax :: ModuleHead -> ModuleHead -> ModuleHead
>= :: ModuleHead -> ModuleHead -> Bool
$c>= :: ModuleHead -> ModuleHead -> Bool
> :: ModuleHead -> ModuleHead -> Bool
$c> :: ModuleHead -> ModuleHead -> Bool
<= :: ModuleHead -> ModuleHead -> Bool
$c<= :: ModuleHead -> ModuleHead -> Bool
< :: ModuleHead -> ModuleHead -> Bool
$c< :: ModuleHead -> ModuleHead -> Bool
compare :: ModuleHead -> ModuleHead -> Ordering
$ccompare :: ModuleHead -> ModuleHead -> Ordering
Ord, ReadPrec [ModuleHead]
ReadPrec ModuleHead
Int -> ReadS ModuleHead
ReadS [ModuleHead]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModuleHead]
$creadListPrec :: ReadPrec [ModuleHead]
readPrec :: ReadPrec ModuleHead
$creadPrec :: ReadPrec ModuleHead
readList :: ReadS [ModuleHead]
$creadList :: ReadS [ModuleHead]
readsPrec :: Int -> ReadS ModuleHead
$creadsPrec :: Int -> ReadS ModuleHead
Read, Int -> ModuleHead -> ShowS
[ModuleHead] -> ShowS
ModuleHead -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleHead] -> ShowS
$cshowList :: [ModuleHead] -> ShowS
show :: ModuleHead -> String
$cshow :: ModuleHead -> String
showsPrec :: Int -> ModuleHead -> ShowS
$cshowsPrec :: Int -> ModuleHead -> ShowS
Show)

_ModuleHead :: Name
_ModuleHead = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.ModuleHead")

_ModuleHead_comments :: FieldName
_ModuleHead_comments = (String -> FieldName
Core.FieldName String
"comments")

_ModuleHead_name :: FieldName
_ModuleHead_name = (String -> FieldName
Core.FieldName String
"name")

_ModuleHead_exports :: FieldName
_ModuleHead_exports = (String -> FieldName
Core.FieldName String
"exports")

newtype ModuleName = 
  ModuleName {
    ModuleName -> String
unModuleName :: String}
  deriving (ModuleName -> ModuleName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleName -> ModuleName -> Bool
$c/= :: ModuleName -> ModuleName -> Bool
== :: ModuleName -> ModuleName -> Bool
$c== :: ModuleName -> ModuleName -> Bool
Eq, Eq ModuleName
ModuleName -> ModuleName -> Bool
ModuleName -> ModuleName -> Ordering
ModuleName -> ModuleName -> ModuleName
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 :: ModuleName -> ModuleName -> ModuleName
$cmin :: ModuleName -> ModuleName -> ModuleName
max :: ModuleName -> ModuleName -> ModuleName
$cmax :: ModuleName -> ModuleName -> ModuleName
>= :: ModuleName -> ModuleName -> Bool
$c>= :: ModuleName -> ModuleName -> Bool
> :: ModuleName -> ModuleName -> Bool
$c> :: ModuleName -> ModuleName -> Bool
<= :: ModuleName -> ModuleName -> Bool
$c<= :: ModuleName -> ModuleName -> Bool
< :: ModuleName -> ModuleName -> Bool
$c< :: ModuleName -> ModuleName -> Bool
compare :: ModuleName -> ModuleName -> Ordering
$ccompare :: ModuleName -> ModuleName -> Ordering
Ord, ReadPrec [ModuleName]
ReadPrec ModuleName
Int -> ReadS ModuleName
ReadS [ModuleName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModuleName]
$creadListPrec :: ReadPrec [ModuleName]
readPrec :: ReadPrec ModuleName
$creadPrec :: ReadPrec ModuleName
readList :: ReadS [ModuleName]
$creadList :: ReadS [ModuleName]
readsPrec :: Int -> ReadS ModuleName
$creadsPrec :: Int -> ReadS ModuleName
Read, Int -> ModuleName -> ShowS
[ModuleName] -> ShowS
ModuleName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleName] -> ShowS
$cshowList :: [ModuleName] -> ShowS
show :: ModuleName -> String
$cshow :: ModuleName -> String
showsPrec :: Int -> ModuleName -> ShowS
$cshowsPrec :: Int -> ModuleName -> ShowS
Show)

_ModuleName :: Name
_ModuleName = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.ModuleName")

data Name = 
  NameImplicit QualifiedName |
  NameNormal QualifiedName |
  NameParens QualifiedName
  deriving (Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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 :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord, ReadPrec [Name]
ReadPrec Name
Int -> ReadS Name
ReadS [Name]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Name]
$creadListPrec :: ReadPrec [Name]
readPrec :: ReadPrec Name
$creadPrec :: ReadPrec Name
readList :: ReadS [Name]
$creadList :: ReadS [Name]
readsPrec :: Int -> ReadS Name
$creadsPrec :: Int -> ReadS Name
Read, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)

_Name :: Name
_Name = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Name")

_Name_implicit :: FieldName
_Name_implicit = (String -> FieldName
Core.FieldName String
"implicit")

_Name_normal :: FieldName
_Name_normal = (String -> FieldName
Core.FieldName String
"normal")

_Name_parens :: FieldName
_Name_parens = (String -> FieldName
Core.FieldName String
"parens")

newtype NamePart = 
  NamePart {
    NamePart -> String
unNamePart :: String}
  deriving (NamePart -> NamePart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NamePart -> NamePart -> Bool
$c/= :: NamePart -> NamePart -> Bool
== :: NamePart -> NamePart -> Bool
$c== :: NamePart -> NamePart -> Bool
Eq, Eq NamePart
NamePart -> NamePart -> Bool
NamePart -> NamePart -> Ordering
NamePart -> NamePart -> NamePart
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 :: NamePart -> NamePart -> NamePart
$cmin :: NamePart -> NamePart -> NamePart
max :: NamePart -> NamePart -> NamePart
$cmax :: NamePart -> NamePart -> NamePart
>= :: NamePart -> NamePart -> Bool
$c>= :: NamePart -> NamePart -> Bool
> :: NamePart -> NamePart -> Bool
$c> :: NamePart -> NamePart -> Bool
<= :: NamePart -> NamePart -> Bool
$c<= :: NamePart -> NamePart -> Bool
< :: NamePart -> NamePart -> Bool
$c< :: NamePart -> NamePart -> Bool
compare :: NamePart -> NamePart -> Ordering
$ccompare :: NamePart -> NamePart -> Ordering
Ord, ReadPrec [NamePart]
ReadPrec NamePart
Int -> ReadS NamePart
ReadS [NamePart]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NamePart]
$creadListPrec :: ReadPrec [NamePart]
readPrec :: ReadPrec NamePart
$creadPrec :: ReadPrec NamePart
readList :: ReadS [NamePart]
$creadList :: ReadS [NamePart]
readsPrec :: Int -> ReadS NamePart
$creadsPrec :: Int -> ReadS NamePart
Read, Int -> NamePart -> ShowS
[NamePart] -> ShowS
NamePart -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NamePart] -> ShowS
$cshowList :: [NamePart] -> ShowS
show :: NamePart -> String
$cshow :: NamePart -> String
showsPrec :: Int -> NamePart -> ShowS
$cshowsPrec :: Int -> NamePart -> ShowS
Show)

_NamePart :: Name
_NamePart = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.NamePart")

data Operator = 
  OperatorBacktick QualifiedName |
  OperatorNormal QualifiedName
  deriving (Operator -> Operator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operator -> Operator -> Bool
$c/= :: Operator -> Operator -> Bool
== :: Operator -> Operator -> Bool
$c== :: Operator -> Operator -> Bool
Eq, Eq Operator
Operator -> Operator -> Bool
Operator -> Operator -> Ordering
Operator -> Operator -> Operator
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 :: Operator -> Operator -> Operator
$cmin :: Operator -> Operator -> Operator
max :: Operator -> Operator -> Operator
$cmax :: Operator -> Operator -> Operator
>= :: Operator -> Operator -> Bool
$c>= :: Operator -> Operator -> Bool
> :: Operator -> Operator -> Bool
$c> :: Operator -> Operator -> Bool
<= :: Operator -> Operator -> Bool
$c<= :: Operator -> Operator -> Bool
< :: Operator -> Operator -> Bool
$c< :: Operator -> Operator -> Bool
compare :: Operator -> Operator -> Ordering
$ccompare :: Operator -> Operator -> Ordering
Ord, ReadPrec [Operator]
ReadPrec Operator
Int -> ReadS Operator
ReadS [Operator]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Operator]
$creadListPrec :: ReadPrec [Operator]
readPrec :: ReadPrec Operator
$creadPrec :: ReadPrec Operator
readList :: ReadS [Operator]
$creadList :: ReadS [Operator]
readsPrec :: Int -> ReadS Operator
$creadsPrec :: Int -> ReadS Operator
Read, Int -> Operator -> ShowS
[Operator] -> ShowS
Operator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operator] -> ShowS
$cshowList :: [Operator] -> ShowS
show :: Operator -> String
$cshow :: Operator -> String
showsPrec :: Int -> Operator -> ShowS
$cshowsPrec :: Int -> Operator -> ShowS
Show)

_Operator :: Name
_Operator = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Operator")

_Operator_backtick :: FieldName
_Operator_backtick = (String -> FieldName
Core.FieldName String
"backtick")

_Operator_normal :: FieldName
_Operator_normal = (String -> FieldName
Core.FieldName String
"normal")

data Pattern = 
  PatternApplication Pattern_Application |
  PatternAs Pattern_As |
  PatternList [Pattern] |
  PatternLiteral Literal |
  PatternName Name |
  PatternParens Pattern |
  PatternRecord Pattern_Record |
  PatternTuple [Pattern] |
  PatternTyped Pattern_Typed |
  PatternWildcard 
  deriving (Pattern -> Pattern -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c== :: Pattern -> Pattern -> Bool
Eq, Eq Pattern
Pattern -> Pattern -> Bool
Pattern -> Pattern -> Ordering
Pattern -> Pattern -> Pattern
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 :: Pattern -> Pattern -> Pattern
$cmin :: Pattern -> Pattern -> Pattern
max :: Pattern -> Pattern -> Pattern
$cmax :: Pattern -> Pattern -> Pattern
>= :: Pattern -> Pattern -> Bool
$c>= :: Pattern -> Pattern -> Bool
> :: Pattern -> Pattern -> Bool
$c> :: Pattern -> Pattern -> Bool
<= :: Pattern -> Pattern -> Bool
$c<= :: Pattern -> Pattern -> Bool
< :: Pattern -> Pattern -> Bool
$c< :: Pattern -> Pattern -> Bool
compare :: Pattern -> Pattern -> Ordering
$ccompare :: Pattern -> Pattern -> Ordering
Ord, ReadPrec [Pattern]
ReadPrec Pattern
Int -> ReadS Pattern
ReadS [Pattern]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pattern]
$creadListPrec :: ReadPrec [Pattern]
readPrec :: ReadPrec Pattern
$creadPrec :: ReadPrec Pattern
readList :: ReadS [Pattern]
$creadList :: ReadS [Pattern]
readsPrec :: Int -> ReadS Pattern
$creadsPrec :: Int -> ReadS Pattern
Read, Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern] -> ShowS
$cshowList :: [Pattern] -> ShowS
show :: Pattern -> String
$cshow :: Pattern -> String
showsPrec :: Int -> Pattern -> ShowS
$cshowsPrec :: Int -> Pattern -> ShowS
Show)

_Pattern :: Name
_Pattern = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Pattern")

_Pattern_application :: FieldName
_Pattern_application = (String -> FieldName
Core.FieldName String
"application")

_Pattern_as :: FieldName
_Pattern_as = (String -> FieldName
Core.FieldName String
"as")

_Pattern_list :: FieldName
_Pattern_list = (String -> FieldName
Core.FieldName String
"list")

_Pattern_literal :: FieldName
_Pattern_literal = (String -> FieldName
Core.FieldName String
"literal")

_Pattern_name :: FieldName
_Pattern_name = (String -> FieldName
Core.FieldName String
"name")

_Pattern_parens :: FieldName
_Pattern_parens = (String -> FieldName
Core.FieldName String
"parens")

_Pattern_record :: FieldName
_Pattern_record = (String -> FieldName
Core.FieldName String
"record")

_Pattern_tuple :: FieldName
_Pattern_tuple = (String -> FieldName
Core.FieldName String
"tuple")

_Pattern_typed :: FieldName
_Pattern_typed = (String -> FieldName
Core.FieldName String
"typed")

_Pattern_wildcard :: FieldName
_Pattern_wildcard = (String -> FieldName
Core.FieldName String
"wildcard")

data Pattern_Application = 
  Pattern_Application {
    Pattern_Application -> Name
pattern_ApplicationName :: Name,
    Pattern_Application -> [Pattern]
pattern_ApplicationArgs :: [Pattern]}
  deriving (Pattern_Application -> Pattern_Application -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern_Application -> Pattern_Application -> Bool
$c/= :: Pattern_Application -> Pattern_Application -> Bool
== :: Pattern_Application -> Pattern_Application -> Bool
$c== :: Pattern_Application -> Pattern_Application -> Bool
Eq, Eq Pattern_Application
Pattern_Application -> Pattern_Application -> Bool
Pattern_Application -> Pattern_Application -> Ordering
Pattern_Application -> Pattern_Application -> Pattern_Application
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 :: Pattern_Application -> Pattern_Application -> Pattern_Application
$cmin :: Pattern_Application -> Pattern_Application -> Pattern_Application
max :: Pattern_Application -> Pattern_Application -> Pattern_Application
$cmax :: Pattern_Application -> Pattern_Application -> Pattern_Application
>= :: Pattern_Application -> Pattern_Application -> Bool
$c>= :: Pattern_Application -> Pattern_Application -> Bool
> :: Pattern_Application -> Pattern_Application -> Bool
$c> :: Pattern_Application -> Pattern_Application -> Bool
<= :: Pattern_Application -> Pattern_Application -> Bool
$c<= :: Pattern_Application -> Pattern_Application -> Bool
< :: Pattern_Application -> Pattern_Application -> Bool
$c< :: Pattern_Application -> Pattern_Application -> Bool
compare :: Pattern_Application -> Pattern_Application -> Ordering
$ccompare :: Pattern_Application -> Pattern_Application -> Ordering
Ord, ReadPrec [Pattern_Application]
ReadPrec Pattern_Application
Int -> ReadS Pattern_Application
ReadS [Pattern_Application]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pattern_Application]
$creadListPrec :: ReadPrec [Pattern_Application]
readPrec :: ReadPrec Pattern_Application
$creadPrec :: ReadPrec Pattern_Application
readList :: ReadS [Pattern_Application]
$creadList :: ReadS [Pattern_Application]
readsPrec :: Int -> ReadS Pattern_Application
$creadsPrec :: Int -> ReadS Pattern_Application
Read, Int -> Pattern_Application -> ShowS
[Pattern_Application] -> ShowS
Pattern_Application -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern_Application] -> ShowS
$cshowList :: [Pattern_Application] -> ShowS
show :: Pattern_Application -> String
$cshow :: Pattern_Application -> String
showsPrec :: Int -> Pattern_Application -> ShowS
$cshowsPrec :: Int -> Pattern_Application -> ShowS
Show)

_Pattern_Application :: Name
_Pattern_Application = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Pattern.Application")

_Pattern_Application_name :: FieldName
_Pattern_Application_name = (String -> FieldName
Core.FieldName String
"name")

_Pattern_Application_args :: FieldName
_Pattern_Application_args = (String -> FieldName
Core.FieldName String
"args")

data Pattern_As = 
  Pattern_As {
    Pattern_As -> Name
pattern_AsName :: Name,
    Pattern_As -> Pattern
pattern_AsInner :: Pattern}
  deriving (Pattern_As -> Pattern_As -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern_As -> Pattern_As -> Bool
$c/= :: Pattern_As -> Pattern_As -> Bool
== :: Pattern_As -> Pattern_As -> Bool
$c== :: Pattern_As -> Pattern_As -> Bool
Eq, Eq Pattern_As
Pattern_As -> Pattern_As -> Bool
Pattern_As -> Pattern_As -> Ordering
Pattern_As -> Pattern_As -> Pattern_As
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 :: Pattern_As -> Pattern_As -> Pattern_As
$cmin :: Pattern_As -> Pattern_As -> Pattern_As
max :: Pattern_As -> Pattern_As -> Pattern_As
$cmax :: Pattern_As -> Pattern_As -> Pattern_As
>= :: Pattern_As -> Pattern_As -> Bool
$c>= :: Pattern_As -> Pattern_As -> Bool
> :: Pattern_As -> Pattern_As -> Bool
$c> :: Pattern_As -> Pattern_As -> Bool
<= :: Pattern_As -> Pattern_As -> Bool
$c<= :: Pattern_As -> Pattern_As -> Bool
< :: Pattern_As -> Pattern_As -> Bool
$c< :: Pattern_As -> Pattern_As -> Bool
compare :: Pattern_As -> Pattern_As -> Ordering
$ccompare :: Pattern_As -> Pattern_As -> Ordering
Ord, ReadPrec [Pattern_As]
ReadPrec Pattern_As
Int -> ReadS Pattern_As
ReadS [Pattern_As]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pattern_As]
$creadListPrec :: ReadPrec [Pattern_As]
readPrec :: ReadPrec Pattern_As
$creadPrec :: ReadPrec Pattern_As
readList :: ReadS [Pattern_As]
$creadList :: ReadS [Pattern_As]
readsPrec :: Int -> ReadS Pattern_As
$creadsPrec :: Int -> ReadS Pattern_As
Read, Int -> Pattern_As -> ShowS
[Pattern_As] -> ShowS
Pattern_As -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern_As] -> ShowS
$cshowList :: [Pattern_As] -> ShowS
show :: Pattern_As -> String
$cshow :: Pattern_As -> String
showsPrec :: Int -> Pattern_As -> ShowS
$cshowsPrec :: Int -> Pattern_As -> ShowS
Show)

_Pattern_As :: Name
_Pattern_As = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Pattern.As")

_Pattern_As_name :: FieldName
_Pattern_As_name = (String -> FieldName
Core.FieldName String
"name")

_Pattern_As_inner :: FieldName
_Pattern_As_inner = (String -> FieldName
Core.FieldName String
"inner")

data Pattern_Record = 
  Pattern_Record {
    Pattern_Record -> Name
pattern_RecordName :: Name,
    Pattern_Record -> [PatternField]
pattern_RecordFields :: [PatternField]}
  deriving (Pattern_Record -> Pattern_Record -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern_Record -> Pattern_Record -> Bool
$c/= :: Pattern_Record -> Pattern_Record -> Bool
== :: Pattern_Record -> Pattern_Record -> Bool
$c== :: Pattern_Record -> Pattern_Record -> Bool
Eq, Eq Pattern_Record
Pattern_Record -> Pattern_Record -> Bool
Pattern_Record -> Pattern_Record -> Ordering
Pattern_Record -> Pattern_Record -> Pattern_Record
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 :: Pattern_Record -> Pattern_Record -> Pattern_Record
$cmin :: Pattern_Record -> Pattern_Record -> Pattern_Record
max :: Pattern_Record -> Pattern_Record -> Pattern_Record
$cmax :: Pattern_Record -> Pattern_Record -> Pattern_Record
>= :: Pattern_Record -> Pattern_Record -> Bool
$c>= :: Pattern_Record -> Pattern_Record -> Bool
> :: Pattern_Record -> Pattern_Record -> Bool
$c> :: Pattern_Record -> Pattern_Record -> Bool
<= :: Pattern_Record -> Pattern_Record -> Bool
$c<= :: Pattern_Record -> Pattern_Record -> Bool
< :: Pattern_Record -> Pattern_Record -> Bool
$c< :: Pattern_Record -> Pattern_Record -> Bool
compare :: Pattern_Record -> Pattern_Record -> Ordering
$ccompare :: Pattern_Record -> Pattern_Record -> Ordering
Ord, ReadPrec [Pattern_Record]
ReadPrec Pattern_Record
Int -> ReadS Pattern_Record
ReadS [Pattern_Record]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pattern_Record]
$creadListPrec :: ReadPrec [Pattern_Record]
readPrec :: ReadPrec Pattern_Record
$creadPrec :: ReadPrec Pattern_Record
readList :: ReadS [Pattern_Record]
$creadList :: ReadS [Pattern_Record]
readsPrec :: Int -> ReadS Pattern_Record
$creadsPrec :: Int -> ReadS Pattern_Record
Read, Int -> Pattern_Record -> ShowS
[Pattern_Record] -> ShowS
Pattern_Record -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern_Record] -> ShowS
$cshowList :: [Pattern_Record] -> ShowS
show :: Pattern_Record -> String
$cshow :: Pattern_Record -> String
showsPrec :: Int -> Pattern_Record -> ShowS
$cshowsPrec :: Int -> Pattern_Record -> ShowS
Show)

_Pattern_Record :: Name
_Pattern_Record = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Pattern.Record")

_Pattern_Record_name :: FieldName
_Pattern_Record_name = (String -> FieldName
Core.FieldName String
"name")

_Pattern_Record_fields :: FieldName
_Pattern_Record_fields = (String -> FieldName
Core.FieldName String
"fields")

data Pattern_Typed = 
  Pattern_Typed {
    Pattern_Typed -> Pattern
pattern_TypedInner :: Pattern,
    Pattern_Typed -> Type
pattern_TypedType :: Type}
  deriving (Pattern_Typed -> Pattern_Typed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern_Typed -> Pattern_Typed -> Bool
$c/= :: Pattern_Typed -> Pattern_Typed -> Bool
== :: Pattern_Typed -> Pattern_Typed -> Bool
$c== :: Pattern_Typed -> Pattern_Typed -> Bool
Eq, Eq Pattern_Typed
Pattern_Typed -> Pattern_Typed -> Bool
Pattern_Typed -> Pattern_Typed -> Ordering
Pattern_Typed -> Pattern_Typed -> Pattern_Typed
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 :: Pattern_Typed -> Pattern_Typed -> Pattern_Typed
$cmin :: Pattern_Typed -> Pattern_Typed -> Pattern_Typed
max :: Pattern_Typed -> Pattern_Typed -> Pattern_Typed
$cmax :: Pattern_Typed -> Pattern_Typed -> Pattern_Typed
>= :: Pattern_Typed -> Pattern_Typed -> Bool
$c>= :: Pattern_Typed -> Pattern_Typed -> Bool
> :: Pattern_Typed -> Pattern_Typed -> Bool
$c> :: Pattern_Typed -> Pattern_Typed -> Bool
<= :: Pattern_Typed -> Pattern_Typed -> Bool
$c<= :: Pattern_Typed -> Pattern_Typed -> Bool
< :: Pattern_Typed -> Pattern_Typed -> Bool
$c< :: Pattern_Typed -> Pattern_Typed -> Bool
compare :: Pattern_Typed -> Pattern_Typed -> Ordering
$ccompare :: Pattern_Typed -> Pattern_Typed -> Ordering
Ord, ReadPrec [Pattern_Typed]
ReadPrec Pattern_Typed
Int -> ReadS Pattern_Typed
ReadS [Pattern_Typed]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pattern_Typed]
$creadListPrec :: ReadPrec [Pattern_Typed]
readPrec :: ReadPrec Pattern_Typed
$creadPrec :: ReadPrec Pattern_Typed
readList :: ReadS [Pattern_Typed]
$creadList :: ReadS [Pattern_Typed]
readsPrec :: Int -> ReadS Pattern_Typed
$creadsPrec :: Int -> ReadS Pattern_Typed
Read, Int -> Pattern_Typed -> ShowS
[Pattern_Typed] -> ShowS
Pattern_Typed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern_Typed] -> ShowS
$cshowList :: [Pattern_Typed] -> ShowS
show :: Pattern_Typed -> String
$cshow :: Pattern_Typed -> String
showsPrec :: Int -> Pattern_Typed -> ShowS
$cshowsPrec :: Int -> Pattern_Typed -> ShowS
Show)

_Pattern_Typed :: Name
_Pattern_Typed = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Pattern.Typed")

_Pattern_Typed_inner :: FieldName
_Pattern_Typed_inner = (String -> FieldName
Core.FieldName String
"inner")

_Pattern_Typed_type :: FieldName
_Pattern_Typed_type = (String -> FieldName
Core.FieldName String
"type")

data PatternField = 
  PatternField {
    PatternField -> Name
patternFieldName :: Name,
    PatternField -> Pattern
patternFieldPattern :: Pattern}
  deriving (PatternField -> PatternField -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PatternField -> PatternField -> Bool
$c/= :: PatternField -> PatternField -> Bool
== :: PatternField -> PatternField -> Bool
$c== :: PatternField -> PatternField -> Bool
Eq, Eq PatternField
PatternField -> PatternField -> Bool
PatternField -> PatternField -> Ordering
PatternField -> PatternField -> PatternField
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 :: PatternField -> PatternField -> PatternField
$cmin :: PatternField -> PatternField -> PatternField
max :: PatternField -> PatternField -> PatternField
$cmax :: PatternField -> PatternField -> PatternField
>= :: PatternField -> PatternField -> Bool
$c>= :: PatternField -> PatternField -> Bool
> :: PatternField -> PatternField -> Bool
$c> :: PatternField -> PatternField -> Bool
<= :: PatternField -> PatternField -> Bool
$c<= :: PatternField -> PatternField -> Bool
< :: PatternField -> PatternField -> Bool
$c< :: PatternField -> PatternField -> Bool
compare :: PatternField -> PatternField -> Ordering
$ccompare :: PatternField -> PatternField -> Ordering
Ord, ReadPrec [PatternField]
ReadPrec PatternField
Int -> ReadS PatternField
ReadS [PatternField]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PatternField]
$creadListPrec :: ReadPrec [PatternField]
readPrec :: ReadPrec PatternField
$creadPrec :: ReadPrec PatternField
readList :: ReadS [PatternField]
$creadList :: ReadS [PatternField]
readsPrec :: Int -> ReadS PatternField
$creadsPrec :: Int -> ReadS PatternField
Read, Int -> PatternField -> ShowS
[PatternField] -> ShowS
PatternField -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PatternField] -> ShowS
$cshowList :: [PatternField] -> ShowS
show :: PatternField -> String
$cshow :: PatternField -> String
showsPrec :: Int -> PatternField -> ShowS
$cshowsPrec :: Int -> PatternField -> ShowS
Show)

_PatternField :: Name
_PatternField = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.PatternField")

_PatternField_name :: FieldName
_PatternField_name = (String -> FieldName
Core.FieldName String
"name")

_PatternField_pattern :: FieldName
_PatternField_pattern = (String -> FieldName
Core.FieldName String
"pattern")

data QualifiedName = 
  QualifiedName {
    QualifiedName -> [NamePart]
qualifiedNameQualifiers :: [NamePart],
    QualifiedName -> NamePart
qualifiedNameUnqualified :: NamePart}
  deriving (QualifiedName -> QualifiedName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QualifiedName -> QualifiedName -> Bool
$c/= :: QualifiedName -> QualifiedName -> Bool
== :: QualifiedName -> QualifiedName -> Bool
$c== :: QualifiedName -> QualifiedName -> Bool
Eq, Eq QualifiedName
QualifiedName -> QualifiedName -> Bool
QualifiedName -> QualifiedName -> Ordering
QualifiedName -> QualifiedName -> QualifiedName
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 :: QualifiedName -> QualifiedName -> QualifiedName
$cmin :: QualifiedName -> QualifiedName -> QualifiedName
max :: QualifiedName -> QualifiedName -> QualifiedName
$cmax :: QualifiedName -> QualifiedName -> QualifiedName
>= :: QualifiedName -> QualifiedName -> Bool
$c>= :: QualifiedName -> QualifiedName -> Bool
> :: QualifiedName -> QualifiedName -> Bool
$c> :: QualifiedName -> QualifiedName -> Bool
<= :: QualifiedName -> QualifiedName -> Bool
$c<= :: QualifiedName -> QualifiedName -> Bool
< :: QualifiedName -> QualifiedName -> Bool
$c< :: QualifiedName -> QualifiedName -> Bool
compare :: QualifiedName -> QualifiedName -> Ordering
$ccompare :: QualifiedName -> QualifiedName -> Ordering
Ord, ReadPrec [QualifiedName]
ReadPrec QualifiedName
Int -> ReadS QualifiedName
ReadS [QualifiedName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QualifiedName]
$creadListPrec :: ReadPrec [QualifiedName]
readPrec :: ReadPrec QualifiedName
$creadPrec :: ReadPrec QualifiedName
readList :: ReadS [QualifiedName]
$creadList :: ReadS [QualifiedName]
readsPrec :: Int -> ReadS QualifiedName
$creadsPrec :: Int -> ReadS QualifiedName
Read, Int -> QualifiedName -> ShowS
[QualifiedName] -> ShowS
QualifiedName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QualifiedName] -> ShowS
$cshowList :: [QualifiedName] -> ShowS
show :: QualifiedName -> String
$cshow :: QualifiedName -> String
showsPrec :: Int -> QualifiedName -> ShowS
$cshowsPrec :: Int -> QualifiedName -> ShowS
Show)

_QualifiedName :: Name
_QualifiedName = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.QualifiedName")

_QualifiedName_qualifiers :: FieldName
_QualifiedName_qualifiers = (String -> FieldName
Core.FieldName String
"qualifiers")

_QualifiedName_unqualified :: FieldName
_QualifiedName_unqualified = (String -> FieldName
Core.FieldName String
"unqualified")

newtype RightHandSide = 
  RightHandSide {
    RightHandSide -> Expression
unRightHandSide :: Expression}
  deriving (RightHandSide -> RightHandSide -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RightHandSide -> RightHandSide -> Bool
$c/= :: RightHandSide -> RightHandSide -> Bool
== :: RightHandSide -> RightHandSide -> Bool
$c== :: RightHandSide -> RightHandSide -> Bool
Eq, Eq RightHandSide
RightHandSide -> RightHandSide -> Bool
RightHandSide -> RightHandSide -> Ordering
RightHandSide -> RightHandSide -> RightHandSide
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 :: RightHandSide -> RightHandSide -> RightHandSide
$cmin :: RightHandSide -> RightHandSide -> RightHandSide
max :: RightHandSide -> RightHandSide -> RightHandSide
$cmax :: RightHandSide -> RightHandSide -> RightHandSide
>= :: RightHandSide -> RightHandSide -> Bool
$c>= :: RightHandSide -> RightHandSide -> Bool
> :: RightHandSide -> RightHandSide -> Bool
$c> :: RightHandSide -> RightHandSide -> Bool
<= :: RightHandSide -> RightHandSide -> Bool
$c<= :: RightHandSide -> RightHandSide -> Bool
< :: RightHandSide -> RightHandSide -> Bool
$c< :: RightHandSide -> RightHandSide -> Bool
compare :: RightHandSide -> RightHandSide -> Ordering
$ccompare :: RightHandSide -> RightHandSide -> Ordering
Ord, ReadPrec [RightHandSide]
ReadPrec RightHandSide
Int -> ReadS RightHandSide
ReadS [RightHandSide]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RightHandSide]
$creadListPrec :: ReadPrec [RightHandSide]
readPrec :: ReadPrec RightHandSide
$creadPrec :: ReadPrec RightHandSide
readList :: ReadS [RightHandSide]
$creadList :: ReadS [RightHandSide]
readsPrec :: Int -> ReadS RightHandSide
$creadsPrec :: Int -> ReadS RightHandSide
Read, Int -> RightHandSide -> ShowS
[RightHandSide] -> ShowS
RightHandSide -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RightHandSide] -> ShowS
$cshowList :: [RightHandSide] -> ShowS
show :: RightHandSide -> String
$cshow :: RightHandSide -> String
showsPrec :: Int -> RightHandSide -> ShowS
$cshowsPrec :: Int -> RightHandSide -> ShowS
Show)

_RightHandSide :: Name
_RightHandSide = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.RightHandSide")

newtype Statement = 
  Statement {
    Statement -> Expression
unStatement :: Expression}
  deriving (Statement -> Statement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c== :: Statement -> Statement -> Bool
Eq, Eq Statement
Statement -> Statement -> Bool
Statement -> Statement -> Ordering
Statement -> Statement -> Statement
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 :: Statement -> Statement -> Statement
$cmin :: Statement -> Statement -> Statement
max :: Statement -> Statement -> Statement
$cmax :: Statement -> Statement -> Statement
>= :: Statement -> Statement -> Bool
$c>= :: Statement -> Statement -> Bool
> :: Statement -> Statement -> Bool
$c> :: Statement -> Statement -> Bool
<= :: Statement -> Statement -> Bool
$c<= :: Statement -> Statement -> Bool
< :: Statement -> Statement -> Bool
$c< :: Statement -> Statement -> Bool
compare :: Statement -> Statement -> Ordering
$ccompare :: Statement -> Statement -> Ordering
Ord, ReadPrec [Statement]
ReadPrec Statement
Int -> ReadS Statement
ReadS [Statement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Statement]
$creadListPrec :: ReadPrec [Statement]
readPrec :: ReadPrec Statement
$creadPrec :: ReadPrec Statement
readList :: ReadS [Statement]
$creadList :: ReadS [Statement]
readsPrec :: Int -> ReadS Statement
$creadsPrec :: Int -> ReadS Statement
Read, Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> String
$cshow :: Statement -> String
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show)

_Statement :: Name
_Statement = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Statement")

data Type = 
  TypeApplication Type_Application |
  TypeFunction Type_Function |
  TypeInfix Type_Infix |
  TypeList Type |
  TypeParens Type |
  TypeTuple [Type] |
  TypeVariable Name
  deriving (Type -> Type -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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 :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
Ord, ReadPrec [Type]
ReadPrec Type
Int -> ReadS Type
ReadS [Type]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Type]
$creadListPrec :: ReadPrec [Type]
readPrec :: ReadPrec Type
$creadPrec :: ReadPrec Type
readList :: ReadS [Type]
$creadList :: ReadS [Type]
readsPrec :: Int -> ReadS Type
$creadsPrec :: Int -> ReadS Type
Read, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show)

_Type :: Name
_Type = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Type")

_Type_application :: FieldName
_Type_application = (String -> FieldName
Core.FieldName String
"application")

_Type_function :: FieldName
_Type_function = (String -> FieldName
Core.FieldName String
"function")

_Type_infix :: FieldName
_Type_infix = (String -> FieldName
Core.FieldName String
"infix")

_Type_list :: FieldName
_Type_list = (String -> FieldName
Core.FieldName String
"list")

_Type_parens :: FieldName
_Type_parens = (String -> FieldName
Core.FieldName String
"parens")

_Type_tuple :: FieldName
_Type_tuple = (String -> FieldName
Core.FieldName String
"tuple")

_Type_variable :: FieldName
_Type_variable = (String -> FieldName
Core.FieldName String
"variable")

data Type_Application = 
  Type_Application {
    Type_Application -> Type
type_ApplicationContext :: Type,
    Type_Application -> Type
type_ApplicationArgument :: Type}
  deriving (Type_Application -> Type_Application -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type_Application -> Type_Application -> Bool
$c/= :: Type_Application -> Type_Application -> Bool
== :: Type_Application -> Type_Application -> Bool
$c== :: Type_Application -> Type_Application -> Bool
Eq, Eq Type_Application
Type_Application -> Type_Application -> Bool
Type_Application -> Type_Application -> Ordering
Type_Application -> Type_Application -> Type_Application
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 :: Type_Application -> Type_Application -> Type_Application
$cmin :: Type_Application -> Type_Application -> Type_Application
max :: Type_Application -> Type_Application -> Type_Application
$cmax :: Type_Application -> Type_Application -> Type_Application
>= :: Type_Application -> Type_Application -> Bool
$c>= :: Type_Application -> Type_Application -> Bool
> :: Type_Application -> Type_Application -> Bool
$c> :: Type_Application -> Type_Application -> Bool
<= :: Type_Application -> Type_Application -> Bool
$c<= :: Type_Application -> Type_Application -> Bool
< :: Type_Application -> Type_Application -> Bool
$c< :: Type_Application -> Type_Application -> Bool
compare :: Type_Application -> Type_Application -> Ordering
$ccompare :: Type_Application -> Type_Application -> Ordering
Ord, ReadPrec [Type_Application]
ReadPrec Type_Application
Int -> ReadS Type_Application
ReadS [Type_Application]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Type_Application]
$creadListPrec :: ReadPrec [Type_Application]
readPrec :: ReadPrec Type_Application
$creadPrec :: ReadPrec Type_Application
readList :: ReadS [Type_Application]
$creadList :: ReadS [Type_Application]
readsPrec :: Int -> ReadS Type_Application
$creadsPrec :: Int -> ReadS Type_Application
Read, Int -> Type_Application -> ShowS
[Type_Application] -> ShowS
Type_Application -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type_Application] -> ShowS
$cshowList :: [Type_Application] -> ShowS
show :: Type_Application -> String
$cshow :: Type_Application -> String
showsPrec :: Int -> Type_Application -> ShowS
$cshowsPrec :: Int -> Type_Application -> ShowS
Show)

_Type_Application :: Name
_Type_Application = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Type.Application")

_Type_Application_context :: FieldName
_Type_Application_context = (String -> FieldName
Core.FieldName String
"context")

_Type_Application_argument :: FieldName
_Type_Application_argument = (String -> FieldName
Core.FieldName String
"argument")

data Type_Function = 
  Type_Function {
    Type_Function -> Type
type_FunctionDomain :: Type,
    Type_Function -> Type
type_FunctionCodomain :: Type}
  deriving (Type_Function -> Type_Function -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type_Function -> Type_Function -> Bool
$c/= :: Type_Function -> Type_Function -> Bool
== :: Type_Function -> Type_Function -> Bool
$c== :: Type_Function -> Type_Function -> Bool
Eq, Eq Type_Function
Type_Function -> Type_Function -> Bool
Type_Function -> Type_Function -> Ordering
Type_Function -> Type_Function -> Type_Function
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 :: Type_Function -> Type_Function -> Type_Function
$cmin :: Type_Function -> Type_Function -> Type_Function
max :: Type_Function -> Type_Function -> Type_Function
$cmax :: Type_Function -> Type_Function -> Type_Function
>= :: Type_Function -> Type_Function -> Bool
$c>= :: Type_Function -> Type_Function -> Bool
> :: Type_Function -> Type_Function -> Bool
$c> :: Type_Function -> Type_Function -> Bool
<= :: Type_Function -> Type_Function -> Bool
$c<= :: Type_Function -> Type_Function -> Bool
< :: Type_Function -> Type_Function -> Bool
$c< :: Type_Function -> Type_Function -> Bool
compare :: Type_Function -> Type_Function -> Ordering
$ccompare :: Type_Function -> Type_Function -> Ordering
Ord, ReadPrec [Type_Function]
ReadPrec Type_Function
Int -> ReadS Type_Function
ReadS [Type_Function]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Type_Function]
$creadListPrec :: ReadPrec [Type_Function]
readPrec :: ReadPrec Type_Function
$creadPrec :: ReadPrec Type_Function
readList :: ReadS [Type_Function]
$creadList :: ReadS [Type_Function]
readsPrec :: Int -> ReadS Type_Function
$creadsPrec :: Int -> ReadS Type_Function
Read, Int -> Type_Function -> ShowS
[Type_Function] -> ShowS
Type_Function -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type_Function] -> ShowS
$cshowList :: [Type_Function] -> ShowS
show :: Type_Function -> String
$cshow :: Type_Function -> String
showsPrec :: Int -> Type_Function -> ShowS
$cshowsPrec :: Int -> Type_Function -> ShowS
Show)

_Type_Function :: Name
_Type_Function = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Type.Function")

_Type_Function_domain :: FieldName
_Type_Function_domain = (String -> FieldName
Core.FieldName String
"domain")

_Type_Function_codomain :: FieldName
_Type_Function_codomain = (String -> FieldName
Core.FieldName String
"codomain")

data Type_Infix = 
  Type_Infix {
    Type_Infix -> Type
type_InfixLhs :: Type,
    Type_Infix -> Operator
type_InfixOperator :: Operator,
    Type_Infix -> Operator
type_InfixRhs :: Operator}
  deriving (Type_Infix -> Type_Infix -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type_Infix -> Type_Infix -> Bool
$c/= :: Type_Infix -> Type_Infix -> Bool
== :: Type_Infix -> Type_Infix -> Bool
$c== :: Type_Infix -> Type_Infix -> Bool
Eq, Eq Type_Infix
Type_Infix -> Type_Infix -> Bool
Type_Infix -> Type_Infix -> Ordering
Type_Infix -> Type_Infix -> Type_Infix
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 :: Type_Infix -> Type_Infix -> Type_Infix
$cmin :: Type_Infix -> Type_Infix -> Type_Infix
max :: Type_Infix -> Type_Infix -> Type_Infix
$cmax :: Type_Infix -> Type_Infix -> Type_Infix
>= :: Type_Infix -> Type_Infix -> Bool
$c>= :: Type_Infix -> Type_Infix -> Bool
> :: Type_Infix -> Type_Infix -> Bool
$c> :: Type_Infix -> Type_Infix -> Bool
<= :: Type_Infix -> Type_Infix -> Bool
$c<= :: Type_Infix -> Type_Infix -> Bool
< :: Type_Infix -> Type_Infix -> Bool
$c< :: Type_Infix -> Type_Infix -> Bool
compare :: Type_Infix -> Type_Infix -> Ordering
$ccompare :: Type_Infix -> Type_Infix -> Ordering
Ord, ReadPrec [Type_Infix]
ReadPrec Type_Infix
Int -> ReadS Type_Infix
ReadS [Type_Infix]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Type_Infix]
$creadListPrec :: ReadPrec [Type_Infix]
readPrec :: ReadPrec Type_Infix
$creadPrec :: ReadPrec Type_Infix
readList :: ReadS [Type_Infix]
$creadList :: ReadS [Type_Infix]
readsPrec :: Int -> ReadS Type_Infix
$creadsPrec :: Int -> ReadS Type_Infix
Read, Int -> Type_Infix -> ShowS
[Type_Infix] -> ShowS
Type_Infix -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type_Infix] -> ShowS
$cshowList :: [Type_Infix] -> ShowS
show :: Type_Infix -> String
$cshow :: Type_Infix -> String
showsPrec :: Int -> Type_Infix -> ShowS
$cshowsPrec :: Int -> Type_Infix -> ShowS
Show)

_Type_Infix :: Name
_Type_Infix = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Type.Infix")

_Type_Infix_lhs :: FieldName
_Type_Infix_lhs = (String -> FieldName
Core.FieldName String
"lhs")

_Type_Infix_operator :: FieldName
_Type_Infix_operator = (String -> FieldName
Core.FieldName String
"operator")

_Type_Infix_rhs :: FieldName
_Type_Infix_rhs = (String -> FieldName
Core.FieldName String
"rhs")

data TypeDeclaration = 
  TypeDeclaration {
    TypeDeclaration -> DeclarationHead
typeDeclarationName :: DeclarationHead,
    TypeDeclaration -> Type
typeDeclarationType :: Type}
  deriving (TypeDeclaration -> TypeDeclaration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeDeclaration -> TypeDeclaration -> Bool
$c/= :: TypeDeclaration -> TypeDeclaration -> Bool
== :: TypeDeclaration -> TypeDeclaration -> Bool
$c== :: TypeDeclaration -> TypeDeclaration -> Bool
Eq, Eq TypeDeclaration
TypeDeclaration -> TypeDeclaration -> Bool
TypeDeclaration -> TypeDeclaration -> Ordering
TypeDeclaration -> TypeDeclaration -> TypeDeclaration
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 :: TypeDeclaration -> TypeDeclaration -> TypeDeclaration
$cmin :: TypeDeclaration -> TypeDeclaration -> TypeDeclaration
max :: TypeDeclaration -> TypeDeclaration -> TypeDeclaration
$cmax :: TypeDeclaration -> TypeDeclaration -> TypeDeclaration
>= :: TypeDeclaration -> TypeDeclaration -> Bool
$c>= :: TypeDeclaration -> TypeDeclaration -> Bool
> :: TypeDeclaration -> TypeDeclaration -> Bool
$c> :: TypeDeclaration -> TypeDeclaration -> Bool
<= :: TypeDeclaration -> TypeDeclaration -> Bool
$c<= :: TypeDeclaration -> TypeDeclaration -> Bool
< :: TypeDeclaration -> TypeDeclaration -> Bool
$c< :: TypeDeclaration -> TypeDeclaration -> Bool
compare :: TypeDeclaration -> TypeDeclaration -> Ordering
$ccompare :: TypeDeclaration -> TypeDeclaration -> Ordering
Ord, ReadPrec [TypeDeclaration]
ReadPrec TypeDeclaration
Int -> ReadS TypeDeclaration
ReadS [TypeDeclaration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TypeDeclaration]
$creadListPrec :: ReadPrec [TypeDeclaration]
readPrec :: ReadPrec TypeDeclaration
$creadPrec :: ReadPrec TypeDeclaration
readList :: ReadS [TypeDeclaration]
$creadList :: ReadS [TypeDeclaration]
readsPrec :: Int -> ReadS TypeDeclaration
$creadsPrec :: Int -> ReadS TypeDeclaration
Read, Int -> TypeDeclaration -> ShowS
[TypeDeclaration] -> ShowS
TypeDeclaration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeDeclaration] -> ShowS
$cshowList :: [TypeDeclaration] -> ShowS
show :: TypeDeclaration -> String
$cshow :: TypeDeclaration -> String
showsPrec :: Int -> TypeDeclaration -> ShowS
$cshowsPrec :: Int -> TypeDeclaration -> ShowS
Show)

_TypeDeclaration :: Name
_TypeDeclaration = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.TypeDeclaration")

_TypeDeclaration_name :: FieldName
_TypeDeclaration_name = (String -> FieldName
Core.FieldName String
"name")

_TypeDeclaration_type :: FieldName
_TypeDeclaration_type = (String -> FieldName
Core.FieldName String
"type")

data TypeSignature = 
  TypeSignature {
    TypeSignature -> Name
typeSignatureName :: Name,
    TypeSignature -> Type
typeSignatureType :: Type}
  deriving (TypeSignature -> TypeSignature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSignature -> TypeSignature -> Bool
$c/= :: TypeSignature -> TypeSignature -> Bool
== :: TypeSignature -> TypeSignature -> Bool
$c== :: TypeSignature -> TypeSignature -> Bool
Eq, Eq TypeSignature
TypeSignature -> TypeSignature -> Bool
TypeSignature -> TypeSignature -> Ordering
TypeSignature -> TypeSignature -> TypeSignature
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 :: TypeSignature -> TypeSignature -> TypeSignature
$cmin :: TypeSignature -> TypeSignature -> TypeSignature
max :: TypeSignature -> TypeSignature -> TypeSignature
$cmax :: TypeSignature -> TypeSignature -> TypeSignature
>= :: TypeSignature -> TypeSignature -> Bool
$c>= :: TypeSignature -> TypeSignature -> Bool
> :: TypeSignature -> TypeSignature -> Bool
$c> :: TypeSignature -> TypeSignature -> Bool
<= :: TypeSignature -> TypeSignature -> Bool
$c<= :: TypeSignature -> TypeSignature -> Bool
< :: TypeSignature -> TypeSignature -> Bool
$c< :: TypeSignature -> TypeSignature -> Bool
compare :: TypeSignature -> TypeSignature -> Ordering
$ccompare :: TypeSignature -> TypeSignature -> Ordering
Ord, ReadPrec [TypeSignature]
ReadPrec TypeSignature
Int -> ReadS TypeSignature
ReadS [TypeSignature]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TypeSignature]
$creadListPrec :: ReadPrec [TypeSignature]
readPrec :: ReadPrec TypeSignature
$creadPrec :: ReadPrec TypeSignature
readList :: ReadS [TypeSignature]
$creadList :: ReadS [TypeSignature]
readsPrec :: Int -> ReadS TypeSignature
$creadsPrec :: Int -> ReadS TypeSignature
Read, Int -> TypeSignature -> ShowS
[TypeSignature] -> ShowS
TypeSignature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeSignature] -> ShowS
$cshowList :: [TypeSignature] -> ShowS
show :: TypeSignature -> String
$cshow :: TypeSignature -> String
showsPrec :: Int -> TypeSignature -> ShowS
$cshowsPrec :: Int -> TypeSignature -> ShowS
Show)

_TypeSignature :: Name
_TypeSignature = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.TypeSignature")

_TypeSignature_name :: FieldName
_TypeSignature_name = (String -> FieldName
Core.FieldName String
"name")

_TypeSignature_type :: FieldName
_TypeSignature_type = (String -> FieldName
Core.FieldName String
"type")

data TypedBinding = 
  TypedBinding {
    TypedBinding -> TypeSignature
typedBindingTypeSignature :: TypeSignature,
    TypedBinding -> ValueBinding
typedBindingValueBinding :: ValueBinding}
  deriving (TypedBinding -> TypedBinding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypedBinding -> TypedBinding -> Bool
$c/= :: TypedBinding -> TypedBinding -> Bool
== :: TypedBinding -> TypedBinding -> Bool
$c== :: TypedBinding -> TypedBinding -> Bool
Eq, Eq TypedBinding
TypedBinding -> TypedBinding -> Bool
TypedBinding -> TypedBinding -> Ordering
TypedBinding -> TypedBinding -> TypedBinding
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 :: TypedBinding -> TypedBinding -> TypedBinding
$cmin :: TypedBinding -> TypedBinding -> TypedBinding
max :: TypedBinding -> TypedBinding -> TypedBinding
$cmax :: TypedBinding -> TypedBinding -> TypedBinding
>= :: TypedBinding -> TypedBinding -> Bool
$c>= :: TypedBinding -> TypedBinding -> Bool
> :: TypedBinding -> TypedBinding -> Bool
$c> :: TypedBinding -> TypedBinding -> Bool
<= :: TypedBinding -> TypedBinding -> Bool
$c<= :: TypedBinding -> TypedBinding -> Bool
< :: TypedBinding -> TypedBinding -> Bool
$c< :: TypedBinding -> TypedBinding -> Bool
compare :: TypedBinding -> TypedBinding -> Ordering
$ccompare :: TypedBinding -> TypedBinding -> Ordering
Ord, ReadPrec [TypedBinding]
ReadPrec TypedBinding
Int -> ReadS TypedBinding
ReadS [TypedBinding]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TypedBinding]
$creadListPrec :: ReadPrec [TypedBinding]
readPrec :: ReadPrec TypedBinding
$creadPrec :: ReadPrec TypedBinding
readList :: ReadS [TypedBinding]
$creadList :: ReadS [TypedBinding]
readsPrec :: Int -> ReadS TypedBinding
$creadsPrec :: Int -> ReadS TypedBinding
Read, Int -> TypedBinding -> ShowS
[TypedBinding] -> ShowS
TypedBinding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypedBinding] -> ShowS
$cshowList :: [TypedBinding] -> ShowS
show :: TypedBinding -> String
$cshow :: TypedBinding -> String
showsPrec :: Int -> TypedBinding -> ShowS
$cshowsPrec :: Int -> TypedBinding -> ShowS
Show)

_TypedBinding :: Name
_TypedBinding = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.TypedBinding")

_TypedBinding_typeSignature :: FieldName
_TypedBinding_typeSignature = (String -> FieldName
Core.FieldName String
"typeSignature")

_TypedBinding_valueBinding :: FieldName
_TypedBinding_valueBinding = (String -> FieldName
Core.FieldName String
"valueBinding")

data ValueBinding = 
  ValueBindingSimple ValueBinding_Simple
  deriving (ValueBinding -> ValueBinding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueBinding -> ValueBinding -> Bool
$c/= :: ValueBinding -> ValueBinding -> Bool
== :: ValueBinding -> ValueBinding -> Bool
$c== :: ValueBinding -> ValueBinding -> Bool
Eq, Eq ValueBinding
ValueBinding -> ValueBinding -> Bool
ValueBinding -> ValueBinding -> Ordering
ValueBinding -> ValueBinding -> ValueBinding
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 :: ValueBinding -> ValueBinding -> ValueBinding
$cmin :: ValueBinding -> ValueBinding -> ValueBinding
max :: ValueBinding -> ValueBinding -> ValueBinding
$cmax :: ValueBinding -> ValueBinding -> ValueBinding
>= :: ValueBinding -> ValueBinding -> Bool
$c>= :: ValueBinding -> ValueBinding -> Bool
> :: ValueBinding -> ValueBinding -> Bool
$c> :: ValueBinding -> ValueBinding -> Bool
<= :: ValueBinding -> ValueBinding -> Bool
$c<= :: ValueBinding -> ValueBinding -> Bool
< :: ValueBinding -> ValueBinding -> Bool
$c< :: ValueBinding -> ValueBinding -> Bool
compare :: ValueBinding -> ValueBinding -> Ordering
$ccompare :: ValueBinding -> ValueBinding -> Ordering
Ord, ReadPrec [ValueBinding]
ReadPrec ValueBinding
Int -> ReadS ValueBinding
ReadS [ValueBinding]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ValueBinding]
$creadListPrec :: ReadPrec [ValueBinding]
readPrec :: ReadPrec ValueBinding
$creadPrec :: ReadPrec ValueBinding
readList :: ReadS [ValueBinding]
$creadList :: ReadS [ValueBinding]
readsPrec :: Int -> ReadS ValueBinding
$creadsPrec :: Int -> ReadS ValueBinding
Read, Int -> ValueBinding -> ShowS
[ValueBinding] -> ShowS
ValueBinding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueBinding] -> ShowS
$cshowList :: [ValueBinding] -> ShowS
show :: ValueBinding -> String
$cshow :: ValueBinding -> String
showsPrec :: Int -> ValueBinding -> ShowS
$cshowsPrec :: Int -> ValueBinding -> ShowS
Show)

_ValueBinding :: Name
_ValueBinding = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.ValueBinding")

_ValueBinding_simple :: FieldName
_ValueBinding_simple = (String -> FieldName
Core.FieldName String
"simple")

data ValueBinding_Simple = 
  ValueBinding_Simple {
    ValueBinding_Simple -> Pattern
valueBinding_SimplePattern :: Pattern,
    ValueBinding_Simple -> RightHandSide
valueBinding_SimpleRhs :: RightHandSide,
    ValueBinding_Simple -> Maybe LocalBindings
valueBinding_SimpleLocalBindings :: (Maybe LocalBindings)}
  deriving (ValueBinding_Simple -> ValueBinding_Simple -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
$c/= :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
== :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
$c== :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
Eq, Eq ValueBinding_Simple
ValueBinding_Simple -> ValueBinding_Simple -> Bool
ValueBinding_Simple -> ValueBinding_Simple -> Ordering
ValueBinding_Simple -> ValueBinding_Simple -> ValueBinding_Simple
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 :: ValueBinding_Simple -> ValueBinding_Simple -> ValueBinding_Simple
$cmin :: ValueBinding_Simple -> ValueBinding_Simple -> ValueBinding_Simple
max :: ValueBinding_Simple -> ValueBinding_Simple -> ValueBinding_Simple
$cmax :: ValueBinding_Simple -> ValueBinding_Simple -> ValueBinding_Simple
>= :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
$c>= :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
> :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
$c> :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
<= :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
$c<= :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
< :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
$c< :: ValueBinding_Simple -> ValueBinding_Simple -> Bool
compare :: ValueBinding_Simple -> ValueBinding_Simple -> Ordering
$ccompare :: ValueBinding_Simple -> ValueBinding_Simple -> Ordering
Ord, ReadPrec [ValueBinding_Simple]
ReadPrec ValueBinding_Simple
Int -> ReadS ValueBinding_Simple
ReadS [ValueBinding_Simple]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ValueBinding_Simple]
$creadListPrec :: ReadPrec [ValueBinding_Simple]
readPrec :: ReadPrec ValueBinding_Simple
$creadPrec :: ReadPrec ValueBinding_Simple
readList :: ReadS [ValueBinding_Simple]
$creadList :: ReadS [ValueBinding_Simple]
readsPrec :: Int -> ReadS ValueBinding_Simple
$creadsPrec :: Int -> ReadS ValueBinding_Simple
Read, Int -> ValueBinding_Simple -> ShowS
[ValueBinding_Simple] -> ShowS
ValueBinding_Simple -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueBinding_Simple] -> ShowS
$cshowList :: [ValueBinding_Simple] -> ShowS
show :: ValueBinding_Simple -> String
$cshow :: ValueBinding_Simple -> String
showsPrec :: Int -> ValueBinding_Simple -> ShowS
$cshowsPrec :: Int -> ValueBinding_Simple -> ShowS
Show)

_ValueBinding_Simple :: Name
_ValueBinding_Simple = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.ValueBinding.Simple")

_ValueBinding_Simple_pattern :: FieldName
_ValueBinding_Simple_pattern = (String -> FieldName
Core.FieldName String
"pattern")

_ValueBinding_Simple_rhs :: FieldName
_ValueBinding_Simple_rhs = (String -> FieldName
Core.FieldName String
"rhs")

_ValueBinding_Simple_localBindings :: FieldName
_ValueBinding_Simple_localBindings = (String -> FieldName
Core.FieldName String
"localBindings")

newtype Variable = 
  Variable {
    Variable -> Name
unVariable :: Name}
  deriving (Variable -> Variable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variable -> Variable -> Bool
$c/= :: Variable -> Variable -> Bool
== :: Variable -> Variable -> Bool
$c== :: Variable -> Variable -> Bool
Eq, Eq Variable
Variable -> Variable -> Bool
Variable -> Variable -> Ordering
Variable -> Variable -> Variable
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 :: Variable -> Variable -> Variable
$cmin :: Variable -> Variable -> Variable
max :: Variable -> Variable -> Variable
$cmax :: Variable -> Variable -> Variable
>= :: Variable -> Variable -> Bool
$c>= :: Variable -> Variable -> Bool
> :: Variable -> Variable -> Bool
$c> :: Variable -> Variable -> Bool
<= :: Variable -> Variable -> Bool
$c<= :: Variable -> Variable -> Bool
< :: Variable -> Variable -> Bool
$c< :: Variable -> Variable -> Bool
compare :: Variable -> Variable -> Ordering
$ccompare :: Variable -> Variable -> Ordering
Ord, ReadPrec [Variable]
ReadPrec Variable
Int -> ReadS Variable
ReadS [Variable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Variable]
$creadListPrec :: ReadPrec [Variable]
readPrec :: ReadPrec Variable
$creadPrec :: ReadPrec Variable
readList :: ReadS [Variable]
$creadList :: ReadS [Variable]
readsPrec :: Int -> ReadS Variable
$creadsPrec :: Int -> ReadS Variable
Read, Int -> Variable -> ShowS
[Variable] -> ShowS
Variable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variable] -> ShowS
$cshowList :: [Variable] -> ShowS
show :: Variable -> String
$cshow :: Variable -> String
showsPrec :: Int -> Variable -> ShowS
$cshowsPrec :: Int -> Variable -> ShowS
Show)

_Variable :: Name
_Variable = (String -> Name
Core.Name String
"hydra/ext/haskell/ast.Variable")