{-# LANGUAGE CPP, MagicHash, BangPatterns #-}
import Data.Char
import Data.Array
import GHC.Exts
import System.IO
import System.IO.Unsafe
import Debug.Trace

import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)

-- parser produced by Happy Version 1.16

data HappyAbsSyn
	= HappyTerminal Token
	| HappyErrorToken Int
	| HappyAbsSyn4 (Exp)
	| HappyAbsSyn5 (Exp1)
	| HappyAbsSyn6 (Term)
	| HappyAbsSyn7 (Factor)

happyActOffsets :: HappyAddr
happyActOffsets = HappyA# "\x01\x00\x25\x00\x1e\x00\x1b\x00\x1d\x00\x18\x00\x00\x00\x00\x00\x00\x00\x01\x00\xf8\xff\x03\x00\x03\x00\x03\x00\x03\x00\x20\x00\x01\x00\x18\x00\x18\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x01\x00\x00\x00\x00\x00"#

happyGotoOffsets :: HappyAddr
happyGotoOffsets = HappyA# "\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x07\x00\xfe\xff\x1c\x00\x06\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x00\x00"#

happyDefActions :: HappyAddr
happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\xfd\xff\xfa\xff\xf7\xff\xf6\xff\xf5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xfc\xff\xf8\xff\xf9\xff\xf4\xff\x00\x00\x00\x00\xfe\xff"#

happyCheck :: HappyAddr
happyCheck = HappyA# "\xff\xff\x03\x00\x01\x00\x0b\x00\x03\x00\x04\x00\x03\x00\x04\x00\x02\x00\x03\x00\x03\x00\x0a\x00\x02\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x02\x00\x03\x00\x08\x00\x09\x00\x04\x00\x06\x00\x07\x00\x05\x00\x01\x00\x0c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#

happyTable :: HappyAddr
happyTable = HappyA# "\x00\x00\x13\x00\x03\x00\x16\x00\x08\x00\x09\x00\x08\x00\x09\x00\x11\x00\x06\x00\x14\x00\x0a\x00\x18\x00\x0a\x00\x18\x00\x04\x00\x05\x00\x06\x00\x16\x00\x04\x00\x05\x00\x06\x00\x0a\x00\x04\x00\x05\x00\x06\x00\x03\x00\x04\x00\x05\x00\x06\x00\x12\x00\x06\x00\x0c\x00\x0d\x00\x10\x00\x0e\x00\x0f\x00\x11\x00\x03\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#

happyReduceArr = array (1, 11) [
	(1 , happyReduce_1),
	(2 , happyReduce_2),
	(3 , happyReduce_3),
	(4 , happyReduce_4),
	(5 , happyReduce_5),
	(6 , happyReduce_6),
	(7 , happyReduce_7),
	(8 , happyReduce_8),
	(9 , happyReduce_9),
	(10 , happyReduce_10),
	(11 , happyReduce_11)
	]

happy_n_terms = 13 :: Int
happy_n_nonterms = 4 :: Int

happyReduce_1 = happyReduce 6# 0# happyReduction_1
happyReduction_1 ((HappyAbsSyn4  happy_var_6) `HappyStk`
	_ `HappyStk`
	(HappyAbsSyn4  happy_var_4) `HappyStk`
	_ `HappyStk`
	(HappyTerminal (TokenVar happy_var_2)) `HappyStk`
	_ `HappyStk`
	happyRest)
	 = HappyAbsSyn4
		 (Let happy_var_2 happy_var_4 happy_var_6
	) `HappyStk` happyRest

happyReduce_2 = happySpecReduce_1  0# happyReduction_2
happyReduction_2 (HappyAbsSyn5  happy_var_1)
	 =  HappyAbsSyn4
		 (Exp1 happy_var_1
	)
happyReduction_2 _  = notHappyAtAll

happyReduce_3 = happySpecReduce_3  1# happyReduction_3
happyReduction_3 (HappyAbsSyn6  happy_var_3)
	_
	(HappyAbsSyn5  happy_var_1)
	 =  HappyAbsSyn5
		 (Plus happy_var_1 happy_var_3
	)
happyReduction_3 _ _ _  = notHappyAtAll

happyReduce_4 = happySpecReduce_3  1# happyReduction_4
happyReduction_4 (HappyAbsSyn6  happy_var_3)
	_
	(HappyAbsSyn5  happy_var_1)
	 =  HappyAbsSyn5
		 (Minus happy_var_1 happy_var_3
	)
happyReduction_4 _ _ _  = notHappyAtAll

happyReduce_5 = happySpecReduce_1  1# happyReduction_5
happyReduction_5 (HappyAbsSyn6  happy_var_1)
	 =  HappyAbsSyn5
		 (Term happy_var_1
	)
happyReduction_5 _  = notHappyAtAll

happyReduce_6 = happySpecReduce_3  2# happyReduction_6
happyReduction_6 (HappyAbsSyn7  happy_var_3)
	_
	(HappyAbsSyn6  happy_var_1)
	 =  HappyAbsSyn6
		 (Times happy_var_1 happy_var_3
	)
happyReduction_6 _ _ _  = notHappyAtAll

happyReduce_7 = happySpecReduce_3  2# happyReduction_7
happyReduction_7 (HappyAbsSyn7  happy_var_3)
	_
	(HappyAbsSyn6  happy_var_1)
	 =  HappyAbsSyn6
		 (Div happy_var_1 happy_var_3
	)
happyReduction_7 _ _ _  = notHappyAtAll

happyReduce_8 = happySpecReduce_1  2# happyReduction_8
happyReduction_8 (HappyAbsSyn7  happy_var_1)
	 =  HappyAbsSyn6
		 (Factor happy_var_1
	)
happyReduction_8 _  = notHappyAtAll

happyReduce_9 = happySpecReduce_1  3# happyReduction_9
happyReduction_9 (HappyTerminal (TokenInt happy_var_1))
	 =  HappyAbsSyn7
		 (Int happy_var_1
	)
happyReduction_9 _  = notHappyAtAll

happyReduce_10 = happySpecReduce_1  3# happyReduction_10
happyReduction_10 (HappyTerminal (TokenVar happy_var_1))
	 =  HappyAbsSyn7
		 (Var happy_var_1
	)
happyReduction_10 _  = notHappyAtAll

happyReduce_11 = happySpecReduce_3  3# happyReduction_11
happyReduction_11 _
	(HappyAbsSyn4  happy_var_2)
	_
	 =  HappyAbsSyn7
		 (Brack happy_var_2
	)
happyReduction_11 _ _ _  = notHappyAtAll

happyNewToken action sts stk [] =
	happyDoAction 12# notHappyAtAll action sts stk []

