Haskell Programming Examples

Haskell Sample Program

haskell

main = putStrLn "Hello World"

title

haskell

main = putStrLn 2 + 2

sfgfd

haskell

main = putStrLn "hello world"

Zxcv

haskell

main = putStrLn "hello world"

Compile and Execute Haskell Online

haskell

--{-# OPTIONS_GHC -Wall #-}
--module HW05 where
module Main where

data AbstractInteger = Zero
                     | Succ AbstractInteger
                     | Pred AbstractInteger
                     deriving (Show, Eq)

-- Задача 1 -----------------------------------------
instance Ord AbstractInteger where
--   (<=) = undefined
    compare (Pred _) (Pred _) = EQ
    compare (Pred _) _ = LT
    compare (Succ _) (Succ _) = EQ
    compare (Succ _) _ = GT
    compare Zero (Succ _) = LT
    compare Zero (Pred _) = GT
    compare Zero Zero = EQ

-- Задача 2 ----------------------------------------
aiToInteger :: AbstractInteger -> Integer
--aiToInteger = undefined
aiToInteger Zero = 0
aiToInteger (Pred ai)
  | ai == Zero = -1
  | otherwise = aiToInteger ai - 1
aiToInteger (Succ ai)
  | ai == Zero = 1
  | otherwise = aiToInteger ai + 1

-- Задача 3 -----------------------------------------
plusAbs :: AbstractInteger -> AbstractInteger -> AbstractInteger
--plusAbs = undefined
plusAbs ai1 ai2 = plusAbs' ai1 ai2
  where
    plusAbs' Zero a = a
    plusAbs' (Pred a1') (Succ a2') = plusAbs a1' a2'
    plusAbs' a1@(Pred _) (Pred a2') = plusAbs (Pred a1) a2'
    plusAbs' a1@(Succ _) (Succ a2') = plusAbs (Succ a1) a2'
    plusAbs' a1 a2 = plusAbs a2 a1

-- Задача 4 -----------------------------------------
timesAbs :: AbstractInteger -> AbstractInteger -> AbstractInteger
--timesAbs = undefined
timesAbs ai1 ai2 = ai2
{-
timesAbs  (Pred (Pred Zero)) (Pred (Pred (Pred Zero))) =  
                =    Succ( Succ ( Succ (Succ (Succ (Succ Zero)))))
-}

-- Задача 5 -----------------------------------------
instance Num AbstractInteger  where
    (+)   = plusAbs
    (*)   = timesAbs
    negate      = undefined
    fromInteger = undefined
    abs         = undefined
    signum      = undefined

-- Задача 6 -----------------------------------------
factorial :: (Eq a, Num a) => a -> a
factorial = undefined

-- Задача  7 -----------------------------------------
data Quaternion = Quaternion Double Double Double Double deriving (Eq)

instance Show Quaternion where
    show = undefined

-- Задача 8 -----------------------------------------
plusQuaternion :: Quaternion -> Quaternion -> Quaternion
plusQuaternion = undefined

-- Задача 9 -----------------------------------------
timesQuaternion :: Quaternion -> Quaternion -> Quaternion
timesQuaternion = undefined

--- Задача 10 ----------------------------------------
instance Num Quaternion  where
    (+)   = plusQuaternion
    (*)   = timesQuaternion
    negate      = undefined
    fromInteger = undefined
    abs         = undefined
    signum      = undefined
    
main :: IO ()
main = do
print $ "1. " ++ show (compare Zero (Succ Zero))
print $ "1. " ++ show (compare (Pred Zero) (Succ Zero))
print $ "1. " ++ show (Zero <= (Succ Zero))
print $ "1. " ++ show ((Pred Zero) == (Succ Zero))
print $ "2. " ++ show (aiToInteger Zero)
print $ "2. " ++ show (aiToInteger (Pred (Pred Zero)))
print $ "2. " ++ show (aiToInteger (Pred (Pred (Pred Zero))))
print $ "2. " ++ show (aiToInteger (Succ (Pred (Pred (Pred (Pred Zero))))))
print $ "3. " ++ show (plusAbs (Pred (Pred Zero))  (Succ (Succ Zero)))
print $ "3. " ++ show (plusAbs (Pred Zero)  (Succ (Succ Zero)))
print $ "4. " ++ show (timesAbs  (Pred (Pred Zero)) (Pred (Pred (Pred Zero))))

