Found it

What do you experts think of this :

-- | Main entry point to the application.
{-# OPTIONS_GHC -Wall #-}

module LogAnalysis where

import           Data.Char (isDigit, isLetter)
import           Log
                
isValid :: String -> Bool
isValid s =
  case words s of
    [a]:b:_ -> isLetter a && all isDigit b
    _       -> False

parse :: String -> LogMessage
parse s =
   case words s of
        ("I":time:text)           -> LogMessage Info (read time) (unwords text)
        ("W":time:text)           -> LogMessage Warning (read time) (unwords text)
        ("E":errorcode:time:text) -> LogMessage (Error (read errorcode)) (read time) (unwords text)
        _                         ->  Unknown "This is not in the right format"

parseMessage :: String -> LogMessage
parseMessage s =
    case isValid(s) of
        true -> parse(s)
        false -> Unknown "This is not the right format"


-- | The main entry point.
main :: IO ()
main = do
    print $ show (parseMessage "I 4681 ehci 0xf43d000:15: regista14: [0xbffff 0xfed nosabled 00-02] Zonseres: brips byted nored)")
    print $ show (parseMessage "W 3654 e8] PGTT ASF! 00f00000003.2: 0x000 - 0000: 00009dbfffec00000: Pround/f1743colled")
    print $ show (parseMessage "E 47 1034 'What a pity it wouldn't stay!' sighed the Lory, as soon as it was quite")

Rpe;pf




Sumit Sahrawat, Maths & Computing, IIT (BHU) schreef op 24-2-2015 om 4:26:
From the homework:

data MessageType = Info
                 | Warning
                 | Error Int
    deriving (Show, Eq)

data LogMessage = LogMessage MessageType TimeStamp String
    deriving (Eq, Show)

data MaybeLogMessage = ValidM LogMessage -- A valid msg
                     | InvalidLM String  -- Invalid msg

parseMessage :: String -> MaybeLogMessage
parseMessage = undefined

To implement parseMessage, we consume the string from left to right word-by-word.
If the first word is E, then we read the second word as in integer indicating severity and proceed further.
Info and Warning don't require more information, so the next word will be the timestamp in those cases.
If the pattern fails anywhere, we return the whole string as an InvalidLM.

Hope this helps.


On 24 February 2015 at 06:37, Richard A. O'Keefe <ok@cs.otago.ac.nz> wrote:

On 24/02/2015, at 5:19 am, Roelof Wobben <r.wobben@home.nl> wrote:

> I tried it another way more like explained on this page :  http://www.seas.upenn.edu/~cis194/spring13/lectures/02-ADTs.html
>
> so I tried this :
>
> parseMessage :: [Char] -> [Char]
> parseMessage s
> case Errornumber of
>     IsDigit Errornumber  -> "Geldige string"
>     otherwise            -> "Ongeldige string"
>   where
>       Error = s words
>       Errornumber = Error(ErrorNumber _ _ )
>       Errorcode = Error(_ Errorcode _ )
>
> but now I cannot use where :(

That's not your problem.

IsDigit ErrorNumber is not a pattern.

parseMessage s =
    if isDigit errorNumber then "Geldige string"
    else                        "Ongelidige string"
  where
    errorNumber = ???

is OK.

Now I cannot make sense of
    Error = s words

        identifiers beginning with capital letters are used for
        - module names
        - type constructors
        - data constructors
        You want a variable here, so it must begin with a
        lower case letter.

        s words treats a string s as a function and applies it
        to the function words as argument: s(words).  But that
        does not type check.  You mean words s.

        The result of words s, whatever else it may be, is not
        an error.

    Errornumber = Error(ErrorNumber _ _)

        In the form "expr where pattern = expr", the thing after
        the equal sign must be an expression.  But
        Error(ErrorNumber _ _) is not an expression.  "_" is a
        PATTERN (= I do not care what goes here) but never an
        EXPRESSION (because what value would it have?).


_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe



--
Regards

Sumit Sahrawat