happyNewToken action sts stk (tk:tks) =
	let cont i = happyDoAction i tk action sts stk tks in
	case tk of {
	TokenLet -> cont 1#;
	TokenIn -> cont 2#;
	TokenInt happy_dollar_dollar -> cont 3#;
	TokenVar happy_dollar_dollar -> cont 4#;
	TokenEq -> cont 5#;
	TokenPlus -> cont 6#;
	TokenMinus -> cont 7#;
	TokenTimes -> cont 8#;
	TokenDiv -> cont 9#;
	TokenOB -> cont 10#;
	TokenCB -> cont 11#;
	_ -> happyError' (tk:tks)
	}

happyError_ tk tks = happyError' (tk:tks)

newtype HappyIdentity a = HappyIdentity a
happyIdentity = HappyIdentity
happyRunIdentity (HappyIdentity a) = a

instance Functor HappyIdentity where
    fmap = liftM

instance Applicative HappyIdentity where
    pure = return
    (<*>) = ap

instance Monad HappyIdentity where
    return = HappyIdentity
    (HappyIdentity p) >>= q = q p

happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b
happyThen = (>>=)
happyReturn :: () => a -> HappyIdentity a
happyReturn = (return)
happyThen1 m k tks = (>>=) m (\a -> k a tks)
happyReturn1 :: () => a -> b -> HappyIdentity a
happyReturn1 = \a tks -> (return) a
happyError' :: () => [Token] -> HappyIdentity a
happyError' = HappyIdentity . happyError

