Basic Haskell Cheat Sheet Declaring Types and Classes Expressions / Clauses type synonym type MyType = Type if expression ≈ guarded equations Structure type PairList a b = [(a,b)] if boolExpr foo ... | boolExpr = exprA type String = [Char] -- from Prelude then exprA | otherwise = exprB function :: type -> type else exprB function x = expr data (single constructor) data MyData = MyData Type Type deriving (Class, Class ) nested if expression ≈ guarded equations function2 :: type -> [type] -> type data (multi constructor) data MyData = Simple Type if boolExpr1 foo ... | boolExpr1 = exprA function2 x xs = expr | Duple Type Type then exprA | boolExpr2 = exprB | Nople else if boolExpr2 | otherwise = exprC main = do then exprB data (record syntax) data MDt = MDt { fieldA else exprC action , fieldB :: TyAB ... case expression ≈ function pattern matching , fieldC :: TyC } case x of pat1 -> exA foo pat1 = exA newtype newtype MyType = MyType Type pat2 -> exB foo pat2 = exB Function Application (single constr./field) deriving (Class, Class ) _ -> exC foo _ = exC f x y ≡ (f x) y ≡ ((f) (x)) (y) typeclass class MyClass a where 2-variable case expression ≈ function pattern matching f x y z ≡ ((f x) y) z ≡ (f x y) z foo :: a -> a -> b case (x,y ) of foo pat1 patA = exprA f $ g x ≡ f (g x) ≡ f . g $ x goo :: a -> a (pat1,patA ) -> exprA foo pat2 patB = exprB f $ g $ h x ≡ f (g (h x)) ≡ f . g . h $ x typeclass instance instance MyClass MyType where (pat2,patB ) -> exprB foo _ _ = exprC f $ g x y ≡ f (g x y) ≡ f . g x $ y foo x y = ... _ -> exprC f g $ h x ≡ f g (h x) ≡ f g . h $ x goo x = ... let expression ≈ where clause let nameA = exprA foo ... = mainExpression Values and Types Operators (grouped by precedence) nameB = exprB where nameA = exprA in mainExpression nameB = exprB has type expr :: type do notation ≈ desugarized do notation boolean True || False :: Bool List index, function composition !!, . raise to: Non-neg. Int, Int, Float ^, ^^, ** do patA <- action1 action1 >>= \patA -> character ’a’ :: Char action2 action2 >> fixed-precision integer 1 :: Int multiplication, fractional division *, / integral division (⇒ −∞), modulus ‘div‘, ‘mod‘ patB <- action3 action3 >>= \patB -> integer (arbitrary sz.) 31337 :: Integer action4 action4 31337^10 :: Integer integral quotient (⇒ 0), remainder ‘quot‘, ‘rem‘ single precision float 1.2 :: Float addition, subtraction +, - double precision float 1.2 :: Double list construction, append lists :, ++ Pattern Matching (fn. declaration, lambda, case, let, where) list [] :: [a] list difference \\ [1,2,3] :: [Integer] comparisons: >, >=, <, <=, ==, /= fixed number 3 3 character ’a’ ’a’ [’a’,’b’,’c’] :: [Char] list membership ‘elem‘, ‘notElem‘ ignore value _ empty string "" "abc" :: [Char] boolean and && list empty [] [[1,2],[3,4]] :: [[Integer]] boolean or || head x and tail xs (x:xs) string "asdf" :: String sequencing: bind and then >>=, >> tail xs (ignore head) (_:xs) tuple (1,2) :: (Int,Int) application, strict apl., sequencing $, $!, ‘seq‘ list with 3 elements [a,b,c] ([1,2],’a’) :: ([Int],Char) NOTE: Highest precedence (first line) is 9, lowest precedence is 0. list where 2nd element is 3 (x:3:xs) ordering relation LT, EQ, GT :: Ordering Operator listings aligned left, right, and center indicate left-, right-, tuple pair values a and b (a,b) function (λ) \x -> e :: a -> b and non-associativity. ignore second element (a,_) maybe (just something Just 10 :: Maybe Int triple values a, b and c (a,b,c) or nothing) Nothing :: Maybe a non associative infix 0-9 ‘op‘ left associative infixl 0-9 +-+ mixed first tuple on list ((a,b):xs) Defining fixity: right associative infixr 0-9 -!- maybe just constructor Just a Values and Typeclasses default (when none given) infixl 9 nothing constructor Nothing given context, has type expr :: constraint => type custom user-defined type MyData a b c Numeric (+,-,*) 137 :: Num a => a Functions ≡ Infix operators ignore second field MyData a _ c Fractional (/) 1.2 :: Fractional a => a user-defined record type MyR {f1=x, f2=y} f a b ≡ a ‘f‘ b Floating 1.2 :: Floating a => a a + b ≡ (+) a b as-pattern tuple s and its values s@(a,b) Equatable (==) ’a’ :: Eq a => a (a +) b ≡ ((+) a) b list a, its head and tail a@(x:xs) Ordered (<=,>=,>,<) 731 :: Ord a => a (+ b) a ≡ (\x -> x + b) a Copyright 2014-2021, Rudy Matela – Compiled on November 8, 2021 This text is available under the Creative Commons Attribution-ShareAlike 3.0 Licence, Upstream: https://github.com/rudymatela/concise-cheat-sheets Basic Haskell Cheat Sheet v1.2 or (at your option), the GNU Free Documentation License version 1.3 or Later. Prelude functions (Ato few types have been simplified their list instances, e.g.: foldr ) Tuples Tracing and monitoring (unsafe) Debug.Trace fst :: (a, b) -> a fst (x,y ) ≡ x Print string, return expr trace string $ expr Misc snd :: (a, b) -> b snd (x,y ) ≡ y Call show before printing traceShow expr $ expr id :: a -> a id x ≡ x -- identity curry :: ((a, b) -> c) -> a -> b -> c Trace function f x y | traceShow (x,y) False = undefined const :: a -> b -> a (const x ) y ≡ x curry (\(x,y ) -> e ) ≡ \x y -> e call values f x y = ... undefined :: a undefined ≡ ⊥ (lifts error) uncurry :: (a -> b -> c) -> (a, b) -> c error :: [Char] -> a error cs ≡ ⊥ (lifts error cs) uncurry (\x y -> e ) ≡ \(x,y ) -> e IO – Must be “inside” the IO Monad not :: Bool -> Bool not True ≡ False flip :: (a -> b -> c) -> b -> a -> c Numeric Write char c to stdout putChar c flip f $ x y ≡ f y x Write string cs to stdout putStr cs abs :: Num a => a -> a abs (-9) ≡ 9 Write string cs to stdout w/ a newline putStrLn cs Lists even, odd :: Integral a => a -> Bool even 10 ≡ True Print x , a show instance, to stdout print x gcd, lcm :: Integral a => a -> a -> a gcd 6 8 ≡ 2 null :: [a] -> Bool null [] ≡ True -- ∅? Read char from stdin getChar recip :: Fractional a => a -> a recip x ≡ 1/x length :: [a] -> Int length [x,y,z ] ≡ 3 Read line from stdin as a string getLine pi :: Floating a => a pi ≡ 3.14... elem :: a -> [a] -> Bool y ‘elem‘ [x,y ] ≡ True -- ∈? Read all input from stdin as a string getContents sqrt, log :: Floating a => a -> a sqrt x ≡ x **0.5 head :: [a] -> a head [x,y,z,w ] ≡ x Bind stdin/out to foo (:: String -> String ) interact foo exp, sin, cos, tan, asin, acos :: Floating a => a -> a last :: [a] -> a last [x,y,z,w ] ≡ w Write string cs to a file named fn writeFile fn cs truncate, round :: (RealFrac a, Integral b) => a -> b tail :: [a] -> [a] tail [x,y,z,w ] ≡ [y,z,w ] Append string cs to a file named fn appendFile fn cs ceiling, floor :: (RealFrac a, Integral b) => a -> b init :: [a] -> [a] init [x,y,z,w ] ≡ [x,y,z ] Read contents from a file named fn readFile fn reverse :: [a] -> [a] reverse [x,y,z ] ≡ [z,y,x ] take :: Int -> [a] -> [a] take 2 [x,y,z ] ≡ [x,y ] Strings drop :: Int -> [a] -> [a] drop 2 [x,y,z ] ≡ [z ] List Comprehensions lines :: String -> [String] takeWhile, dropWhile :: (a -> Bool) -> [a] -> [a] lines "ab\ncd\ne" ≡ ["ab","cd","e"] Take pat from list. If boolPredicate, add element expr to list: takeWhile (/= z ) [x,y,z,w ] ≡ [x,y ] [expr | pat <- list, boolPredicate, ...] zip :: [a] -> [b] -> [(a, b)] unlines :: [String] -> String zip [x,y,z ] [a,b ] ≡ [(x,a ),(y,b )] unlines ["ab","cd","e"] ≡ "ab\ncd\ne\n" [x | x <- xs ] ≡ xs [f x | x <- xs, p x] ≡ map f $ filter p xs Infinite Lists words :: String -> [String] [x | x <- xs, p x, q x] ≡ filter q $ filter p xs words "ab cd e" ≡ ["ab","cd","e"] repeat :: a -> [a] repeat x ≡ [x,x,x,x,x,x,...] [x+y | x <- [a,b ], y <- [i,j ]] ≡ [a +i, a +j, b +i, b +j ] cycle :: [a] -> [a] cycle xs ≡ xs ++xs ++xs ++... unwords :: [String] -> String [x | boolE ] ≡ if boolE then [x ] else [] cycle [x,y ] ≡ [x,y,x,y,x,y,...] unwords ["ab","cd","ef"] ≡ "ab cd ef" iterate :: (a -> a) -> a -> [a] iterate f x ≡ [x,f x,f (f x ),...] Read and Show classes GHC - Glasgow Haskell Compiler (and Cabal) Higher-order / Functors show :: Show a => a -> String show 137 ≡ "137" compiling program.hs $ ghc program.hs read :: Show a => String -> a read "2" ≡ 2 running $ ./program map :: (a->b) -> [a] -> [b] running directly $ run_haskell program.hs map f [x,y,z ] ≡ [f x, f y, f z ] Ord Class interactive mode (GHCi) $ ghci zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] min :: Ord a => a -> a -> a min ’a’ ’b’ ≡ ’a’ GHCi load > :l program.hs zipWith f [x,y,z ] [a,b ] ≡ [f x a, f y b ] max :: Ord a => a -> a -> a max "b" "ab" ≡ "b" GHCi reload > :r filter :: (a -> Bool) -> [a] -> [a] compare :: Ord a => a->a->Ordering compare 1 2 ≡ LT GHCi activate stats > :set +s filter (/=y) [x,y,z ] ≡ [x,z ] GHCi help > :? Type of an expression > :t expr foldr :: (a -> b -> b) -> b -> [a] -> b Libraries / Modules Info (oper./func./class) > :i thing foldr f z [x,y ] ≡ x ‘f ‘ (y ‘f ‘ z ) Installed GHC packages $ ghc-pkg list [pkg_name] foldl :: (a -> b -> a) -> a -> [b] -> a importing import Some.Module Activating some pragma {-# LANGUAGE Pragma #-} foldl f x [y,z ] ≡ (x ‘f ‘ y ) ‘f ‘ z (qualified) import qualified Some.Module as SM Same, via GHC call $ ghc -XSomePragma ... (subset) import Some.Module (foo,goo ) Special folds (hiding) import Some.Module hiding (foo,goo ) install package pkg $ cabal install pkg and :: [Bool] -> Bool and [p,q,r ] ≡ p && q && r (typeclass instances) import Some.Module () update package list $ cabal update or :: [Bool] -> Bool or [p,q,r ] ≡ p || q || r list packages matching pat $ cabal list pat declaring module Module.Name information about package $ cabal info pkg sum :: Num a => [a] -> a sum [i,j,k ] ≡ i +j +k ( foo, goo ) help on commands $ cabal help [command] product :: Num a => [a] -> a product [i,j,k ] ≡ i *j *k where run executable/test/bench $ cabal run/test/bench [name] maximum :: Ord a => [a] -> a maximum [9,0,5] ≡ 9 ... initialize sandbox $ cabal sandbox init minimum :: Ord a => [a] -> a minimum [9,0,5] ≡ 0 ./File/On/Disk.hs import File.On.Disk add custom sandbox source $ cabal sandbox add-source dir concat :: [[a]] ->[a] concat [xs,ys,zs ] ≡ xs ++ys ++zs Copyright 2014-2021, Rudy Matela – Compiled on November 8, 2021 This text is available under the Creative Commons Attribution-ShareAlike 3.0 Licence, Upstream: https://github.com/rudymatela/concise-cheat-sheets Basic Haskell Cheat Sheet v1.2 or (at your option), the GNU Free Documentation License version 1.3 or Later.
Authors Rudy Matela
License CC-BY-SA-3.0 GFDL-1.3-or-later