Skip to content

Latest commit

 

History

History
1181 lines (932 loc) · 20.4 KB

TESTS.md

File metadata and controls

1181 lines (932 loc) · 20.4 KB

Introduction

This file is a test suite. Each section maps to an HSpec test, and each line that is followed by a Haskell code fence is tested to make sure re-formatting that code snippet produces the same result.

You can browse through this document to see what HIndent's style is like, or contribute additional sections to it, or regression tests.

Modules

Module header

module X where

x = 1

Exports

module X
  ( x
  , y
  , Z
  , P(x, z)
  ) where

Exports, indentation 4

module X
    ( x
    , y
    , Z
    , P(x, z)
    ) where

Imports

Import lists

import Data.Text
import Data.Text
import qualified Data.Text as T
import qualified Data.Text (a, b, c)
import Data.Text (a, b, c)
import Data.Text hiding (a, b, c)

Sorted

import B
import A
import A
import B

Declarations

Type declaration

type EventSource a = (AddHandler a, a -> IO ())

Type declaration with infix promoted type constructor

fun1 :: Def ('[ Ref s (Stored Uint32), IBool] 'T.:-> IBool)
fun1 = undefined

fun2 :: Def ('[ Ref s (Stored Uint32), IBool] ':-> IBool)
fun2 = undefined

Instance declaration without decls

instance C a

Instance declaration with decls

instance C a where
  foobar = do
    x y
    k p

GADT declarations

data Ty :: (* -> *) where
  TCon
    :: { field1 :: Int
       , field2 :: Bool}
    -> Ty Bool
  TCon' :: (a :: *) -> a -> Ty a

Expressions

Lazy patterns in a lambda

f = \ ~a -> undefined
-- \~a yields parse error on input ‘\~’

Bang patterns in a lambda

f = \ !a -> undefined
-- \!a yields parse error on input ‘\!’

List comprehensions, short

map f xs = [f x | x <- xs]

List comprehensions, long

defaultExtensions =
  [ e
  | EnableExtension {extensionField1 = extensionField1} <-
      knownExtensions knownExtensions
  , let a = b
    -- comment
  , let c = d
    -- comment
  ]

List comprehensions with operators

defaultExtensions =
  [e | e@EnableExtension {} <- knownExtensions] \\
  map EnableExtension badExtensions

Parallel list comprehension, short

zip xs ys = [(x, y) | x <- xs | y <- ys]

Parallel list comprehension, long

fun xs ys =
  [ (alphaBetaGamma, deltaEpsilonZeta)
  | x <- xs
  , z <- zs
  | y <- ys
  , cond
  , let t = t
  ]

Record, short

getGitProvider :: EventProvider GitRecord ()
getGitProvider =
  EventProvider {getModuleName = "Git", getEvents = getRepoCommits}

Record, medium

commitToEvent :: FolderPath -> TimeZone -> Commit -> Event.Event
commitToEvent gitFolderPath timezone commit =
  Event.Event
  {pluginName = getModuleName getGitProvider, eventIcon = "glyphicon-cog"}

Record, long

commitToEvent :: FolderPath -> TimeZone -> Commit -> Event.Event
commitToEvent gitFolderPath timezone commit =
  Event.Event
  { pluginName = getModuleName getGitProvider
  , eventIcon = "glyphicon-cog"
  , eventDate = localTimeToUTC timezone (commitDate commit)
  }

Cases

strToMonth :: String -> Int
strToMonth month =
  case month of
    "Jan" -> 1
    "Feb" -> 2
    _ -> error $ "Unknown month " ++ month

Operators, bad

x =
  Value <$> thing <*> secondThing <*> thirdThing <*> fourthThing <*>
  Just thisissolong <*>
  Just stilllonger <*>
  evenlonger

Operators, good

x =
  Value <$> thing <*> secondThing <*> thirdThing <*> fourthThing <*>
  Just thisissolong <*> Just stilllonger <*> evenlonger

Operator with do

for xs $ do
  left x
  right x

Operator with lambda

for xs $ \x -> do
  left x
  right x

Operator with lambda-case

for xs $ \case
  Left x -> x

Type application

fun @Int 12

Transform list comprehensions