calc tks = happyRunIdentity happySomeParser where
  happySomeParser = happyThen (happyParse 0# tks) (\x -> case x of {HappyAbsSyn4 z -> happyReturn z; _other -> notHappyAtAll })

happySeq = happyDontSeq

happyError tks = error "Parse error"

data Exp  = Let String Exp Exp | Exp1 Exp1
data Exp1 = Plus Exp1 Term | Minus Exp1 Term | Term Term
data Term = Times Term Factor | Div Term Factor | Factor Factor
data Factor = Int Int | Var String | Brack Exp

data Token
	= TokenLet
	| TokenIn
	| TokenInt Int
	| TokenVar String
	| TokenEq
	| TokenPlus
	| TokenMinus
	| TokenTimes
	| TokenDiv
	| TokenOB
	| TokenCB

lexer :: String -> [Token]
lexer [] = []
lexer (c:cs)
	| isSpace c = lexer cs
	| isAlpha c = lexVar (c:cs)
	| isDigit c = lexNum (c:cs)
lexer ('=':cs) = TokenEq : lexer cs
lexer ('+':cs) = TokenPlus : lexer cs
lexer ('-':cs) = TokenMinus : lexer cs
lexer ('*':cs) = TokenTimes : lexer cs
lexer ('/':cs) = TokenDiv : lexer cs
lexer ('(':cs) = TokenOB : lexer cs
lexer (')':cs) = TokenCB : lexer cs

lexNum cs = TokenInt (read num) : lexer rest
	where (num,rest) = span isDigit cs

lexVar cs =
   case span isAlpha cs of
	("let",rest) -> TokenLet : lexer rest
	("in",rest)  -> TokenIn : lexer rest
	(var,rest)   -> TokenVar var : lexer rest

runCalc :: String -> Exp
runCalc = calc . lexer

main = case runCalc "1 + 2 + 3" of {
	(Exp1 (Plus (Plus (Term (Factor (Int 1))) (Factor (Int 2))) (Factor (Int 3))))  ->
	case runCalc "1 * 2 + 3" of {
	(Exp1 (Plus (Term (Times (Factor (Int 1)) (Int 2))) (Factor (Int 3)))) ->
	case runCalc "1 + 2 * 3" of {
	(Exp1 (Plus (Term (Factor (Int 1))) (Times (Factor (Int 2)) (Int 3)))) ->
	case runCalc "let x = 2 in x * (x - 2)" of {
	(Let "x" (Exp1 (Term (Factor (Int 2)))) (Exp1 (Term (Times (Factor (Var "x")) (Brack (Exp1 (Minus (Term (Factor (Var "x"))) (Factor (Int 2))))))))) -> print "Test works\n";
	_ -> quit } ; _ -> quit } ; _ -> quit } ; _ -> quit }
quit = print "Test failed\n"
{-# LINE 1 "GenericTemplate.hs" #-}
{-# LINE 1 "<built-in>" #-}
{-# LINE 1 "<command line>" #-}
{-# LINE 1 "GenericTemplate.hs" #-}
-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp

{-# LINE 28 "GenericTemplate.hs" #-}

data Happy_IntList = HappyCons Int# Happy_IntList

{-# LINE 49 "GenericTemplate.hs" #-}

{-# LINE 59 "GenericTemplate.hs" #-}

happyTrace string expr = unsafePerformIO $ do
    hPutStr stderr string
    return expr

infixr 9 `HappyStk`
data HappyStk a = HappyStk a (HappyStk a)

-----------------------------------------------------------------------------
-- starting the parse

happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll

-----------------------------------------------------------------------------
-- Accepting the parse

-- If the current token is 0#, it means we've just accepted a partial
-- parse (a %partial parser).  We must ignore the saved token on the top of
-- the stack in this case.
happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
	happyReturn1 ans
happyAccept j tk st sts (HappyStk ans _) =
	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)

-----------------------------------------------------------------------------
-- Arrays only: do the next action

happyDoAction i tk st
	= (happyTrace ("state: " ++ show (I# (st)) ++  		      ",\ttoken: " ++ show (I# (i)) ++ 		      ",\taction: ")) $

	  case action of
		0#		  -> (happyTrace ("fail.\n")) $
				     happyFail i tk st
		-1# 	  -> (happyTrace ("accept.\n")) $
				     happyAccept i tk st
		n | isTrue# (n <# (0# :: Int#)) -> (happyTrace ("reduce (rule " ++ show rule 						 ++ ")")) $

				     (happyReduceArr ! rule) i tk st
				     where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))
		n		  -> (happyTrace ("shift, enter state " 						 ++ show (I# (new_state)) 						 ++ "\n")) $

				     happyShift new_state i tk st
				     where new_state = (n -# (1# :: Int#))
   where off    = indexShortOffAddr happyActOffsets st
	 off_i  = (off +# i)
	 check  = if isTrue# (off_i >=# (0# :: Int#))
			then isTrue# (indexShortOffAddr happyCheck off_i ==#  i)
			else False
 	 action | check     = indexShortOffAddr happyTable off_i
		| otherwise = indexShortOffAddr happyDefActions st

{-# LINE 127 "GenericTemplate.hs" #-}

indexShortOffAddr (HappyA# arr) off =
	narrow16Int# i
  where
	i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
	high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
	low  = int2Word# (ord# (indexCharOffAddr# arr off'))
	off' = off *# 2#

data HappyAddr = HappyA# Addr#

-----------------------------------------------------------------------------
-- HappyState data type (not arrays)

{-# LINE 170 "GenericTemplate.hs" #-}

-----------------------------------------------------------------------------
-- Shifting a token

happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =
     let i = (case x of { HappyErrorToken (I# (i)) -> i }) in
--     trace "shifting the error token" $
     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)

happyShift new_state i tk st sts stk =
     happyNewToken new_state (HappyCons (st) (sts)) ((HappyTerminal (tk))`HappyStk`stk)

-- happyReduce is specialised for the common cases.

happySpecReduce_0 i fn 0# tk st sts stk
     = happyFail 0# tk st sts stk
happySpecReduce_0 nt fn j tk st@((action)) sts stk
     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)

happySpecReduce_1 i fn 0# tk st sts stk
     = happyFail 0# tk st sts stk
happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')
     = let r = fn v1 in
       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))

happySpecReduce_2 i fn 0# tk st sts stk
     = happyFail 0# tk st sts stk
happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')
     = let r = fn v1 v2 in
       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))

happySpecReduce_3 i fn 0# tk st sts stk
     = happyFail 0# tk st sts stk
happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
     = let r = fn v1 v2 v3 in
       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))

happyReduce k i fn 0# tk st sts stk
     = happyFail 0# tk st sts stk
happyReduce k nt fn j tk st sts stk
     = case happyDrop (k -# (1# :: Int#)) sts of
	 !sts1@((HappyCons (st1@(action)) (_))) ->
        	let r = fn stk in  -- it doesn't hurt to always seq here...
       		happyDoSeq r (happyGoto nt j tk st1 sts1 r)

happyMonadReduce k nt fn 0# tk st sts stk
     = happyFail 0# tk st sts stk
happyMonadReduce k nt fn j tk st sts stk =
        happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
       where !sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
             drop_stk = happyDropStk k stk

happyMonad2Reduce k nt fn 0# tk st sts stk
     = happyFail 0# tk st sts stk
happyMonad2Reduce k nt fn j tk st sts stk =
       happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
       where !sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
             drop_stk = happyDropStk k stk

             off    = indexShortOffAddr happyGotoOffsets st1
             off_i  = (off +# nt)
             new_state = indexShortOffAddr happyTable off_i

happyDrop 0# l = l
happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t

happyDropStk 0# l = l
happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs

-----------------------------------------------------------------------------
-- Moving to a new state after a reduction

happyGoto nt j tk st =
   (happyTrace (", goto state " ++ show (I# (new_state)) ++ "\n")) $
   happyDoAction j tk new_state
   where off    = indexShortOffAddr happyGotoOffsets st
	 off_i  = (off +# nt)
 	 new_state = indexShortOffAddr happyTable off_i

-----------------------------------------------------------------------------
-- Error recovery (0# is the error token)

-- parse error if we are in recovery and we fail again
happyFail  0# tk old_st _ stk =
--	trace "failing" $
    	happyError_ tk

{-  We don't need state discarding for our restricted implementation of
    "error".  In fact, it can cause some bogus parses, so I've disabled it
    for now --SDM

-- discard a state
happyFail  0# tk old_st (HappyCons ((action)) (sts))
						(saved_tok `HappyStk` _ `HappyStk` stk) =
--	trace ("discarding state, depth " ++ show (length stk))  $
	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
-}

-- Enter error recovery: generate an error token,
--                       save the old token and carry on.
happyFail  i tk (action) sts stk =
--      trace "entering error recovery" $
	happyDoAction 0# tk action sts ( (HappyErrorToken (I# (i))) `HappyStk` stk)

-- Internal happy errors:

notHappyAtAll = error "Internal Happy error\n"

-----------------------------------------------------------------------------
-- Hack to get the typechecker to accept our action functions

happyTcHack :: Int# -> a -> a
happyTcHack x y = y
{-# INLINE happyTcHack #-}

-----------------------------------------------------------------------------
-- Seq-ing.  If the --strict flag is given, then Happy emits
--	happySeq = happyDoSeq
-- otherwise it emits
-- 	happySeq = happyDontSeq

happyDoSeq, happyDontSeq :: a -> b -> b
happyDoSeq   a b = a `seq` b
happyDontSeq a b = b

-----------------------------------------------------------------------------
-- Don't inline any functions from the template.  GHC has a nasty habit
-- of deciding to inline happyGoto everywhere, which increases the size of
-- the generated parser quite a bit.

{-# NOINLINE happyDoAction #-}
{-# NOINLINE happyTable #-}
{-# NOINLINE happyCheck #-}
{-# NOINLINE happyActOffsets #-}
{-# NOINLINE happyGotoOffsets #-}
{-# NOINLINE happyDefActions #-}

{-# NOINLINE happyShift #-}
{-# NOINLINE happySpecReduce_0 #-}
{-# NOINLINE happySpecReduce_1 #-}
{-# NOINLINE happySpecReduce_2 #-}
{-# NOINLINE happySpecReduce_3 #-}
{-# NOINLINE happyReduce #-}
{-# NOINLINE happyMonadReduce #-}
{-# NOINLINE happyGoto #-}
{-# NOINLINE happyFail #-}

-- end of Happy Template.


import Control.Monad.Fix
import Data.IORef
import Prelude hiding (traverse)

data N a = N (IORef Bool, N a, a, N a)

newNode :: N a -> a -> N a -> IO (N a)
newNode b c f = do v  <- newIORef False
                   return (N (v, b, c, f))

ll = mdo n0 <- newNode n3 0 n1
         n1 <- newNode n0 1 n2
         n2 <- newNode n1 2 n3
         n3 <- newNode n2 3 n0
         return n0

data Dir = F | B deriving Eq

traverse :: Dir -> N a -> IO [a]
traverse d (N (v, b, i, f)) =
    do visited <- readIORef v
       if visited
          then return []
          else do writeIORef v True
                  let next = if d == F then f else b
                  is <- traverse d next
                  return (i:is)

l2dll :: [a] -> IO (N a)
l2dll (x:xs) = mdo c      <- newNode l x f
                   (f, l) <- l2dll' c xs
                   return c

l2dll' :: N a -> [a] -> IO (N a, N a)
l2dll' p []     = return (p, p)
l2dll' p (x:xs) = mdo c      <- newNode p x f
                      (f, l) <- l2dll' c xs
                      return (c, l)


module QSort where

qsort [] = []
qsort (a:as) = (qsort left) ++ [a] ++ (qsort right)
 where (left,right) = (filter (<=a) as, filter (>a) as)

run = qsort [8 :: Int, 4, 0, 3, 1, 23, 11, 18]

-- > run
-- [0,1,3,4,8,11,18,23]


module Test.Test2 where
import Data.Typeable

data Show1 = S1 Char Char Char
 deriving Typeable

data Strict = S2 Char !Char

data Opaque = forall a. O a
data List1 a = Nil | a :^ (List1 a)
  deriving Show

newtype MyInt = My Int
  deriving (Eq,Show,Num, Enum)

newtype MkT a = MkT a
  deriving (Show)

newtype MkT2 a = MkT2 (MkT a)
  deriving Show

data Param2 s r = P2 (FakeSTRef r (s(Param2 s r)))
                | P2Nil
data FakeSTRef r s = Ref s

testParam2 = O (P2 (Ref P2Nil))

infixr 5 :^
--test T{t=t1} = undefined

instance Show Show1 where
 show (S1 a b c) = show (a)

type Just1 = Maybe

data Unary = Unary deriving Show

poly :: a -> ()
poly x = seq x ()


mymap f [] = []
mymap f (x:xs) = f x:mymap f xs

main = mapM_ putStrLn $ mymap ('a':) ["hello","bye"]


data T a b = T (a -> b)

f g y = () where x = T g


f xs = head xs

g xs = f xs

main = g []


import Control.Exception
main = evaluate (error "foo")


data Unboxed1 = Unboxed1 (# Int, Bool #)

data Unboxed2 = Unboxed2 (# Int, (# Int, Bool #) #)

o1 = Unboxed1 (# 5, True #)
o2 = Unboxed2 (# 6, (# 7, False #) #)

force_them :: Int
force_them = x + (if b then 1 else 2) + y + z + (if c then 3 else 4)
  where
    Unboxed1 (# x, b #) = o1
    Unboxed2 (# y, (# z, c #) #) = o2


g i = let a = i + 1
          b = id
          c = ()
          d = (+)
      in (a,b,c,d)


g i = (a,b,c)
      where a = False
            b = True
            c = ()


g i = let a = False
          b = True
          c = (a,b)
      in c


f i = if ?flag then i*2 else i

g i = let ?flag=False in f i


import Break020b

line1 _ = return ()
line2 _ = return ()

in_another_decl _ = do line1 0
                       line2 0

main = do
  line1 0
  line2 0
  in_another_decl 0
  in_another_module 0
  line2 1
  return ()


module Break020b where

in_another_module _ = return ()


import Control.Exception as CE

exception_uncaught = ioError (userError "error")
exception_caught   = CE.try exception_uncaught :: IO (Either CE.IOException ())


module Test where

import Prelude hiding (foldl)

foldl f c xs = go c xs
  where go c []     = c
        go c (x:xs) = go (f c x) xs


{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}

type family Id x
type instance Id Int = Int
type instance Id Bool = Bool

class Convert x y where convert :: x -> y
instance Convert x x where convert = id

f :: Convert a (Id a) => a -> Id a
f x = convert x

g :: Convert a (Id a) => a -> Id a
g x = let x' = f x in x'


{-# LANGUAGE ApplicativeDo #-}

f :: Int -> IO Int
f x = do
  y <- return (x + 1)
  return (y * 2)


import TupleN

tuple3 x = $(tuple 3) x

normal_fn x = tuple3 x


f :: Maybe Int
f = do
   i <- return 1
   j <- return 2
   k <- return 3
   return i


{-# LANGUAGE MagicHash, BangPatterns #-}

import GHC.Base

f :: Int -> Int# ->  Int#
f x i = i

test = let !(I# i) = 3 in I# (f 2 i)


import System.Directory

main = do
  setCurrentDirectory ".."
  putStrLn "Hello World"


{-# LANGUAGE MagicHash #-}
import GHC.Exts
data T = C Int# Word# Float# Double# Char# Int Float Double
test = C 1# 32## 1.2# 1.23## 'x'# 1 1.2 1.23

data TwoFields = TwoFields Char Int deriving Show

data T2 = C2 {-# UNPACK #-} !Int {-#UNPACK#-} !Word {-# UNPACK #-} !TwoFields deriving Show
test2 = C2 1 32 (TwoFields 'a' 3)

f x = x


newtype MkT2 a = MkT2 [Maybe a] deriving Show

f :: t Int -> t Int
f x = x

f2 :: t Int -> t Int -> (t Int, t Int)
f2 x y = (x,y)


module Print031 where

newtype MkT2 a = MkT2 [Maybe a] deriving Show
data Phantom a = Phantom Int deriving Show

f :: t (Phantom a) -> Bool
f x = const False x -- const just to bring x into scope


f xs = case map id xs of
         [] -> True
         x:xs -> False


{-# LANGUAGE MagicHash #-}
module T13825 where

import GHC.Exts
import Data.Word
import Data.Int

data Packed1 = Packed1 Float# Float# Int# Float#
    deriving Show

data Packed2 =
    Packed2
        {-# UNPACK #-} !Float
        {-# UNPACK #-} !Float
        {-# UNPACK #-} !Int
        {-# UNPACK #-} !Float
    deriving Show

data Packed3 =
    Packed3
        {-# UNPACK #-} !Word8
        {-# UNPACK #-} !Int8
        {-# UNPACK #-} !Int64
        {-# UNPACK #-} !Word16
        {-# UNPACK #-} !Word64
        {-# UNPACK #-} !Word32
        {-# UNPACK #-} !Float
        {-# UNPACK #-} !Double
    deriving Show

packed1 = Packed1 12.34# 56.78# 42# 99.99#
packed2 = Packed2 12.34 56.78 42 99.99
packed3 = Packed3 1 2 3 4 5 6 7.8 9.0


module Test where

f x y z | x<y       = z
        | otherwise = z*y


{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeFamilies, PolyKinds #-}

module T7386 where

data Nat = Zero | Succ Nat
data family Sing (a :: k)
data instance Sing (a :: Nat) where
   SZero :: Sing Zero
   SSucc :: Sing n -> Sing (Succ n)


{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}
module T8557 where

data family Sing (a :: k)
data instance Sing (a :: [k]) = SNil

x :: Sing '[]
x = SNil


module TupleN where
import Language.Haskell.TH

tuple :: Int -> ExpQ
tuple n = [|\list -> $(tupE (exprs [|list|])) |]
  where
    exprs list = id [infixE (Just (list))
                           (varE '(!!))
                           (Just (litE $ integerL (toInteger num)))
                      | num <- [0..(n - 1)]]


module A where
import {-# SOURCE #-} B

a x = b x


-- #hide
module Hidden where
hidden :: Int -> Int
hidden a = a


{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Test
-- Copyright   :  (c) Simon Marlow 2002
-- License     :  BSD-style
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- This module illustrates & tests most of the features of Haddock.
-- Testing references from the description: 'T', 'f', 'g', 'Visible.visible'.
--
-----------------------------------------------------------------------------

-- This is plain comment, ignored by Haddock.

module Test (

        -- Section headings are introduced with '-- *':
        -- * Type declarations

        -- Subsection headings are introduced with '-- **' and so on.
        -- ** Data types
        T(..), T2, T3(..), T4(..), T5(..), T6(..),
        N1(..), N2(..), N3(..), N4, N5(..), N6(..), N7(..),

        -- ** Records
        R(..), R1(..),

        -- | test that we can export record selectors on their own:
        p, q, u,

        -- * Class declarations
        C(a,b), D(..), E, F(..),

        -- | Test that we can export a class method on its own:
        a,

        -- * Function types
        f, g,

        -- * Auxiliary stuff

        -- $aux1

        -- $aux2

        -- $aux3

        -- $aux4

        -- $aux5

        -- $aux6

        -- $aux7

        -- $aux8

        -- $aux9

        -- $aux10

        -- $aux11

        -- $aux12

        -- | This is some inline documentation in the export list
        --
        -- > a code block using bird-tracks
        -- > each line must begin with > (which isn't significant unless it
        -- > is at the beginning of the line).

        -- * A hidden module
        module Hidden,

        -- * A visible module
        module Visible,

        {-| nested-style doc comments -}

        -- * Existential \/ Universal types
        Ex(..),

        -- * Type signatures with argument docs
        k, l, m, o,

        -- * A section
        -- and without an intervening comma:
        -- ** A subsection

{-|
 > a literal line

 $ a non /literal/ line $
-}

        f',
   ) where

import Hidden
import Visible

-- | This comment applies to the /following/ declaration
-- and it continues until the next non-comment line
data T a b
 = A Int (Maybe Float) -- ^ This comment describes the 'A' constructor
 | -- | This comment describes the 'B' constructor
   B (T a b, T Int Float) -- ^

-- | An abstract data declaration
data T2 a b = T2 a b

-- | A data declaration with no documentation annotations on the constructors
data T3 a b = A1 a | B1 b

-- A data declaration with no documentation annotations at all
data T4 a b = A2 a | B2 b

-- A data declaration documentation on the constructors only
data T5 a b
  = A3 a -- ^ documents 'A3'
  | B3 b -- ^ documents 'B3'

-- | Testing alternative comment styles
data T6
  -- | This is the doc for 'A4'
  = A4
  | B4
  | -- ^ This is the doc for 'B4'

    -- | This is the doc for 'C4'
    C4

-- | A newtype
newtype N1 a = N1 a

-- | A newtype with a fieldname
newtype N2 a b = N2 {n :: a b}

-- | A newtype with a fieldname, documentation on the field
newtype N3 a b = N3 {n3 :: a b -- ^ this is the 'n3' field
                    }

-- | An abstract newtype - we show this one as data rather than newtype because
-- the difference isn\'t visible to the programmer for an abstract type.
newtype N4 a b = N4 a

newtype N5 a b = N5 {n5 :: a b -- ^ no docs on the datatype or the constructor
                    }

newtype N6 a b = N6 {n6 :: a b
                    }
                 -- ^ docs on the constructor only

-- | docs on the newtype and the constructor
newtype N7 a b = N7 {n7 :: a b
                    }
                -- ^ The 'N7' constructor

class (D a) => C a  where
   -- |this is a description of the 'a' method
   a :: IO a
   b :: [a]
   -- ^ this is a description of the 'b' method
   c :: a -- c is hidden in the export list

-- ^ This comment applies to the /previous/ declaration (the 'C' class)

class D a where
   d :: T a b
   e :: (a,a)
-- ^ This is a class declaration with no separate docs for the methods

instance D Int where
  d = undefined
  e = undefined

-- instance with a qualified class name
instance Test.D Float where
  d = undefined
  e = undefined

class E a where
  ee :: a
-- ^ This is a class declaration with no methods (or no methods exported)

-- This is a class declaration with no documentation at all
class F a where
  ff :: a

-- | This is the documentation for the 'R' record, which has four fields,
-- 'p', 'q', 'r', and 's'.
data R =
  -- | This is the 'C1' record constructor, with the following fields:
  C1 { p :: Int -- ^ This comment applies to the 'p' field
     , q :: forall a . a->a  -- ^ This comment applies to the 'q' field
     , -- | This comment applies to both 'r' and 's'
       r,s :: Int
     }
  | C2 { t :: T1 -> (T2 Int Int)-> (T3 Bool Bool) -> (T4 Float Float) -> T5 () (),
       u,v :: Int
     }
  -- ^ This is the 'C2' record constructor, also with some fields:

-- | Testing different record commenting styles
data R1
  -- | This is the 'C3' record constructor
  = C3 {
        -- | The 's1' record selector
          s1 :: Int
        -- | The 's2' record selector
        , s2 :: Int
        , s3 :: Int  -- NOTE: In the original examples/Test.hs in Haddock, there is an extra "," here.
                     -- Since GHC doesn't allow that, I have removed it in this file.
        -- ^ The 's3' record selector
     }

-- These section headers are only used when there is no export list to
-- give the structure of the documentation:

-- * This is a section header (level 1)
-- ** This is a section header (level 2)
-- *** This is a section header (level 3)

{-|
In a comment string we can refer to identifiers in scope with
single quotes like this: 'T', and we can refer to modules by
using double quotes: "Foo".  We can add emphasis /like this/.

   * This is a bulleted list

   - This is the next item (different kind of bullet)

   (1) This is an ordered list

   2. This is the next item (different kind of bullet)

@
     This is a block of code, which can include other markup: 'R'
     formatting
               is
                 significant
@

> this is another block of code

We can also include URLs in documentation: <http://www.haskell.org/>.
-}

f :: C a => a -> Int

-- | we can export foreign declarations too
foreign import ccall "header.h" g :: Int -> IO CInt

-- | this doc string has a parse error in it: \'
h :: Int
h = 42

-- $aux1 This is some documentation that is attached to a name ($aux1)
-- rather than a source declaration.  The documentation may be
-- referred to in the export list using its name.
--
-- @ code block in named doc @

-- $aux2 This is some documentation that is attached to a name ($aux2)

-- $aux3
-- @ code block on its own in named doc @

-- $aux4
--
-- @ code block on its own in named doc (after newline) @

{- $aux5 a nested, named doc comment

   with a paragraph,

   @ and a code block @
-}

-- some tests for various arrangements of code blocks:

{- $aux6
>test
>test1

@ test2
  test3
@
-}

{- $aux7
@
test1
test2
@
-}

{- $aux8
>test3
>test4
-}

{- $aux9
@
test1
test2
@

>test3
>test4
-}

{- $aux10
>test3
>test4

@
test1
test2
@
-}

-- This one is currently wrong (Haddock 0.4).  The @...@ part is
-- interpreted as part of the bird-tracked code block.
{- $aux11
aux11:

>test3
>test4

@
test1
test2
@
-}

-- $aux12
-- > foo
--
-- > bar
--

-- | A data-type using existential\/universal types
data Ex a
  = forall b . C b => Ex1 b
  | forall b . Ex2 b
  | forall b . C a => Ex3 b -- NOTE: I have added "forall b" here make GHC accept this file
  | Ex4 (forall a . a -> a)

-- | This is a function with documentation for each argument
k :: T () ()      -- ^ This argument has type 'T'
  -> (T2 Int Int) -- ^ This argument has type 'T2 Int Int'
  -> (T3 Bool Bool -> T4 Float Float) -- ^ This argument has type @T3 Bool Bool -> T4 Float Float@
  -> T5 () ()     -- ^ This argument has a very long description that should
                  -- hopefully cause some wrapping to happen when it is finally
                  -- rendered by Haddock in the generated HTML page.
  -> IO ()        -- ^ This is the result type

-- This function has arg docs but no docs for the function itself
l :: (Int, Int, Float) -- ^ takes a triple
  -> Int -- ^ returns an 'Int'

-- | This function has some arg docs
m :: R
  -> N1 ()      -- ^ one of the arguments
  -> IO Int     -- ^ and the return value

-- | This function has some arg docs but not a return value doc

-- can't use the original name ('n') with GHC
newn :: R               -- ^ one of the arguments, an 'R'
     -> N1 ()           -- ^ one of the arguments
     -> IO Int
newn = undefined

-- | A foreign import with argument docs
foreign import ccall unsafe "header.h"
 o :: Float  -- ^ The input float
   -> IO Float  -- ^ The output float

-- | We should be able to escape this: \#\#\#

-- p :: Int
-- can't use the above original definition with GHC
newp :: Int
newp = undefined

-- | a function with a prime can be referred to as 'f''
-- but f' doesn't get link'd 'f\''
f' :: Int

-- Add some definitions here so that this file can be compiled with GHC

data T1
f = undefined
f' = undefined
type CInt = Int
k = undefined
l = undefined
m = undefined


module Visible where
visible :: Int -> Int
visible a = a


module ShouldCompile where

{- | blabla -}
data Bla = Hej


module ShouldCompile where

{- | blabla -}
main = undefined


module ShouldCompile where

-- | blabla
main = undefined


module ShouldCompile where

-- | blabla öqewjlaskjfdasklöjfaslökj
-- aslfdjaskldaskldasjda
-- xxxxxx
-- end of the comment
main = undefined


hej = undefined

-- | 1l3i1j3 as
main = undefined


{-^ wealwwwwwwwwwwww

-}
main = return ()


module ShouldCompile where

{- |asd-}
main=undefined


module ShouldCompile where

{-|
main=undefined
-}
main = undefined


module ShouldCompile where

{-$ aslkdjasasd asdkjasdlaj {-weqw -}-}
main = undefined


module ShouldCompile where

{-| weoprjwer {- | qwoiejqwioe -}-}
main = undefined


module ShouldCompile where

-- aslkdjasldkjasldkaj
-- | awlkdajsads
-- asdasödlklas
--qww
main=undefined


main=undefined

-- | vkfja
hej=main
-- | ieasdkjahsdkjashd
x = hej

-- | eroiewuroieuwr
y = undefined


module ShouldCompile where

-- ^ bla
main=undefined

-- ^ vkfja
hej=main
-- ^ ieasdkjahsdkjashd
x = hej

-- ^ eroiewuroieuwr
y = undefined


-- | a header
module HeaderTest where

-- | bla bla
x = 0


-- | a header
module HeaderTest where

-- * A section
x = 0

-- ** A subsection
y = 1

-- *** A subsubsection
main = print x

-- | bla bla
z = 0


-- #hide, prune, ignore-exports

-- |Module description
module A where


-- #hide, prune, ignore-exports
module A where


-- | module header bla bla

-- #hide, prune, ignore-exports
module A where


module A (

-- | bla bla

{- | blabla -}

) where


module A (

-- | bla bla

{- | blabla -}

x,

-- ** qeÃ¶qwkeÃ¶wqlkeqÃ¶le

-- | qweljqwelkqjwelqjkq

) where

x = True


module A (

-- | bla bla

{- | blabla -}

x,

-- ** qeÃ¶qwkeÃ¶wqlkeqÃ¶le

-- | qweljqwelkqjwelqjkq

y,

-- | dkashdakj
z

-- * asdjha

) where

x = True
y = False
z = True


main = print (test::Int)
  where
    -- | kjfhaskd
    test = 0
    -- | xzczn
    -- qwelkjqwelkqj
    test2 = 1

    -- | adlkjadajdldjad
    test3 = 2


{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module ShouldCompile where

test :: (Eq a) => [a] -- ^ doc1
               -> [a] {-^ doc2 -}
               -> [a] -- ^ doc3
test xs ys = xs


module ShouldCompile where

test2 :: a -- ^ doc1
        -> b {-^ doc2 -} -> a -- ^ doc 3
test2 x y = x


module ShouldCompile where

test2 :: a -- ^ doc1
         -> a
test2 x = x


{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module ShouldCompile where

test :: (Eq a) => [a] -- ^ doc1
               -> forall b . [b] {-^ doc2 -}
               -> [a] -- ^ doc3
test xs ys = xs


{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module ShouldCompile where

test :: [a] -- ^ doc1
        -> forall b. (Ord b) => [b] {-^ doc2 -}
        -> forall c. (Num c) => [c] -- ^ doc3
        -> [a]
test xs ys zs = xs


module ShouldCompile where

data a <--> b = Mk a b

test :: [a] -- ^ doc1
        -> a <--> b
        -> [a] -- ^ blabla
test xs ys = xs


module ShouldCompile where

data A
  -- | A comment that documents the first constructor
  = A | B | C | D


module ShouldCompile where

data A
  -- | A comment that documents the first constructor
  = A
  -- | comment for B
  | {-^ comment for A -} B
  -- | comment for C
  | C
  | D


module ShouldCompile where

data A
  = A
  | {-| comment for B -} forall a. B a a
  | forall a. Num a => C a {-^ comment for C -}


module ShouldCompile where

data R a = R {
    field1 :: a -- | comment for field2
  , field2 :: a
  , field3 :: a -- ^ comment for field3
  , {-| comment for field4 -} field4 :: a
}


module ShouldCompile where

-- | dlkjasldkja
f 0 = 1
-- | falkajflksjfa
f 1 = 2
-- | slkdjasldkj
f 3 = 6
-- | asldfaslÃ¶djas

-- | blabla


{-# LANGUAGE GADTs #-}

module Hi where

-- | This is a GADT.
data Hi where
    -- | This is a GADT constructor.
    Hi :: () -> Hi


{-# LANGUAGE GADTs #-}

module Hi where

data Hi where
    Hi :: () -- ^ This is a comment on the '()' field of 'Hi'
       -> Int
       -> String -- ^ This is a comment on the 'String' field of 'Hi'
       -> Hi -- ^ This is a comment on the return type of 'Hi'


module ConstructorFields where

data Foo
  = Bar Int String  -- ^ doc on `Bar` constructor

  | Baz             -- ^ doc on the `Baz` constructor
      Int           -- ^ doc on the `Int` field of `Baz`
      String        -- ^ doc on the `String` field of `Baz`

  | Int :+ String   -- ^ doc on the `:+` constructor

  | Int             -- ^ doc on the `Int` field of the `:*` constructor
      :*            -- ^ doc on the `:*` constructor
    String          -- ^ doc on the `String` field of the `:*` constructor

  | Boo { x :: () } -- ^ doc on the `Boo` record constructor

  | Boa             -- ^ doc on the `Boa` record constructor
      { y :: () }


module UnamedConstructorFields where

data A = A
data B = B
data C = C

-- Haddock on 'A' prevents the haddock on 'C' from being applied to 'MkFoo'
data Foo = MkFoo A -- ^ 'A' has a comment
                 B -- This doesn't
                 C -- ^ 'C' has a comment


module UnamedConstructorStrictFields where
-- See #15206

data A = A
data B = B

data Foo = MkFoo
  {-# UNPACK #-} !A -- ^ Unpacked strict field
                 B

data Bar =
  {-# UNPACK #-} !A -- ^ Unpacked strict field
    :%%
                 B


module CommentsBeforeArguments where

data A = A
data B = B

f1 :: {-| Comment before -}
     () ->

     ()
     {-^ Comment after -} ->

     ()
     {-^ Result after -}
f1 _ _ = ()

f2 :: {-| Comment before -}
     () ->

     ()
     {-^ Comment after -} ->

     {-| Result after -}
     ()
f2 _ _ = ()


module Foo
(
  -- The reference to chunk2 should show up in the -ddump-parsed output.
  -- $chunk1
  -- $chunk2
  foo,
  -- $chunk3
  bar
)
where

{- $chunk1
This is chunk 1.
-}

{- $chunk2
This is chunk 2.
-}

{- $chunk3
This is chunk 3.
-}

foo = 3
bar = 7


{-# LANGUAGE StandaloneDeriving #-}
module T11768 where

data Foo = Foo
  deriving Eq -- ^ Documenting a single type

data Bar = Bar
  deriving ( Eq -- ^ Documenting one of multiple types
           , Ord
           )

-- | Documenting a standalone deriving instance
deriving instance Read Bar


{-# OPTIONS_GHC -XNoImplicitPrelude #-}
-----------------------------------------------------------------------------
--
-- Module      :  Foreign
-- Copyright   :  (c) The FFI task force 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  ffi@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- A collection of data types, classes, and functions for interfacing
-- with another programming language.
--
-----------------------------------------------------------------------------

module Hej where


module ShouldCompile where

{- | blabla -}
data Bla = Hej


module ShouldCompile where

{- | blabla -}
main = undefined


module ShouldCompile where

-- | blabla
main = undefined


module ShouldCompile where

-- | blabla öqewjlaskjfdasklöjfaslökj
-- aslfdjaskldaskldasjda
-- xxxxxx
-- end of the comment
main = undefined


hej = undefined

-- | 1l3i1j3 as
main = undefined


{-^ wealwwwwwwwwwwww

-}
main = return ()


module ShouldCompiler where

{- |asd-}
main=undefined


module ShouldCompile where

{-|
main=undefined
-}
main = undefined


module ShouldCompile where

{-$ aslkdjasasd asdkjasdlaj {-weqw -}-}
main = undefined


module ShouldCompile where

{-| weoprjwer {- | qwoiejqwioe -}-}
main = undefined


module ShouldCompile where

-- aslkdjasldkjasldkaj
-- | awlkdajsads
---asdasödlklas
--------------- qww
main=undefined


main=undefined

-- | vkfja
hej=main
-- | ieasdkjahsdkjashd
x = hej

-- | eroiewuroieuwr
y = undefined


module ShouldCompile where

-- ^ bla
main=undefined

-- ^ vkfja
hej=main
-- ^ ieasdkjahsdkjashd
x = hej

-- ^ eroiewuroieuwr
y = undefined


-- | a header
module HeaderTest where

-- | bla bla
x = 0


-- | a header
module HeaderTest where

-- * A section
x = 0

-- ** A subsection
y = 1

-- *** A subsubsection
main = print x

-- | bla bla
z = 0


-- #hide, prune, ignore-exports

-- |Module description
module A where


-- #hide, prune, ignore-exports
module A where


-- | module header bla bla

-- #hide, prune, ignore-exports
module A where


module A (

-- | bla bla

{- | blabla -}

) where


module A (

-- | bla bla

{- | blabla -}

x,

-- ** qeÃ¶qwkeÃ¶wqlkeqÃ¶le

-- | qweljqwelkqjwelqjkq

) where

x = True


module A (

-- | bla bla

{- | blabla -}

x,

-- ** qeÃ¶qwkeÃ¶wqlkeqÃ¶le

-- | qweljqwelkqjwelqjkq

y,

-- | dkashdakj
z

-- * asdjha

) where

x = True
y = False
z = True


main = print (test::Int)
  where
    -- | kjfhaskd
    test = 0
    -- | xzczn
    -- qwelkjqwelkqj
    test2 = 1

    -- | adlkjadajdldjad
    test3 = 2


module ShouldCompile where

test2 :: a -- ^ doc1
        -> b {-^ doc2 -} -> a -- ^ doc 3
test2 x y = x


module ShouldCompile where

test2 :: a -- ^ doc1
         -> a
test2 x = x


{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module ShouldCompile where

test :: (Eq a) => [a] -- ^ doc1
               -> forall b . [b] {-^ doc2 -}
               -> [a] -- ^ doc3
test xs ys = xs


{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module ShouldCompile where

-- I bet this test is a mistake!  From the layout it
-- looks as if 'test' takes three args, the latter two
-- of higher rank.  But the parens around these args are
-- missing, so it parses as
--    test :: [a]
--          -> forall a. Ord a
--          => [b]
--          -> forall c. Num c
--          => [c]
--          -> [a]
--
-- But maybe that what was intended; I'm not sure
-- Anyway it should typecheck!

test :: [a] -- ^ doc1
        -> forall b. (Ord b) => [b] {-^ doc2 -}
        -> forall c. (Num c) => [c] -- ^ doc3
        -> [a]
test xs ys zs = xs


module ShouldCompile where

data a <--> b = Mk a b

test :: [a] -- ^ doc1
        -> a <--> b
        -> [a] -- ^ doc3
test xs ys = xs


module ShouldCompile where

data A
  -- | A comment that documents the first constructor
  = A | B | C | D


module ShouldCompile where

data A
  -- | A comment that documents the first constructor
  = A
  -- | comment for B
  | {-^ comment for A -} B
  -- | comment for C
  | C
  | D


module ShouldCompile where

data A
  = A
  | {-| comment for B -} forall a. B a a
  | forall a. Num a => C a {-^ comment for C -}


module ShouldCompile where

data R a = R {
    field1 :: a -- | comment for field2
  , field2 :: a
  , field3 :: a -- ^ comment for field3
  , {-| comment for field4 -} field4 :: a
}


{-# LANGUAGE GADTs #-}

module Hi where

data Hi where
    Hi :: () -- ^ This is a comment on the '()' field of 'Hi'
       -> Int
       -> String -- ^ This is a comment on the 'String' field of 'Hi'
       -> Hi -- ^ This is a comment on the return type of 'Hi'


module ConstructorFields where

data Foo
  = Bar Int String  -- ^ doc on `Bar` constructor

  | Baz             -- ^ doc on the `Baz` constructor
      Int           -- ^ doc on the `Int` field of `Baz`
      String        -- ^ doc on the `String` field of `Baz`

  | Int :+ String   -- ^ doc on the `:+` constructor

  | Int             -- ^ doc on the `Int` field of the `:*` constructor
      :*            -- ^ doc on the `:*` constructor
    String          -- ^ doc on the `String` field of the `:*` constructor

  | Boo { x :: () } -- ^ doc on the `Boo` record constructor

  | Boa             -- ^ doc on the `Boa` record constructor
      { y :: () }


module UnamedConstructorFields where

data A = A
data B = B
data C = C

-- Haddock on 'A' prevents the haddock on 'C' from being applied to 'MkFoo'
data Foo = MkFoo A -- ^ 'A' has a comment
                 B -- This doesn't
                 C -- ^ 'C' has a comment


module UnamedConstructorStrictFields where
-- See #15206

data A = A
data B = B

data Foo = MkFoo
  {-# UNPACK #-} !A -- ^ Unpacked strict field
                 B

data Bar =
  {-# UNPACK #-} !A -- ^ Unpacked strict field
    :%%
                 B


module ShouldCompile where

postInlineUnconditionally
  = case Just "Hey" of
        -- The point of examining occ_info here is that for *non-values*
        -- that occur outside a lambda, the call-site inliner won't have
        -- a chance (because it doesn't know that the thing
        -- only occurs once).   The pre-inliner won't have gotten
        -- it either, if the thing occurs in more than one branch
        -- So the main target is things like
        --      let x = f y in
        --      case v of
        --         True  -> case x of ...
        --         False -> case x of ...
        -- I'm not sure how important this is in practice
      Just a    -- OneOcc => no work-duplication issue
        -> True -- Small enough to dup
                        -- ToDo: consider discount on smallEnoughToInline if int_cxt is true
                        --
                        -- NB: Do NOT inline arbitrarily big things, even if one_br is True
                        -- Reason: doing so risks exponential behaviour.  We simplify a big
                        --         expression, inline it, and simplify it again.  But if the
                        --         very same thing happens in the big expression, we get
                        --         exponential cost!
                        -- PRINCIPLE: when we've already simplified an expression once,
                        -- make sure that we only inline it if it's reasonably small.

      _ -> False

-- Here's an example that we don't handle well:
--      let f = if b then Left (\x.BIG) else Right (\y.BIG)
--      in \y. ....case f of {...} ....
-- Here f is used just once, and duplicating the case work is fine (exprIsCheap).
-- But
-- * We can't preInlineUnconditionally because that woud invalidate
--   the occ info for b.
-- * We can't postInlineUnconditionally because the RHS is big, and
--   that risks exponential behaviour
-- * We can't call-site inline, because the rhs is big
-- Alas!

  where
    x = id


{-# OPTIONS_GHC -XNoImplicitPrelude #-}
-----------------------------------------------------------------------------
--
-- Module      :  Foreign
-- Copyright   :  (c) The FFI task force 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  ffi@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- A collection of data types, classes, and functions for interfacing
-- with another programming language.
--
-----------------------------------------------------------------------------

module Hej where


main=undefined
-- | aksdjhaskdjhasdsakjhdajksda


module ShouldFail where

-- | aksdjhaskdjhasdsakjhdajksd

main=undefined


module ShouldFail where

-- aslkdjasldkjasldkaj
-- | awlkdajsads
-- asdasödlklas
---qww
-----------------
main=undefined


module Constructors where

data Foo
    = Bar
    | Baz
    | Quux Foo Int

newtype Norf = Norf (Foo, [Foo], Foo)

bar, baz, quux :: Foo
bar = Bar
baz = Baz
quux = Quux quux 0

unfoo :: Foo -> Int
unfoo Bar = 0
unfoo Baz = 0
unfoo (Quux foo n) = 42 * n + unfoo foo

unnorf :: Norf -> [Foo]
unnorf (Norf (Bar, xs, Bar)) = xs
unnorf (Norf (Baz, xs, Baz)) = reverse xs
unnorf _ = undefined

unnorf' :: Norf -> Int
unnorf' x@(Norf (f1@(Quux _ n), _, f2@(Quux f3 _))) =
    x' + n * unfoo f1 + aux f3
  where
    aux fx = unfoo f2 * unfoo fx * unfoo f3
    x' = sum . map unfoo . unnorf $ x


{-# LANGUAGE CPP #-}
module CPP where

#define SOMETHING1

foo :: String
foo = {-  " single quotes are fine in block comments
          {- nested block comments are fine -}
       -} "foo"

#define SOMETHING2

bar :: String
bar = "block comment in a string is not a comment {- "

#define SOMETHING3

-- " single quotes are fine in line comments
-- {- unclosed block comments are fine in line comments

-- Multiline CPP is also fine
#define FOO\
  1

baz :: String
baz = "line comment in a string is not a comment --"


module Foo where

data Foo = Bar { x :: Int, y :: Bool }

foo a = a{x=2}

bar = Bar{ x = 1, y = False}

foobar = foo (id id bar)