Hm4. Салимов Наиль 11-802

du/app/Main.hs

@@ -1,4 +1,58 @@
+{-# LANGUAGE FlexibleContexts #-}
 module Main where
 
+import Control.Exception.Base
+import System.Environment
+import Control.Monad.State
+import System.Directory
+
+
+getDirectories path = do
+  r <- (try $ listDirectory  path ) :: IO (Either SomeException [FilePath] )
+  case r of
+    Left e ->
+       do
+          putStrLn $ "Exception: " ++ show e
+          return []
+    Right files -> filterM doesDirectoryExist (map (\f -> path ++ "/" ++ f) files)
+
+getDirectoriesWithDepth :: FilePath -> Int -> StateT [FilePath] IO ()
+getDirectoriesWithDepth path 0 = do
+  dList <- get
+  put (path : dList)
+
+getDirectoriesWithDepth path  depth = do
+  dList <- get
+  put (path : dList)
+  dirs <- liftIO $ getDirectories path
+  forM_ dirs (\dir -> getDirectoriesWithDepth dir (depth -1))
+
+getDirectoryFilesCount :: FilePath -> IO String
+getDirectoryFilesCount path = do
+  c <- fmap length $ listDirectory path
+  return $ path ++ "\t" ++ show (c)
+
+getDirectorySize :: FilePath -> IO String
+getDirectorySize path = do
+  s <- getFileSize path
+  return $ path ++ "\t" ++ show (s)
+
+du' :: FilePath -> Int -> IO ()
+du' path depth = do
+  res <- runStateT (getDirectoriesWithDepth path depth) []
+  count <- forM (snd res) getDirectoryFilesCount
+  size <- forM (snd res) getDirectorySize
+  putStrLn "Count:"
+  forM_ (reverse count) putStrLn
+  putStrLn "Size:"
+  forM_ (reverse size) putStrLn
+
+du :: FilePath -> Maybe Int -> IO ()
+du path Nothing = du' path (maxBound :: Int)
+du path (Just depth) = du' path depth
+
 main :: IO ()
-main = putStrLn "Hello, Haskell!"
+main = do
+  du "." (Just 0)
+  putStrLn ("--------------------")
+  du "." Nothing

du/du.cabal

@@ -29,7 +29,7 @@ executable du
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
-    build-depends:    base ^>=4.14.3.0
+    build-depends:    base ^>=4.15.0.0
                     , directory >= 1.3
                     , mtl >= 2.2
     hs-source-dirs:   app

proj2/app/Main.hs

@@ -5,116 +5,40 @@ import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Monad
 
-data D = D Integer Integer
 
-printPrime :: Integer -> IO ()
-printPrime 1 = putStrLn "One"
-printPrime n
-  = if go n 2
-    then putStrLn ("Prime " ++ show n)
-    else putStrLn ("Not prime " ++ show n)
+primeOrZero :: Int -> Int
+primeOrZero 1 = 0
+primeOrZero n = if go n 2 then n else 0
   where go n k | k*k > n = True
                | n `mod` k == 0 = False
                | otherwise = go n (k+1)
 
-pp :: Integer -> IO Integer
-pp x = printPrime x >> pure x
-
-list :: [Integer]
-list = [ 66333293675293
-       , 37446796642823
-       , 59978924802163
-       , 79404304192991
-       , 14833513069799
-       , 70451647138309
-       , 62204847621503
-       , 83747881716781
-       , 53222479319519
-       , 34298041863719
-       ]
-
-main1 :: IO ()
-main1 = do
-  getNumCapabilities >>= print
-  let x = list!!0
-      y = list!!1
-  -- withAsync (printPrime x) $ \rx -> do
-  --   withAsync (printPrime y) $ \ry -> do
-  --     wait rx
-  --     wait ry
-  --
-  -- forConcurrently_ list printPrime
-  D a b <- runConcurrently $ D
-    <$> Concurrently (pp x)
-    <*> Concurrently (pp y)
-  print a
-  print b
-
-summator :: TBQueue Int -> TVar Bool -> Int -> IO Int
-summator q b s = do
-  mx <- atomically $ do
-    finished <- readTVar b
-    if finished
-      then tryReadTBQueue q
-      else Just <$> readTBQueue q
-  case mx of
-    Just x -> summator q b $! s+x
-    Nothing -> pure s
-
-fillQueue :: TBQueue Int -> TVar Bool -> IO ()
-fillQueue q b = do
-  let n = 10000000
-  forM_ [1..n] $ \i ->
-    atomically $ writeTBQueue q i
-  atomically $ writeTVar b True
-
-main2 = do
-  threads <- getNumCapabilities
-  print threads
-  (q,b) <- atomically $ (,)
-    <$> newTBQueue 10000000
-    <*> newTVar False
-  withAsync (fillQueue q b) $ \r -> do
-    results <- replicateConcurrently threads $
-      summator q b 0
-    wait r
-    forM_ results print
-    print $ sum results
-
--- Повторяем n раз действие,
--- пока возвращается Nothing
--- Если вернулся Just, возвращаем его
-retryN :: Int -> STM (Maybe a) -> STM (Maybe a)
-retryN 0 act = pure Nothing
-retryN n act = do
-  mr <- act
-  case mr of
-    Nothing -> retryN (n-1) act
-    Just r -> pure $ Just r
-
 count :: TQueue Int -> Async () -> Int -> IO Int
 count q r s = do
   (finished, mx) <- atomically $ (,)
     <$> pollSTM r
     <*> tryReadTQueue q
   case mx of
     Nothing -> do
-      -- finished <- poll r
       case finished of
         Nothing -> count q r s
         Just _ -> pure s
-    Just x -> count q r $! s+x
+    Just x -> count q r $! s + primeOrZero x
 
-writer :: TQueue Int -> IO ()
-writer q = do
-  forM_ [1..1000000] $ \i ->
+writer :: TQueue Int -> Int -> IO ()
+writer q n = do
+  forM_ [1..n] $ \i ->
     atomically $ writeTQueue q i
 
+main :: IO ()
 main = do
   threads <- getNumCapabilities
-  print threads
+
+  str <- getLine
+  let n = (read str :: Int)
+
   q <- atomically newTQueue
-  withAsync (writer q) $ \r -> do
+  withAsync (writer q n) $ \r -> do
     sums <- replicateConcurrently threads $
       count q r 0
     wait r

proj2/proj2.cabal

@@ -29,7 +29,7 @@ executable proj2
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
-    build-depends:    base ^>=4.14.3.0
+    build-depends:    base ^>=4.15.0.0
                     , async >= 2.2
                     , stm >= 2.5
     hs-source-dirs:   app

proj3/app/Main.hs

@@ -109,5 +109,26 @@ csvRes =
   , [ "r4\",\"\\c1", "r4\",\"c2", "r4\",\"c3"]
   ]
 
