=========================================
Inline Pragmas
=========================================

factorial :: Num a => a -> a
factorial 0 = 0
factorial n = n * factorial (n-1)
{-# INLINE factorial #-}

a = b
{-# INLINE CONLIKE [1] a #-}
{-#INLINE [~2] a#-}

---

(module
  (type_signature
    (variable_identifier)
    (annotation)
    (context
      (context_pattern (class (type_class_identifier) (type_variable_identifier))))
      (function_type
        (type (type_variable_identifier))
        (type (type_variable_identifier))))
  (function_declaration (variable_identifier) (integer)
    (function_body (integer)))
  (function_declaration (variable_identifier) (variable_identifier)
    (function_body
      (infix_operator_application (variable_identifier) (variable_operator (variable_symbol))
      (function_application
        (variable_identifier)
        (parenthesized_expression
          (infix_operator_application
            (variable_identifier)
            (variable_operator (variable_symbol))
            (integer)))))))
  (pragma)
  (function_declaration
    (variable_identifier)
    (function_body (variable_identifier)))
    (pragma)
    (pragma))

=========================================
No Inline Pragmas
=========================================

factorial :: Num a => a -> a
factorial 0 = 0
factorial n = n * factorial (n-1)
{-# NOINLINE factorial #-}

a = b
{-# NOINLINE CONLIKE [1] a #-}
{-# NOINLINE [~2] a #-}

---

(module
  (type_signature
    (variable_identifier)
    (annotation)
    (context
      (context_pattern (class (type_class_identifier) (type_variable_identifier))))
      (function_type
        (type (type_variable_identifier))
        (type (type_variable_identifier))))
  (function_declaration (variable_identifier) (integer)
    (function_body (integer)))
  (function_declaration (variable_identifier) (variable_identifier)
    (function_body
      (infix_operator_application (variable_identifier) (variable_operator (variable_symbol))
      (function_application
        (variable_identifier)
        (parenthesized_expression
          (infix_operator_application
            (variable_identifier)
            (variable_operator (variable_symbol))
            (integer)))))))
  (pragma)
  (function_declaration
    (variable_identifier)
    (function_body (variable_identifier)))
  (pragma)
  (pragma))

=========================================
Specialization Pragmas
=========================================

factorial :: Num a => a -> a
factorial 0 = 0
factorial n = n ⋆ factorial (n-1)
{-# SPECIALIZE [0] factorial :: Int -> Int,
                   factorial :: Integer -> Integer #-}
{-# SPECIALISE factorial :: Int -> Int,
               factorial :: Integer -> Integer #-}

{-# SPECIALIZE INLINE [0] factorial :: Int -> Int,
                          factorial :: Integer -> Integer #-}
{-# SPECIALISE NOINLINE factorial :: Int -> Int,
                        factorial :: Integer -> Integer #-}

instance (Eq a) => Eq (Foo a) where {
  {-# SPECIALIZE instance Eq (Foo [(Int, Bar)]) #-}
}

---

(module
  (type_signature
    (variable_identifier)
    (annotation)
    (context
      (context_pattern (class (type_class_identifier) (type_variable_identifier))))
      (function_type
        (type (type_variable_identifier))
        (type (type_variable_identifier))))
  (function_declaration (variable_identifier) (integer)
    (function_body (integer)))
  (function_declaration (variable_identifier) (variable_identifier)
    (function_body
      (infix_operator_application (variable_identifier) (variable_operator (variable_symbol))
      (function_application
        (variable_identifier)
        (parenthesized_expression
          (infix_operator_application
          (variable_identifier)
          (variable_operator (variable_symbol))
          (integer)))))))
  (pragma)
  (pragma)
  (pragma)
  (pragma)

  (type_class_instance_declaration
    (context (context_pattern (class (type_class_identifier) (type_variable_identifier))))
    (type_class_identifier)
    (instance
      (parenthesized_type_pattern (type_constructor_identifier) (type_variable_identifier)))
      (where
        (pragma))))

=========================================
Language Pragmas Without Module
=========================================

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables, DataKinds #-}

---

(module
  (pragma)
  (pragma))

=========================================
Language Pragmas With Module
=========================================

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables, DataKinds #-}
module A where

---

(module
  (pragma)
  (pragma)
  (module_identifier)
  (where))

=========================================
Options GHC Pragmas Without Module
=========================================

{-# OPTIONS_GHC #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans#-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -fno-warn-orphans -funbox-strict-fields #-}

---

(module
  (pragma)
  (pragma)
  (pragma)
  (pragma)
  (pragma))

=========================================
Options GHC Pragmas With Module
=========================================

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans#-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module A where

---

(module
  (pragma)
  (pragma)
  (pragma)
  (module_identifier)
  (where))

=========================================
Source Pragma
=========================================

module A where

import {-# SOURCE #-} B(TB(..))

---

(module
  (module_identifier)
  (where
    (import_declaration
      (pragma)
      (module_identifier)
      (import_spec
        (import
          (type_constructor_identifier)
          (all_constructors))))))

=========================================
Include Pragma Without Module
=========================================

{-# INCLUDE "foo.h" #-}
{-# INCLUDE <stdio.h> #-}

---

(module
  (pragma)
  (pragma))


=========================================
Include Pragma With Module
=========================================

{-# INCLUDE "foo.h" #-}
{-# INCLUDE <stdio.h> #-}
module A where

---

(module
  (pragma)
  (pragma)
  (module_identifier)
  (where))

=========================================
Warning Pragma
=========================================

module A {-# WARNING "Unstable" #-} where

f = a
g = f
i = h

{-# WARNING f, g "Unstable" #-}
{-# WARNING f, g ["Use B.f", "Use B.g"] #-}
{-# WARNING i "Unsafe" #-}

---

(module
  (module_identifier)
  (pragma)
  (where
    (function_declaration
      (variable_identifier)
      (function_body
        (variable_identifier)))
    (function_declaration
      (variable_identifier)
      (function_body
        (variable_identifier)))
    (function_declaration
      (variable_identifier)
      (function_body
        (variable_identifier)))
    (pragma)
    (pragma)
    (pragma)))

=========================================
Deprecated Pragma
=========================================

module A {-# DEPRECATED "Use B" #-} where

f = a
g = f
i = h

{-# DEPRECATED f, g "Use B.f, B.g" #-}
{-# DEPRECATED f, g ["Use B.f", "Use B.g"] #-}
{-# DEPRECATED i "Use B.i" #-}

---

(module
  (module_identifier)
  (pragma)
  (where
    (function_declaration
      (variable_identifier)
      (function_body (variable_identifier)))
    (function_declaration
      (variable_identifier)
      (function_body (variable_identifier)))
    (function_declaration
      (variable_identifier)
      (function_body (variable_identifier)))
    (pragma)
    (pragma)
    (pragma)))

=========================================
Line Pragma
=========================================

module A where
{-# LINE 42 "Foo.vhs" #-}

---

(module
  (module_identifier)
  (where
    (pragma)))

=========================================
Column Pragma
=========================================

module A where
{-# COLUMN 42 #-}

---

(module
  (module_identifier)
  (where
    (pragma)))

=========================================
Minimal Pragma
=========================================

module A where

class Eq a where
  (==) :: a -> a -> Bool
  (/=) :: a -> a -> Bool
  x == y = not (x /= y)
  x /= y = not (x == y)
  {-# MINIMAL (==) | (/=) #-}
  {-# MINIMAL (==) , (/=) #-}
  {-# MINIMAL (==) , (/=) | (/=) #-}
  {-# MINIMAL (==) , (/=) | (/=) , (==) #-}

---

(module
  (module_identifier)
  (where
    (type_class_declaration
      (type_class_identifier)
      (type_variable_identifier)
      (where
        (type_signature
          (variable_operator (variable_symbol))
          (annotation)
          (function_type
            (type (type_variable_identifier))
            (function_type
              (type (type_variable_identifier))
              (type (type_constructor_identifier)))))
        (type_signature
          (variable_operator (variable_symbol))
          (annotation)
          (function_type
            (type (type_variable_identifier))
            (function_type
              (type (type_variable_identifier))
              (type (type_constructor_identifier)))))
        (function_declaration
          (variable_identifier)
          (variable_operator (variable_symbol))
          (variable_identifier)
          (function_body
            (function_application
              (variable_identifier)
              (parenthesized_expression
                (infix_operator_application
                  (variable_identifier)
                  (variable_operator (variable_symbol))
                  (variable_identifier))))))
        (function_declaration
          (variable_identifier)
          (variable_operator (variable_symbol))
          (variable_identifier)
          (function_body
            (function_application
              (variable_identifier)
              (parenthesized_expression
                (infix_operator_application
                  (variable_identifier)
                  (variable_operator (variable_symbol))
                  (variable_identifier))))))
      (pragma)
      (pragma)
      (pragma)
      (pragma)))))

=========================================
Inlinable Pragmas
=========================================

a = b
{-# INLINABLE a #-}
{-# INLINABLE [1] a #-}
{-# INLINEABLE [~2] a #-}

---

(module
  (function_declaration
    (variable_identifier)
    (function_body (variable_identifier)))
  (pragma)
  (pragma)
  (pragma))

=========================================
Unpack Pragmas
=========================================

data T = T {-# UNPACK #-} !Float
           {-# UNPACK #-} !Float

---

(module
  (algebraic_datatype_declaration
    (type_constructor_identifier)
      (constructors
        (data_constructor
          (constructor_identifier)
          (pragma)
          (strict_type (type_constructor_identifier))
          (pragma)
          (strict_type (type_constructor_identifier))))))

=========================================
No unpack Pragmas
=========================================

data T = T {-# NOUNPACK #-} !(Int, Int)

---

(module
  (algebraic_datatype_declaration
    (type_constructor_identifier)
    (constructors
      (data_constructor
        (constructor_identifier)
        (pragma)
        (strict_type (tuple_type (type (type_constructor_identifier)) (type (type_constructor_identifier))))))))

=========================================
Complete Pragmas
=========================================

data Choice a = Choice Bool a

pattern LeftChoice :: a -> Choice a
pattern LeftChoice a = Choice False a

pattern RightChoice :: a -> Choice a
pattern RightChoice a <- Choice True a

pattern (:>) s a <- (preview _Snoc -> Just (s,a)) where
  (:>) a s = _Snoc # (a,s)

{-# COMPLETE LeftChoice, RightChoice #-}

foo :: Choice Int -> Int
foo (LeftChoice n) = n * 2
foo (RightChoice n) = n - 2

---

(module
  (algebraic_datatype_declaration
    (type_constructor_identifier)
    (type_variable_identifier)
    (constructors
      (data_constructor
        (constructor_identifier)
        (type_constructor_identifier)
        (type_variable_identifier))))

  (pattern_type_signature
    (constructor_identifier)
    (annotation)
    (function_type
      (type (type_variable_identifier))
      (type (type_constructor_identifier) (type_variable_identifier))))

  (bidirectional_pattern_synonym
    (constructor_pattern
      (constructor_identifier)
      (variable_identifier))
    (function_body
      (function_application
        (function_application
          (constructor_identifier)
          (constructor_identifier))
        (variable_identifier))))

  (pattern_type_signature
    (constructor_identifier)
    (annotation)
    (function_type
      (type (type_variable_identifier))
      (type (type_constructor_identifier) (type_variable_identifier))))

  (unidirectional_pattern_synonym
    (constructor_pattern (constructor_identifier) (variable_identifier))
    (type_constructor_identifier)
    (type_constructor_identifier)
    (type_variable_identifier))

  (unidirectional_pattern_synonym
    (constructor_pattern (constructor_operator (constructor_symbol)) (variable_identifier) (variable_identifier))
    (parenthesized_type_pattern
      (function_type
        (type (type_variable_identifier) (type_variable_identifier))
        (type (type_constructor_identifier)
          (tuple_type
            (type (type_variable_identifier))
            (type (type_variable_identifier))))))
    (where
      (function_declaration
        (constructor_pattern (constructor_operator (constructor_symbol)) (variable_identifier) (variable_identifier))
        (function_body (variable_identifier)))
  (cpp_directive)))
  (pragma)

  (type_signature
    (variable_identifier)
    (annotation)
    (function_type
      (type (type_constructor_identifier) (type_constructor_identifier))
      (type (type_constructor_identifier))))
  (function_declaration
    (variable_identifier)
    (parenthesized_pattern
      (constructor_pattern (constructor_identifier) (variable_identifier)))
    (function_body
      (infix_operator_application
        (variable_identifier)
        (variable_operator (variable_symbol))
        (integer))))
  (function_declaration
    (variable_identifier)
    (parenthesized_pattern
      (constructor_pattern
        (constructor_identifier) (variable_identifier)))
    (function_body
      (infix_operator_application
        (variable_identifier)
        (variable_operator (variable_symbol))
        (integer)))))

=========================================
Overlapping Pragmas
=========================================

instance {-# OVERLAPPING #-} C Int [Int] where {}

---

(module
  (type_class_instance_declaration
    (pragma)
    (type_class_identifier)
    (instance
      (type_constructor_identifier) (list_type (type (type_constructor_identifier))))
    (where)))

=========================================
Overlappable Pragmas
=========================================

instance {-# OVERLAPPABLE #-} Show a => C a Bool where {}

---

(module
  (type_class_instance_declaration
    (pragma)
    (context (context_pattern (class (type_class_identifier) (type_variable_identifier))))
    (type_class_identifier)
    (instance
      (type_variable_identifier)
      (type_constructor_identifier))
    (where)))

=========================================
Overlaps Pragmas
=========================================

instance {-# OVERLAPS #-} Show a => C a Bool where {}

---

(module
  (type_class_instance_declaration
    (pragma)
    (context (context_pattern (class (type_class_identifier) (type_variable_identifier))))
    (type_class_identifier)
    (instance
      (type_variable_identifier)
      (type_constructor_identifier))
    (where)))

=========================================
Incoherent Pragmas
=========================================

instance {-# INCOHERENT #-} (Show a, Show b) => C a [b] where {}

---

(module
  (type_class_instance_declaration
    (pragma)
    (context
      (context_pattern (class (type_class_identifier) (type_variable_identifier)))
      (context_pattern (class (type_class_identifier) (type_variable_identifier))))
    (type_class_identifier)
    (instance
      (type_variable_identifier)
      (list_type (type (type_variable_identifier))))
    (where)))

=========================================
Rule Pragmas
=========================================

module A where
{-# RULES
      "map/map" [2] forall f g xs. map f (map g xs) = map (f.g) xs
      "fold/build"  forall k z (g::forall b. (a->b->b) -> b -> b) .
                    foldr k z (build g) = g k z
  #-}

---

(module
  (module_identifier)
    (where
      (pragma)))

=========================================
Annotation Pragmas
=========================================

module A where
{-# ANN module ("HLint: ignore Eta reduce" :: String) #-}
{-# ANN type Foo (Just "A `Maybe String' annotation") #-}
{-# ANN f SillyAnnotation { foo = (id 10), bar = f } #-}

---

(module
  (module_identifier)
  (where
    (pragma)
    (pragma)
    (pragma)))