Compile and Execute Haskell Online

haskell

--{-# OPTIONS_GHC -Wall #-}
--module HW04 where
module Main where

import Data.Char
  
type Name = String
type Attributes = [(Name, String)]
data XML = Text String | Element Name Attributes [XML]   
         deriving (Eq, Show)
type Stack = [XML]

-- Задача 1 -----------------------------------------
skipSpace :: String -> String
--skipSpace = undefined
skipSpace = sk . sk
    where sk = reverse . dropWhile isSpace

-- Задача 2 -----------------------------------------
getAttribute :: String -> XML -> String
--getAttribute = undefined
getAttribute _ (Text _) = ""
getAttribute s (Element _ attr _) = concatMap getValue attr
    where
     getValue (f, g)
      | f == s = g
      | otherwise = getAttribute s (Text s)

{-
showXML :: XML -> String
showXML (Text t) = t
showXML (Element n as es)
     = "<" ++ n ++ showAtts as ++ ">" ++ concatMap showXML es ++ "</" ++ n ++ ">"
       where
          showAtts ast = concatMap showAtt ast
          showAtt (n1, v) = " " ++ n1 ++ "=" ++ "\"" ++ v ++ "\""
-}

-- Задача 3 -----------------------------------------
getChildren :: String -> XML -> [XML]
--getChildren = undefined
getChildren s (Text _) = []
getChildren s (Element _ _ ch) = filter (\(Element b _ _) -> b == s) ch

-- Задача 4 -----------------------------------------
getChild :: String -> XML -> XML
--getChild = undefined
getChild s (Text _) = Text ""
getChild s e@(Element _ _ _) = listChildren $ getChildren s e
 where
  listChildren l
   | l == [] = getChild s (Text s)
   | otherwise = head l

-- Задача 5 -----------------------------------------
addChild :: XML -> XML -> XML
-- Передумова: другий аргумент - завжди побудований конструктором Element
--addChild  = undefined
addChild (Text s) (Element n attr ch) = Element n attr (ch ++ [Text s]) --Text "oops"

-- Задача 6 -----------------------------------------
getValue :: XML -> XML
--getValue = undefined
getValue (Text _) = Text ""
getValue (Element _ _ ch) = Text $ getValue' ch
 where
  getValue' ((Text v):xs)
    | xs == [] = v
    | otherwise = v ++ getValue' xs
  getValue' ((Element _ _ l):xs) = getValue' l ++ getValue' xs
  getValue' e
    | e == [] = ""
   
-- Задача 7 -----------------------------------------
addText :: String -> Stack -> Stack
-- Передумова: Є по крайній мірі один елемент Element в стеку
--addText = undefined
addText _ [] = []
addText s (x:xs) = addChild (Text s) x:xs

-- Задача 8 -----------------------------------------
popAndAdd :: Stack -> Stack
-- Передумова: Є по крайній мірі два елемента Elements в стеку
--popAndAdd = undefined
popAndAdd st
 | length st < 3 = []
 | otherwise = popAndAdd' st
   where popAndAdd' (x1:(Element n a l):xs) = Element n a (concat [l, [x1]]):xs

-- Початковий елемент стеку 
sentinel :: XML
sentinel = Element "" [] []  

-- Задача 9 -----------------------------------------
parseAttributes :: String -> (Attributes, String)
-- Передумова: Рядок, що містить XML-атрибути, синтаксично вірний
--parseAttributes  = undefined
parseAttributes s = ([("Text", "aaa")], "www")

-- Аналіз імені елемента/атрибута
parseName :: String -> (Name, String)
parseName []
  = error "Error: attempt to read empty name"
parseName s@(c1 : _)
  | isAlpha c1 = break (not . isNameChar) s
  | otherwise = error ("parseName error: name " ++ show s ++
                      " must begin with a letter")
  where
    isNameChar c = isAlpha c || isDigit c || elem c "-."

-- Задача 10 -----------------------------------------
parse :: String -> XML
-- Передумова: рядок, що містить XML-документ, синтаксично вірний
parse s = parse' (skipSpace s) [sentinel]

parse' :: String -> Stack -> XML
parse' = undefined
--parse' = null--"" ""

-----------------------------------------------------------------------
-- Деякі корисні функції перетворення в рядок і виводу
-- Функція перетворення в рядок ('show' function) для XML об'єктів
showXML :: XML -> String
showXML (Text t) = t
showXML (Element n as es)
     = "<" ++ n ++ showAtts as ++ ">" ++ concatMap showXML es ++ "</" ++ n ++ ">"
       where
          showAtts ast = concatMap showAtt ast
          showAtt (n1, v) = " " ++ n1 ++ "=" ++ "\"" ++ v ++ "\""
-- Функція перетворення в рядок ('show' function) для списку XML об'єктів
showXMLs :: [XML] -> String
showXMLs = concatMap showXML
-- Функція виводу XML об'єкта на екран
printXML :: XML -> IO()
printXML = putStrLn . showXML

-------------------------------------------------------------------------
-- Тестові дані
-- Прості тести XML-об'єктів (без проміжків)
s1, s2, s3 :: String
s1 = "<a>A</a>"
s2 = "<a x=\"1\"><b>A</b><b>B</b></a>"
s3 = "<a>\
      \<b>\
        \<c att=\"att1\">text1</c>\
        \<c att=\"att2\">text2</c>\
      \</b>\
      \<b>\
        \<c att=\"att3\">text3</c>\
        \<d>text4</d>\
      \</b>\
    \</a>"
-- Результати аналізу попередніх XML-об'єктів
x1, x2, x3 :: XML
x1 = Element "a" [] [Text "A"]
x2 = Element "a"
            [("x","1")]
            [Element "b" [] [Text "A"],
             Element "b" [] [Text "B"]]
x3 = Element "a" 
            [] 
            [Element "b" 
                     [] 
                     [Element "c"
                              [("att","att1")] 
                              [Text "text1"],
                      Element "c" 
                              [("att","att2")]
                              [Text "text2"]],
             Element "b" 
                     [] 
                     [Element "c" 
                              [("att","att3")] 
                              [Text "text3"],
                      Element "d" 
                              [] 
                              [Text "text4"]]]

casablanca :: String 
casablanca
  = "<film title=\"Casablanca\">\n  <director>Michael Curtiz</director>\n  <year>1942\
    \</year>\n</film>\n\n\n"

casablancaParsed :: XML 
casablancaParsed
  = Element "film" 
            [("title","Casablanca")] 
            [Text "\n  ",
             Element "director" [] [Text "Michael Curtiz"],
             Text "\n  ",
             Element "year" [] [Text "1942"],
             Text "\n"]

-- XML-документ з Мал.1
films :: String
films
  = "<filmlist>\n\
    \  <film title = \"Rear Window\">\n\
    \    <director>Alfred Hitchcock</director>\n\
    \    <composer>Franz Waxman</composer>\n\
    \    <year>1954</year>\n\
    \  </film>\n\
    \  <film   title =  \"2001: A Space Odyssey\">\n\
    \    <director>Stanley Kubrick</director>\n\
    \    <composer>Richard Strauss</composer>\n\
    \    <composer>Gyorgy Ligeti</composer>\n\
    \    <composer>Johann Strauss</composer>\n\
    \    <year>1968</year>\n\
    \  </film>\n\
    \  <film title=\"Lawrence of Arabia\"  >\n\
    \    <duration>228</duration>\n\
    \    <director>David Lean</director>\n\
    \    <composer>Maurice Jarre</composer>\n\
    \  </film>\n\
    \</filmlist>\n\n\n"

-- Результат аналізу  попереднього докуменнту ('parse films')
filmsParsed :: XML
filmsParsed
  = Element "filmlist" 
            [] 
            [Text "\n  ",
             Element "film" [("title","Rear Window")]
                            [Text "\n    ",
                             Element "director" [] [Text "Alfred Hitchcock"],
                             Text "\n    ",
                             Element "composer" [] [Text "Franz Waxman"],
                             Text "\n    ",
                             Element "year" [] [Text "1954"],
                             Text "\n  "],
             Text "\n  ",
             Element "film" [("title","2001: A Space Odyssey")] 
                            [Text "\n    ",
                             Element "director" [] [Text "Stanley Kubrick"],
                             Text "\n    ",
                             Element "composer" [] [Text "Richard Strauss"],
                             Text "\n    ",
                             Element "composer" [] [Text "Gyorgy Ligeti"],
                             Text "\n    ",
                             Element "composer" [] [Text "Johann Strauss"],
                             Text "\n    ",
                             Element "year" [] [Text "1968"],
                             Text "\n  "],
             Text "\n  ",
             Element "film" [("title","Lawrence of Arabia")] 
                            [Text "\n    ",
                             Element "duration" [] [Text "228"],
                             Text "\n    ",
                             Element "director" [] [Text "David Lean"],
                             Text "\n    ",
                             Element "composer" [] [Text "Maurice Jarre"],
                             Text "\n  "],
             Text "\n"]

main :: IO ()
main = do
let
    x11 = Element "a" [] [Text "A", Text "C"]
    x12 = Element "a" [] []
    x21 = Element "a"
            [("x","1")]
            [Element "b" [] [Text "A", Text ""],
             Element "b" [] [Text "C", Text "Q"],
             Element "b" [] [Text "B"],
             Element "b" [] [],
             Element "b" [] [Text "M"]]

print $ "1. " ++ (show $ skipSpace "\n \n\nsome \n \n text")
--print $ x2
--print $ showXML x2
print $ "2. " ++ (show $ getAttribute "x" x2)
print $ "2. " ++ (show $ getAttribute "x" (Text "t"))
print $ "3. " ++ (show $ getChildren "b" x2)
print $ "3. " ++ (show $ getChildren "c" x2)
print $ "4. " ++ (show $ getChild "b" x2)
print $ "4. " ++ (show $ getChild "c" x2)
print $ "5. " ++ (show $ addChild (Text "B") (Element "a" [] [Text "A"]))
--print $ x1
print $ "6. " ++ (show $ getValue x1)
print $ "6. " ++ (show $ getValue x11)
--print $ "6. " ++ (show $ getValue x12)
--print $ x2
--print $ getValue x2
--print $ getValue x21
print $ [Element "a" [] [Text "A",Text "B"], Element "" [] []]
print $ "7. " ++ (show $ addText "B" [Element "a" [] [Text "A"], sentinel])
--print $ "7. " ++ (show $ addText "C" [sentinel])
--print $ "7. " ++ (show $ addText "C" [])
print $ [Element "ab" [("a","1")] [Element "a" [] [Text "A"]], Element "" [] []]
print $ "8. " ++ (show $ popAndAdd [Element "a" [] [Text "A"], Element "ab" [("a","1")] [], sentinel])
print $ "8. " ++ (show $ popAndAdd [Element "a" [] [Text "A"]])

print $ show ([("x","7")],"rest of text")
print $ "9. " ++ (show $ parseAttributes "x=\"7\">rest of text")
print $ parseName "x=\"7\">rest of text"
print $ parseName "a = \"0\" b = \"1\" >rest of text"

Compile and Execute Haskell Online

haskell

type Name = String
type Hobby = String
data Person = Person Name Hobby

getName :: Person -> Name
getName (Person name _) = name

getHobby :: Person -> Hobby
getHobby (Person _ hobby) = hobby

main = putStrLn (getHobby (Person "Tim" "Gaming"))

Harray, Larray, Barry

haskell

import qualified Data.List as L

names = ["Harry", "Larray", "Barray"]
result1 = L.find isHarray names
    where isHarray name = name == "Harry"
    
result2 = L.find isJake names
    where isJake _ = True
    
main = putStrLn (show result2)

Follow

Newsletter