+csvParser  :: Parser [[String]]
+csvParser  = sepEndBy parseByLine (char '\n')
+
+
+parseByLine :: Parser [String]
+parseByLine = sepBy1 parseByCell (char ',')
+
+parseByCell :: Parser String
+parseByCell = stringInBrakets  <|> simpleString
+
+
+part:: Parser (Token String)
+part = char '\\' >> anySingle
+
+simpleString  :: Parser String
+simpleString  = many (part <|> noneOf ",\n")
+
+stringInBrakets  :: Parser String
+stringInBrakets  = char '"' *> many (part <|> noneOf "\"") <* char '"'
+
 main :: IO ()
-main = pure ()
+main = do
+  parseTest csvParser csv

proj3/proj3.cabal

@@ -29,7 +29,7 @@ executable proj3
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
-    build-depends:    base ^>=4.14.3.0
+    build-depends:    base ^>=4.15.0.0
                     , megaparsec >=9.2
     hs-source-dirs:   app
     default-language: Haskell2010

proj4/app/Main.hs

@@ -19,117 +19,26 @@ import TheLens ()
 -- >    10
 -- >
 -- > 55
-sumAndTabulate :: Int -> [Int] -> IO Int
-sumAndTabulate cols list = error "Write me!"
-
-
--- -- Свободная монада - на одном из следующих занятий
--- data S f m r
---   = Elem (f (S f m r)) -- "чистый" элемент e и данные дальше
---   | Act (m (S f m r))  -- данные из действия (в монаде m)
---   | Res r              -- результат r
-
-stS :: Int
-    -> Stream (Of Int) IO Int
-    -> IO Int
-stS cols = fmap S.fst' .
-  S.sum .
-  S.mapM_ (liftIO . putStrLn) .
-  tabS 3 .
-  S.copy
-
--- Получение стрима из нужных строк
-tabS :: Monad m
-     => Int
-     -> Stream (Of Int) m r
-     -> Stream (Of String) m r
-tabS cols ints = S.mapsM S.mconcat $
-                 S.chunksOf cols $
-                 S.map addTab ints
-  where addTab x = show x ++ "\t"
-
--- Вывод на экран
-outTabS :: Int
-        -> Stream (Of Int) IO ()
-        -> IO ()
-outTabS cols = S.mapM_ putStrLn .
-               tabS cols
-
---------------------------------------
-
-type Lens f s t a b
-  = (a -> f b) -- функция модификации поля
-  -> s         -- старый объект
-  -> f t       -- новый объект
-type Lens' f s a = Lens f s s a a
-
-ix :: Functor f => Int -> Lens' f [a] a
-ix k = go k
-  where
-    go 0 f (x:xs) = (:xs) <$> f x
-    go k f (x:xs) = (x:) <$> go (k-1) f xs
-
-_1 :: Functor f => Lens f (a,b) (c,b) a c
-_1 f (a,b) = (\x -> (x,b)) <$> f a
-
-_2 :: Functor f => Lens f (a,b) (a,d) b d
-_2 f (a,b) = (\x -> (a,x)) <$> f b
-
-ex1 = (ix 4) Identity [1..10]
-ex2 = (ix 4) (const $ Identity 101) [1..10]
-ex3 = (ix 4) (\x -> [101..104]) [1..10]
-ex4 = (ix 4) (\x -> (x,x)) [1..10]
-ex5 = _1 (const $ Identity 789) (123,456)
-ex6 = _1 (const $ Identity "ads") (123,456)
-ex7 = _2 (Identity . show) (123,456)
-ex8 = _2 (\x -> [show x, show $ x+1]) (123,456)
-ex9 = (_1 . _2) (const $ Identity "x") ((1,2),3)
-
-
-
-
-{-------------------
-*Main> ((1,[3::Int,4,5]),(2,3))^._2._2
-3
-*Main> ((1,[3::Int,4,5]),(2,3)) & _2._2 .~ "asd"
-((1,[3,4,5]),(2,"asd"))
-*Main> ((1,[3::Int,4,5]),(2,3)) & _2._2 .~ (123,321)
-((1,[3,4,5]),(2,(123,321)))
-*Main> ((1,[3::Int,4,5]),(2,3)) ^. _2
-(2,3)
-*Main> ((1,[3::Int,4,5]),(2,3)) & _2 %~ (\(a,b) -> (a,b,123))
-((1,[3,4,5]),(2,3,123))
-*Main> ((1,[3::Int,4,5]),(2,3)) ^. _1 . _2
-[3,4,5]
-*Main> ((1,[3::Int,4,5]),(2,3)) ^? _1 . _2 . ix 5
-Nothing
-*Main> ((1,[3::Int,4,5]),(2,3)) ^? _1 . _2 . ix 1
-Just 4
-*Main> ((1,[3::Int,4,5]),(2,3)) ^.. _1 . _2 . ix 1
-[4]
-*Main> Right 123 :: Either String Int
-Right 123
-*Main> let ea = Right 123 :: Either String Int
-*Main> ea ^? _Left
-Nothing
-*Main> ea ^? _Right
-Just 123
-*Main> ea & _Right .~ 124
-Right 124
-*Main> ea & _Left .~ 124
-Right 123
-*Main> ea & _Left .~ "123"
-Right 123
-*Main> ea & _Left %~ ("f" ++)
-Right 123
-*Main> let eb = Left "asdasd"
-*Main> eb & _Left %~ ("f" ++)
-Left "fasdasd"
-*Main> ea & _Left %~ ("f" ++)
-Right 123
-*Main> ea & _Left %~ ("f" ++)
-Right 123
-------------------}
+sumAndTabulate:: Int -> [Int] -> IO Int
+sumAndTabulate 0 _= error "Кол-во столбцов должно быть больше 0"
+sumAndTabulate x arr = sumAndTabulateSupport x arr x
+
+sumAndTabulateSupport _ [] _ = do
+  putStr "\n\n"
+  return 0
+
+sumAndTabulateSupport x (a:arr) i = do
+    if (i == 1) then do
+        putStr $ (show a) ++ "\n"
+        res <- sumAndTabulateSupport x arr x
+        return $ a + res
+    else do
+        putStr $ (show a) ++ "\t"
+        res <- sumAndTabulateSupport x arr (i -1)
+        return $ a + res
 
 main :: IO ()
-main = putStrLn "Hello, Haskell!"
+main = do
+  sum <- sumAndTabulate 3 [1..10]
+  putStrLn $ "Сумма: " ++ show sum
+

proj4/proj4.cabal

@@ -29,7 +29,7 @@ executable proj4
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
-    build-depends:    base ^>=4.14.3.0
+    build-depends:    base ^>=4.15.0.0
                     , streaming >=0.2
                     , lens >= 5
     hs-source-dirs:   app