list =
  [ (x, y, map the v)
  | x <- [1 .. 10]
  , y <- [1 .. 10]
  , let v = x + y
  , then group by v using groupWith
  , then take 10
  , then group using permutations
  , t <- concat v
  , then takeWhile by t < 3
  ]

Type families

type family Id a

Type family annotations

type family Id a :: *

Type family instances

type instance Id Int = Int

Type family dependencies

type family Id a = r | r -> a

Binding implicit parameters

f =
  let ?x = 42
  in f

Closed type families

type family Closed (a :: k) :: Bool where
  Closed x = 'True

Template Haskell

Expression brackets

add1 x = [|x + 1|]

Pattern brackets

mkPat = [p|(x, y)|]

Type brackets

foo :: $([t|Bool|]) -> a

Type signatures

Long arguments list

longLongFunction :: ReaderT r (WriterT w (StateT s m)) a
                 -> StateT s (WriterT w (ReaderT r m)) a

Long argument list should line break

longLongFunction ::
     ReaderT r (WriterT w (StateT s m)) a
  -> StateT s (WriterT w (ReaderT r m)) a

Class constraints should leave :: on same line

-- see https://github.com/chrisdone/hindent/pull/266#issuecomment-244182805
fun ::
  (Class a, Class b)
  => foo bar mu zot
  -> foo bar mu zot
  -> c

Class constraints

fun
  :: (Class a, Class b)
  => a -> b -> c

Tuples

fun :: (a, b, c) -> (a, b)

Quasiquotes in types

fun :: [a|bc|]

Default signatures

-- https://github.com/chrisdone/hindent/issues/283
class Foo a where
  bar :: a -> a -> a
  default bar :: Monoid a =>
    a -> a -> a
  bar = mappend

Implicit parameters

f
  :: (?x :: Int)
  => Int

Promoted list (issue #348)

a :: A '[ 'True]
a = undefined

-- nested promoted list with multiple elements.
b :: A '[ '[ 'True, 'False], '[ 'False, 'True]]
b = undefined

Promoted list with a tuple (issue #348)

a :: A '[ '( a, b, c, d)]
a = undefined

-- nested promoted tuples.
b :: A '[ '( 'True, 'False, '[], '( 'False, 'True))]
b = undefined

Function declarations

Prefix notation for operators

(+)
  :: Num a
  => a -> a -> a
(+) a b = a

Where clause

sayHello = do
  name <- getLine
  putStrLn $ greeting name
  where
    greeting name = "Hello, " ++ name ++ "!"

Guards and pattern guards

f x
  | x <- Just x
  , x <- Just x =
    case x of
      Just x -> e
  | otherwise = do e
  where
    x = y

Multi-way if

x =
  if | x <- Just x,
       x <- Just x ->
       case x of
         Just x -> e
         Nothing -> p
     | otherwise -> e

Case inside a where and do

g x =
  case x of
    a -> x
  where
    foo =
      case x of
        _ -> do
          launchMissiles
      where
        y = 2

Let inside a where

g x =
  let x = 1
  in x
  where
    foo =
      let y = 2
          z = 3
      in y

Lists

exceptions = [InvalidStatusCode, MissingContentHeader, InternalServerError]

exceptions =
  [ InvalidStatusCode
  , MissingContentHeader
  , InternalServerError
  , InvalidStatusCode
  , MissingContentHeader
  , InternalServerError
  ]

Long line, function application

test = do
  alphaBetaGamma deltaEpsilonZeta etaThetaIota kappaLambdaMu nuXiOmicron piRh79
  alphaBetaGamma deltaEpsilonZeta etaThetaIota kappaLambdaMu nuXiOmicron piRho80
  alphaBetaGamma
    deltaEpsilonZeta
    etaThetaIota
    kappaLambdaMu
    nuXiOmicron
    piRhoS81

Long line, tuple

test
  (alphaBetaGamma, deltaEpsilonZeta, etaThetaIota, kappaLambdaMu, nuXiOmicro79)
  (alphaBetaGamma, deltaEpsilonZeta, etaThetaIota, kappaLambdaMu, nuXiOmicron80)
  ( alphaBetaGamma
  , deltaEpsilonZeta
  , etaThetaIota
  , kappaLambdaMu
  , nuXiOmicronP81)

Long line, tuple section

