-------------------------------------------------------------------------------- {-# LANGUAGE Safe #-} -------------------------------------------------------------------------------- module Main (main) where -------------------------------------------------------------------------------- import qualified Data.ByteString.Lazy.Char8 as BS import Data.Char (isSpace) -------------------------------------------------------------------------------- data CharType = Space | Other data Oscillate = Oscillate !CharType {-# UNPACK #-} !Int !CharType | Otherwise data Count = Count {-# UNPACK #-} !Int !Oscillate {-# UNPACK #-} !Int -------------------------------------------------------------------------------- -- λ> :info Semigroup -- `a` es un conjunto no vacio y operación binaria -- class Semigroup a where -- (<>) :: a -> a -> a -- λ> :info Monoid -- operación binaria (↑), es asociativa y elemento neutro -- class Semigroup a => Monoid a where -- mempty :: a -- mappend :: a -> a -> a instance Semigroup Oscillate where Otherwise <> x = x x <> Otherwise = x Oscillate l n Other <> Oscillate Other m r = Oscillate l (n + m - 1) r Oscillate l n _ <> Oscillate _ m r = Oscillate l (n + m) r instance Monoid Oscillate where mempty = Otherwise instance Semigroup Count where (Count a b c) <> (Count x y z) = Count (a + x) (b <> y) (c + z) instance Monoid Count where mempty = Count 0 mempty 0 -------------------------------------------------------------------------------- main :: IO () main = BS.getContents >>= putStrLn . result . logic -------------------------------------------------------------------------------- helper :: Char -> Oscillate helper c | isSpace c = Oscillate Space 0 Space | otherwise = Oscillate Other 1 Other {-# INLINE helper #-} logic :: BS.ByteString -> Count logic = BS.foldl' (\ a c -> a <> aux c) mempty where aux c = Count 1 (helper c) (if (c == '\n') then 1 else 0) {-# INLINE logic #-} result :: Count -> String result (Count cs ws ls) = " " ++ show ls ++ " " ++ show (aux ws) ++ " " ++ show cs where aux Otherwise = 0 aux (Oscillate _ n _) = n {-# INLINE result #-}