test
  (, alphaBetaGamma, , deltaEpsilonZeta, , etaThetaIota, kappaLambdaMu, nu79, )
  (, alphaBetaGamma, , deltaEpsilonZeta, , etaThetaIota, kappaLambdaMu, , n80, )
  (
  , alphaBetaGamma
  ,
  , deltaEpsilonZeta
  ,
  , etaThetaIota
  , kappaLambdaMu
  ,
  , nu81
  ,)

Record syntax

Pattern matching, short

fun Rec {alpha = beta, gamma = delta, epsilon = zeta, eta = theta, iota = kappa} = do
  beta + delta + zeta + theta + kappa

Pattern matching, long

fun Rec { alpha = beta
        , gamma = delta
        , epsilon = zeta
        , eta = theta
        , iota = kappa
        , lambda = mu
        } =
  beta + delta + zeta + theta + kappa + mu + beta + delta + zeta + theta + kappa

Johan Tibell compatibility checks

Basic example from Tibbe's style

sayHello :: IO ()
sayHello = do
  name <- getLine
  putStrLn $ greeting name
  where
    greeting name = "Hello, " ++ name ++ "!"

filter :: (a -> Bool) -> [a] -> [a]
filter _ [] = []
filter p (x:xs)
  | p x = x : filter p xs
  | otherwise = filter p xs

Data declarations

data Tree a
  = Branch !a
           !(Tree a)
           !(Tree a)
  | Leaf

data HttpException
  = InvalidStatusCode Int
  | MissingContentHeader

data Person = Person
  { firstName :: !String -- ^ First name
  , lastName :: !String -- ^ Last name
  , age :: !Int -- ^ Age
  }

Spaces between deriving classes

-- From https://github.com/chrisdone/hindent/issues/167
data Person = Person
  { firstName :: !String -- ^ First name
  , lastName :: !String -- ^ Last name
  , age :: !Int -- ^ Age
  } deriving (Eq, Show)

Hanging lambdas

bar :: IO ()
bar =
  forM_ [1, 2, 3] $ \n -> do
    putStrLn "Here comes a number!"
    print n

foo :: IO ()
foo =
  alloca 10 $ \a ->
    alloca 20 $ \b ->
      cFunction fooo barrr muuu (fooo barrr muuu) (fooo barrr muuu)

Comments

Comments within a declaration

bob -- after bob
 =
  foo -- next to foo
  -- line after foo
    (bar
       foo -- next to bar foo
       bar -- next to bar
     ) -- next to the end paren of (bar)
    -- line after (bar)
    mu -- next to mu
    -- line after mu
    -- another line after mu
    zot -- next to zot
    -- line after zot
    (case casey -- after casey
           of
       Just -- after Just
        -> do
         justice -- after justice
          *
           foo
             (blah * blah + z + 2 / 4 + a - -- before a line break
              2 * -- inside this mess
              z /
              2 /
              2 /
              aooooo /
              aaaaa -- bob comment
              ) +
           (sdfsdfsd fsdfsdf) -- blah comment
         putStrLn "")
    [1, 2, 3]
    [ 1 -- foo
    , ( 2 -- bar
      , 2.5 -- mu
       )
    , 3
    ]
    -- in the end of the function
  where
    alpha = alpha
    -- between alpha and beta
    beta = beta
    -- after beta

foo = 1 -- after foo

gamma = do
  delta
  epsilon
  -- in the end of a do-block 1

gamma = do
  delta
  epsilon
  -- the very last block is detected differently

Doesn't work yet (wrong comment position detection)

gamma = do
  -- in the beginning of a do-block
  delta
  where
    -- before alpha
    alpha = alpha

Haddock comments

-- | Module comment.
module X where

-- | Main doc.
main :: IO ()
main = return ()

data X
  = X -- ^ X is for xylophone.
  | Y -- ^ Y is for why did I eat that pizza.

data X = X
  { field1 :: Int -- ^ Field1 is the first field.
  , field11 :: Char
    -- ^ This field comment is on its own line.
  , field2 :: Int -- ^ Field2 is the second field.
  , field3 :: Char -- ^ This is a long comment which starts next to
    -- the field but continues onto the next line, it aligns exactly
    -- with the field name.
  , field4 :: Char
    -- ^ This is a long comment which starts on the following line
    -- from from the field, lines continue at the sme column.
  }

Comments around regular declarations

-- This is some random comment.
-- | Main entry point.
main = putStrLn "Hello, World!"
-- This is another random comment.

Multi-line comments

bob {- after bob -}
 =
  foo {- next to foo -}
  {- line after foo -}
    (bar
       foo {- next to bar foo -}
       bar {- next to bar -}
     ) {- next to the end paren of (bar) -}
    {- line after (bar) -}
    mu {- next to mu -}
    {- line after mu -}
    {- another line after mu -}
    zot {- next to zot -}
    {- line after zot -}
    (case casey {- after casey -}
           of
       Just {- after Just -}
        -> do
         justice {- after justice -}
          *
           foo
             (blah * blah + z + 2 / 4 + a - {- before a line break -}
              2 * {- inside this mess -}
              z /
              2 /
              2 /
              aooooo /
              aaaaa {- bob comment -}
              ) +
           (sdfsdfsd fsdfsdf) {- blah comment -}
         putStrLn "")
    [1, 2, 3]
    [ 1 {- foo -}
    , ( 2 {- bar -}
      , 2.5 {- mu -}
       )
    , 3
    ]

foo = 1 {- after foo -}

Multi-line comments with multi-line contents

{- | This is some random comment.
Here is more docs and such.
Etc.
-}
main = putStrLn "Hello, World!"
{- This is another random comment. -}

Regression tests

jml Adds trailing whitespace when wrapping #221

x = do
  config <- execParser options
  comments <-
    case config of
      Diff False args -> commentsFromDiff args
      Diff True args -> commentsFromDiff ("--cached" : args)
      Files args -> commentsFromFiles args
  mapM_ (putStrLn . Fixme.formatTodo) (concatMap Fixme.getTodos comments)

meditans hindent freezes when trying to format this code #222

c
  :: forall new.
     ( Settable "pitch" Pitch (Map.AsMap (new Map.:\ "pitch")) new
     , Default (Book' (Map.AsMap (new Map.:\ "pitch")))
     )
  => Book' new
c = set #pitch C (def :: Book' (Map.AsMap (new Map.:\ "pitch")))

foo
  :: ( Foooooooooooooooooooooooooooooooooooooooooo
     , Foooooooooooooooooooooooooooooooooooooooooo
     )
  => A

bitemyapp wonky multiline comment handling #231

module Woo where

hi = "hello"
{-
test comment
-}
-- blah blah
-- blah blah
-- blah blah

cocreature removed from declaration issue #186

-- https://github.com/chrisdone/hindent/issues/186
trans One e n =
  M.singleton
    (Query Unmarked (Mark NonExistent)) -- The goal of this is to fail always
    (emptyImage {notPresent = S.singleton (TransitionResult Two (Just A) n)})

sheyll explicit forall in instances #218

-- https://github.com/chrisdone/hindent/issues/218
instance forall x. C

instance forall x. Show x =>
         C x

tfausak support shebangs #208

#!/usr/bin/env stack
-- stack runghc
main =
 pure ()
-- https://github.com/chrisdone/hindent/issues/208
#!/usr/bin/env stack
-- stack runghc
main = pure ()
-- https://github.com/chrisdone/hindent/issues/208

joe9 preserve newlines between import groups

-- https://github.com/chrisdone/hindent/issues/200
import Data.List
import Data.Maybe

import FooBar
import MyProject

import GHC.Monad

-- blah
import Hello

import CommentAfter -- Comment here shouldn't affect newlines
import HelloWorld

import CommentAfter -- Comment here shouldn't affect newlines

import HelloWorld

-- Comment here shouldn't affect newlines
import CommentAfter

import HelloWorld

Wrapped import list shouldn't add newline

import ATooLongList
       (alpha, beta, gamma, delta, epsilon, zeta, eta, theta)
import B

radupopescu deriving keyword not aligned with pipe symbol for type declarations

data Stuffs
  = Things
  | This
  | That
  deriving (Show)

data Simple =
  Simple
  deriving (Show)

sgraf812 top-level pragmas should not add an additional newline #255

-- https://github.com/chrisdone/hindent/issues/255
{-# INLINE f #-}
f :: Int -> Int
f n = n

ivan-timokhin breaks code with type operators #277

-- https://github.com/chrisdone/hindent/issues/277
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}

type m ~> n = ()

class (a :< b) c

ivan-timokhin variables swapped around in constraints #278

-- https://github.com/chrisdone/hindent/issues/278
data Link c1 c2 a c =
  forall b. (c1 a b, c2 b c) =>
            Link (Proxy b)

ttuegel qualified infix sections get mangled #273

-- https://github.com/chrisdone/hindent/issues/273
import qualified Data.Vector as V

main :: IO ()
main = do
  let _ = foldr1 (V.++) [V.empty, V.empty]
  pure ()

-- more corner cases.
xs = V.empty V.++ V.empty

ys = (++) [] []

cons :: V.Vector a -> V.Vector a -> V.Vector a
cons = (V.++)

ivan-timokhin breaks operators type signatures #301

-- https://github.com/chrisdone/hindent/issues/301
(+) :: ()

cdepillabout Long deriving clauses are not reformatted #289

newtype Foo =
  Foo Proxy
  deriving ( Functor
           , Applicative
           , Monad
           , Semigroup
           , Monoid
           , Alternative
           , MonadPlus
           , Foldable
           , Traversable
           )

ivan-timokhin Breaks instances with type operators #342

-- https://github.com/chrisdone/hindent/issues/342
instance Foo (->)

instance Foo (^>)

instance Foo (T.<^)

neongreen “{” is lost when formatting “Foo{}” #366

-- https://github.com/chrisdone/hindent/issues/366
foo = Nothing {}

jparoz Trailing space in list comprehension #357

-- https://github.com/chrisdone/hindent/issues/357
foo =
  [ (x, y)
  | x <- [1 .. 10]
  , y <- [11 .. 20]
  , even x
  , even x
  , even x
  , even x
  , even x
  , odd y
  ]

ttuegel Record formatting applied to expressions with RecordWildCards #274

-- https://github.com/chrisdone/hindent/issues/274
foo (Bar {..}) = Bar {..}

RecursiveDo rec and mdo keyword #328

rec = undefined

mdo = undefined

MINIMAL pragma

Monad example

class A where
  {-# MINIMAL return, ((>>=) | (join, fmap)) #-}

Very long names #310

class A where
  {-# MINIMAL averylongnamewithnoparticularmeaning
            | ananotherverylongnamewithnomoremeaning #-}

NorfairKing Do as left-hand side of an infix operation #296

block =
  do ds <- inBraces $ inWhiteSpace declarations
     return $ Block ds
     <?> "block"

Behaviour checks

Unicode

α = γ * "ω"
-- υ

Empty module

Trailing newline is preserved

module X where

foo = 123

Complex input

A complex, slow-to-print decl

quasiQuotes =
  [ ( ''[]
    , \(typeVariable:_) _automaticPrinter ->
        (let presentVar = varE (presentVarName typeVariable)
         in lamE
              [varP (presentVarName typeVariable)]
              [|(let typeString = "[" ++ fst $(presentVar) ++ "]"
                 in ( typeString
                    , \xs ->
                        case fst $(presentVar) of
                          "GHC.Types.Char" ->
                            ChoicePresentation
                              "String"
                              [ ( "String"
                                , StringPresentation
                                    "String"
                                    (concatMap
                                       getCh
                                       (map (snd $(presentVar)) xs)))
                              , ( "List of characters"
                                , ListPresentation
                                    typeString
                                    (map (snd $(presentVar)) xs))
                              ]
                            where getCh (CharPresentation "GHC.Types.Char" ch) =
                                    ch
                                  getCh (ChoicePresentation _ ((_, CharPresentation _ ch):_)) =
                                    ch
                                  getCh _ = ""
                          _ ->
                            ListPresentation
                              typeString
                              (map (snd $(presentVar)) xs)))|]))
  ]

Random snippet from hindent itself

exp' (App _ op a) = do
  (fits, st) <- fitsOnOneLine (spaced (map pretty (f : args)))
  if fits
    then put st
    else do
      pretty f
      newline
      spaces <- getIndentSpaces
      indented spaces (lined (map pretty args))
  where
    (f, args) = flatten op [a]
    flatten :: Exp NodeInfo -> [Exp NodeInfo] -> (Exp NodeInfo, [Exp NodeInfo])
    flatten (App _ f' a') b = flatten f' (a' : b)
    flatten f' as = (f', as)

Quasi quotes

exp = [name|exp|]