Putting def definitions in place.

src/GF/Canon/AbsGFC.hs

@@ -61,6 +61,7 @@ data Exp =
  | EProd Ident Exp Exp
  | EAbs Ident Exp
  | EAtom Atom
+ | EData
  | EEq [Equation]
   deriving (Eq,Ord,Show)
 

src/GF/Canon/CanonToGrammar.hs

@@ -47,7 +47,7 @@ redInfo (c,info) = errIn ("decompiling abstract" +++ show c) $ do
   c' <- redIdent c 
   info' <- case info of
     AbsCat cont fs -> do
-      return $ G.AbsCat (Yes cont) (Yes fs)
+      return $ G.AbsCat (Yes cont) (Yes (map (uncurry G.Q) fs))
     AbsFun typ df -> do
       return $ G.AbsFun (Yes typ) (Yes df)
 

src/GF/Canon/MkGFC.hs

@@ -67,7 +67,8 @@ trExp t = case t of
   EProd x a b -> A.Prod x (trExp a) (trExp b)
   EAbs  x   b -> A.Abs  x (trExp b)
   EApp  f a   -> A.App  (trExp f)  (trExp a)
-  EEq _       -> A.Eqs [] ---- eqs
+  EEq eqs     -> A.Eqs [(map trPt ps, trExp e) | Equ ps e <- eqs]
+  EData       -> A.EData
   _    -> trAt t
  where
   trAt (EAtom t) = case t of
@@ -78,6 +79,12 @@ trExp t = case t of
     AT s   -> A.Sort $ prt s
     AS s   -> A.K s
     AI i   -> A.EInt $ fromInteger i
+  trPt p = case p of
+    APC mc ps -> let (m,c) = trQIdent mc in A.PP m c (map trPt ps)
+    APV x -> A.PV x
+    APS s -> A.PString s
+    API i -> A.PInt $ fromInteger i
+    APW   -> A.PW
 
 trQIdent (CIQ m c) = (m,c)
 
@@ -102,7 +109,8 @@ rtExp t = case t of
   A.Prod x a b -> EProd (rtIdent x) (rtExp a) (rtExp b)
   A.Abs  x   b -> EAbs  (rtIdent x) (rtExp b)
   A.App  f a   -> EApp  (rtExp f) (rtExp a)
-  A.Eqs _      -> EEq [] ---- eqs
+  A.Eqs eqs    -> EEq   [Equ (map rtPt ps) (rtExp e) | (ps,e) <- eqs]
+  A.EData      -> EData
   _ -> EAtom $ rtAt t
  where
   rtAt t = case t of
@@ -114,6 +122,14 @@ rtExp t = case t of
     A.K s          -> AS s
     A.EInt i       -> AI $ toInteger i
     _ -> error $ "MkGFC.rt not defined for" +++ show t
+  rtPt p = case p of
+    A.PP m c ps -> APC (rtQIdent (m,c)) (map rtPt ps)
+    A.PV x      -> APV x
+    A.PString s -> APS s
+    A.PInt i    -> API $ toInteger i
+    A.PW        -> APW
+    _ -> error $ "MkGFC.rt not defined for" +++ show p
+
 
 rtQIdent (m,c) = CIQ (rtIdent m) (rtIdent c)
 rtIdent x 

src/GF/Canon/PrintGFC.hs

@@ -163,6 +163,7 @@ instance Print Exp where
    EAtom atom -> prPrec i 2 (concat [prt 0 atom])
    EAbs id exp -> prPrec i 0 (concat [["\\"] , prt 0 id , ["->"] , prt 0 exp])
    EEq equations -> prPrec i 0 (concat [["{"] , prt 0 equations , ["}"]])
+   EData  -> prPrec i 2 (concat [["data"]])
 
 instance Print Sort where
   prt i e = case e of
@@ -185,7 +186,7 @@ instance Print APatt where
    APW  -> prPrec i 0 (concat [["_"]])
 
   prtList es = case es of
-   [x] -> (concat [prt 0 x])
+   [] -> (concat [])
    x:xs -> (concat [prt 0 x , prt 0 xs])
 
 instance Print Atom where

src/GF/Canon/SkelGFC.hs

@@ -1,7 +1,5 @@
 module SkelGFC where
 
-import Ident
-
 -- Haskell module generated by the BNF converter
 
 import AbsGFC
@@ -13,7 +11,7 @@ failure x = Bad $ "Undefined case: " ++ show x
 
 transIdent :: Ident -> Result
 transIdent x = case x of
-  _  -> failure x
+  Ident str  -> failure x
 
 
 transCanon :: Canon -> Result
@@ -83,6 +81,7 @@ transExp x = case x of
   EProd id exp0 exp  -> failure x
   EAbs id exp  -> failure x
   EAtom atom  -> failure x
+  EData  -> failure x
   EEq equations  -> failure x
 
 

src/GF/Compile/Extend.hs

@@ -35,6 +35,7 @@ indirInfo n info = AnyInd b n' where
   (b,n') = case info of
     ResValue _ -> (True,n)
     ResParam _ -> (True,n)
+    AbsFun _ (Yes EData) -> (True,n) 
     AnyInd b k -> (b,k)
     _ -> (False,n) ---- canonical in Abs
 

src/GF/Compile/GrammarToCanon.hs

@@ -60,9 +60,15 @@ redInfo am (c,info) = errIn ("translating definition of" +++ prt c) $ do
   c' <- redIdent c 
   case info of
     AbsCat (Yes cont) pfs -> do
-      returns c' $ C.AbsCat cont [] ---- constrs
+      let fs = case pfs of
+                 Yes ts -> [(m,c) | Q m c <- ts]
+                 _ -> []
+      returns c' $ C.AbsCat cont fs
     AbsFun (Yes typ) pdf -> do
-      returns c' $ C.AbsFun typ (Eqs []) ---- df
+      let df = case pdf of
+                 Yes t -> t
+                 _ -> EData --- data vs. primitive
+      returns c' $ C.AbsFun typ df
 
     ResParam (Yes ps) -> do
       ps' <- mapM redParam ps

src/GF/Compile/Rename.hs

@@ -101,7 +101,7 @@ renameIdentPatt env p = do
 
 info2status :: Maybe Ident -> (Ident,Info) -> (Ident,StatusInfo)
 info2status mq (c,i) = (c, case i of
-  AbsFun _ (Yes (Con g)) | g == c -> maybe Con QC mq
+  AbsFun _ (Yes EData) -> maybe Con QC mq
   ResValue _  -> maybe Con QC mq
   ResParam _  -> maybe Con QC mq
   AnyInd True m -> maybe Con (const (QC m)) mq
@@ -143,7 +143,7 @@ renameInfo :: Status -> (Ident,Info) -> Err (Ident,Info)
 renameInfo status (i,info) = errIn ("renaming definition of" +++ prt i) $ 
                                 liftM ((,) i) $ case info of
   AbsCat pco pfs -> liftM2 AbsCat (renPerh (renameContext status) pco)
-                                  (return pfs) ----
+                                  (renPerh (mapM rent) pfs)
   AbsFun pty ptr -> liftM2 AbsFun (ren pty) (ren ptr)
 
   ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr)
@@ -172,8 +172,7 @@ renameTerm env vars = ren vars where
     Con _  -> renid trm
     Q _ _  -> renid trm
     QC _ _ -> renid trm
-
-----    Eqs eqs -> Eqs (map (renameEquation consts vs) eqs)
+    Eqs eqs -> liftM Eqs $ mapM (renameEquation env vars) eqs
     T i cs -> do
       i' <- case i of
         TTyped ty -> liftM TTyped $ ren vs ty -- the only annotation in source
@@ -212,9 +211,10 @@ renamePattern env patt = case patt of
     c' <- renameIdentTerm env $ Cn c
     psvss <- mapM renp ps
     let (ps',vs) = unzip psvss
-    return $ case c' of
-      QC p d -> (PP p d ps', concat vs)
-      _ -> (PC c ps', concat vs)
+    case c' of
+      QC p d -> return (PP p d ps', concat vs)
+      Q  p d -> return (PP p d ps', concat vs) ---- should not happen
+      _ -> prtBad "unresolved pattern" c' ---- (PC c ps', concat vs)
 
 ----  PP p c ps -> (PP p c ps',concat vs') where (ps',vs') = unzip $ map renp ps
 
@@ -255,9 +255,10 @@ renameContext b = renc [] where
     _ -> return cont
   ren = renameTerm b
 
-{-
-renameEquation :: Status -> [Ident] -> Equation -> Equation
-renameEquation b vs (ps,t) = (ps',renameTerm b (concat vs' ++ vs) t) where
-  (ps',vs') = unzip $ map (renamePattern b vs) ps
--}
+-- vars not needed in env, since patterns always overshadow old vars
 
+renameEquation :: Status -> [Ident] -> Equation -> Err Equation
+renameEquation b vs (ps,t) = do
+  (ps',vs') <- liftM unzip $ mapM (renamePattern b) ps
+  t'        <- renameTerm b (concat vs' ++ vs) t
+  return (ps',t')

src/GF/Compile/Update.hs

@@ -36,9 +36,9 @@ combineAnyInfos = combineInfos unifyAnyInfo
 unifyAnyInfo :: Ident -> Info -> Info -> Err Info
 unifyAnyInfo c i j = errIn ("combining information for" +++ prt c) $ case (i,j) of
   (AbsCat mc1 mf1, AbsCat mc2 mf2) -> 
-    liftM2 AbsCat (unifPerhaps mc1 mc2) (unifPerhaps mf1 mf2) ---- adding constrs
+    liftM2 AbsCat (unifPerhaps mc1 mc2) (unifConstrs mf1 mf2) -- adding constrs
   (AbsFun mt1 md1, AbsFun mt2 md2) -> 
-    liftM2 AbsFun (unifPerhaps mt1 mt2) (unifAbsDefs md1 md2) ---- adding defs
+    liftM2 AbsFun (unifPerhaps mt1 mt2) (unifAbsDefs md1 md2) -- adding defs
 
   (ResParam mt1, ResParam mt2) -> liftM ResParam $ unifPerhaps mt1 mt2
   (ResOper mt1 m1, ResOper mt2 m2) -> 
@@ -95,4 +95,11 @@ unifAbsDefs p1 p2 = case (p1,p2) of
   (Nope, _)  -> return p2
   (_, Nope)  -> return p1
   (Yes (Eqs bs), Yes (Eqs ds)) -> return $ yes $ Eqs $ bs ++ ds --- order!
-  _ -> Bad "update conflict"
+  _ -> Bad "update conflict for definitions"
+
+unifConstrs :: Perh [Term] -> Perh [Term] -> Err (Perh [Term])
+unifConstrs p1 p2 = case (p1,p2) of
+  (Nope, _)  -> return p2
+  (_, Nope)  -> return p1
+  (Yes bs, Yes ds) -> return $ yes $ bs ++ ds
+  _ -> Bad "update conflict for constructors"

src/GF/Data/Str.hs

@@ -16,6 +16,7 @@ newtype Str = Str [Tok]  deriving (Read, Show, Eq, Ord)
 data Tok = 
    TK String
  | TN Ss [(Ss, [String])] -- variants depending on next string 
+--- | TP Ss [(Ss, [String])] -- variants depending on previous string
     deriving (Eq, Ord, Show, Read)
 
 -- notice that having both pre and post would leave to inconsistent situations:
@@ -31,14 +32,19 @@ type Ss = [String]
 
 matchPrefix :: Ss -> [(Ss,[String])] -> [String] -> Ss
 matchPrefix s vs t = 
-    head ([u | (u,as) <- vs, any (\c -> isPrefixOf c (concat t)) as] ++ [s])
+  head ([u | (u,as) <- vs, any (\c -> isPrefixOf c (concat t)) as] ++ [s])
+
+matchSuffix :: String -> Ss -> [(Ss,[String])] -> Ss
+matchSuffix t s vs = 
+  head ([u | (u,as) <- vs, any (\c -> isSuffixOf c t) as] ++ [s])
 
 str2strings :: Str -> Ss
 str2strings (Str st) = alls st where 
   alls st = case st of
-    TK s     : ts -> s                   : alls ts
-    TN ds vs : ts -> matchPrefix ds vs t ++ t where t = alls ts
-    []            -> []
+    TK s     : ts   -> s                   : alls ts
+    TN ds vs : ts   -> matchPrefix ds vs t ++ t where t = alls ts
+----    u :TP ds vs: ts -> [u] ++ matchSuffix u ds vs ++ alls ts
+    []              -> []
 
 str2allStrings :: Str -> [Ss]
 str2allStrings (Str st) = alls st where 

src/GF/Grammar/AbsCompute.hs

@@ -47,7 +47,7 @@ computeAbsTermIn gr = compt where
           return $ mkAbs yy $ mkApp f aa'
 
   look (Q m f) = case lookupAbsDef gr m f of
-    Ok (Just (Eqs [])) -> Nothing  -- canonical
+    Ok (Just EData) -> Nothing  -- canonical --- should always be QC
     Ok md -> md
     _ -> Nothing
   look _ = Nothing

src/GF/Grammar/Grammar.hs

@@ -24,7 +24,7 @@ type SourceCnc = Module Ident Option Info
 -- judgements in abstract syntax
 
 data Info =                  
-   AbsCat   (Perh Context) (Perh [Fun])    -- constructors
+   AbsCat   (Perh Context) (Perh [Term])   -- constructors; must be Id or QId
  | AbsFun   (Perh Type) (Perh Term)        -- Yes f = canonical
  | AbsTrans Ident
 
@@ -55,6 +55,7 @@ data Term =
    Vr Ident             -- variable
  | Cn Ident             -- constant
  | Con Ident            -- constructor
+ | EData                -- to mark in definition that a fun is a constructor
  | Sort String          -- basic type
  | EInt Int             -- integer literal
  | K String             -- string literal or token: "foo"
@@ -68,8 +69,6 @@ data Term =
                         -- only used in internal representation
  | Typed Term Term      -- type-annotated term
 
- | ECase Term [Branch]  -- case expression in abstract syntax à la Alfa
-
 -- below this only for concrete syntax
  | RecType [Labelling]  -- record type: { p : A ; ...}
  | R [Assign]           -- record:      { p = a ; ...}

src/GF/Source/AbsGF.hs

@@ -2,12 +2,10 @@ module AbsGF where
 
 import Ident --H
 
--- Haskell module generated by the BNF converter, except for --H
+-- Haskell module generated by the BNF converter, except --H
 
 -- newtype Ident = Ident String deriving (Eq,Ord,Show) --H
-
 newtype LString = LString String deriving (Eq,Ord,Show)
-
 data Grammar =
    Gr [ModDef]
   deriving (Eq,Ord,Show)
@@ -66,7 +64,7 @@ data TopDef =
    DefCat [CatDef]
  | DefFun [FunDef]
  | DefDef [Def]
- | DefData [ParDef]
+ | DefData [DataDef]
  | DefTrans [FlagDef]
  | DefPar [ParDef]
  | DefOper [Def]
@@ -89,6 +87,15 @@ data FunDef =
    FunDef [Ident] Exp
   deriving (Eq,Ord,Show)
 
+data DataDef =
+   DataDef Ident [DataConstr]
+  deriving (Eq,Ord,Show)
+
+data DataConstr =
+   DataId Ident
+ | DataQId Ident Ident
+  deriving (Eq,Ord,Show)
+
 data ParDef =
    ParDef Ident [ParConstr]
  | ParDefIndir Ident Ident

src/GF/Source/GrammarToSource.hs

@@ -41,8 +41,13 @@ mkTopDefs ds = ds
 
 trAnyDef :: (Ident,Info) -> [P.TopDef]
 trAnyDef (i,info) = let i' = tri i in case info of
-  AbsCat (Yes co) _ -> [P.DefCat [P.CatDef i' (map trDecl co)]]
-  AbsFun (Yes ty) _ -> [P.DefFun [P.FunDef [i'] (trt ty)]]
+  AbsCat (Yes co) pd -> [P.DefCat [P.CatDef i' (map trDecl co)]] ++ case pd of
+    Yes fs -> [P.DefData [P.DataDef i' [P.DataQId (tri m) (tri c) | QC m c <- fs]]]
+    _ -> []
+  AbsFun (Yes ty) pt -> [P.DefFun [P.FunDef [i'] (trt ty)]] ++ case pt of
+    Yes EData -> [] -- keep this information in data defs only
+    Yes t -> [P.DefDef [P.DDef [i'] (trt t)]]
+    _ -> []
   AbsFun (May b)  _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]
   ---- don't destroy definitions!
 
@@ -85,8 +90,6 @@ trt trm = case trm of
     Vr s -> P.EIdent $ tri s
     Cn s -> P.ECons $ tri s
     Con s -> P.EConstr $ tri s
-----    ConAt id typ -> P.EConAt (tri id) (trt typ)
-
     Sort s -> P.ESort $ case s of
       "Type" -> P.Sort_Type
       "PType" -> P.Sort_PType
@@ -95,13 +98,9 @@ trt trm = case trm of
       "Strs" -> P.Sort_Strs
       _ -> error $ "not yet sort " +++ show trm ----
 
-
     App c a -> P.EApp (trt c) (trt a)
     Abs x b -> P.EAbstr [trb x] (trt b)
-
-----    Eqs pts -> "fn" +++ prCurlyList [prtBranchOld pst | pst <- pts] ---
-----    ECase e bs -> "case" +++ prt e +++ "of" +++ prCurlyList (map prtBranch bs) 
-
+    Eqs pts -> P.EEqs [P.Equ (map trp ps) (trt t) | (ps,t) <- pts]
     Meta m  -> P.EMeta
     Prod x a b | isWildIdent x -> P.EProd (P.DExp (trt a)) (trt b)
     Prod x a b -> P.EProd (P.DDec [trb x] (trt a)) (trt b)

src/GF/Source/LexGF.hs

@@ -1,3 +1,4 @@
+
 module LexGF where
 
 import Alex

src/GF/Source/PrintGF.hs

@@ -165,7 +165,7 @@ instance Print TopDef where
    DefCat catdefs -> prPrec i 0 (concat [["cat"] , prt 0 catdefs])
    DefFun fundefs -> prPrec i 0 (concat [["fun"] , prt 0 fundefs])
    DefDef defs -> prPrec i 0 (concat [["def"] , prt 0 defs])
-   DefData pardefs -> prPrec i 0 (concat [["data"] , prt 0 pardefs])
+   DefData datadefs -> prPrec i 0 (concat [["data"] , prt 0 datadefs])
    DefTrans flagdefs -> prPrec i 0 (concat [["transfer"] , prt 0 flagdefs])
    DefPar pardefs -> prPrec i 0 (concat [["param"] , prt 0 pardefs])
    DefOper defs -> prPrec i 0 (concat [["oper"] , prt 0 defs])
@@ -199,6 +199,24 @@ instance Print FunDef where
    [x] -> (concat [prt 0 x , [";"]])
    x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
 
+instance Print DataDef where
+  prt i e = case e of
+   DataDef id dataconstrs -> prPrec i 0 (concat [prt 0 id , ["="] , prt 0 dataconstrs])
+
+  prtList es = case es of
+   [x] -> (concat [prt 0 x , [";"]])
+   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
+
+instance Print DataConstr where
+  prt i e = case e of
+   DataId id -> prPrec i 0 (concat [prt 0 id])
+   DataQId id0 id -> prPrec i 0 (concat [prt 0 id0 , ["."] , prt 0 id])
+
+  prtList es = case es of
+   [] -> (concat [])
+   [x] -> (concat [prt 0 x])
+   x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs])
+
 instance Print ParDef where
   prt i e = case e of
    ParDef id parconstrs -> prPrec i 0 (concat [prt 0 id , ["="] , prt 0 parconstrs])

src/GF/Source/SkelGF.hs

@@ -3,7 +3,6 @@ module SkelGF where
 -- Haskell module generated by the BNF converter
 
 import AbsGF
-import Ident
 import ErrM
 type Result = Err String
 
@@ -12,7 +11,7 @@ failure x = Bad $ "Undefined case: " ++ show x
 
 transIdent :: Ident -> Result
 transIdent x = case x of
-  _  -> failure x
+  Ident str  -> failure x
 
 
 transLString :: LString -> Result
@@ -88,7 +87,7 @@ transTopDef x = case x of
   DefCat catdefs  -> failure x
   DefFun fundefs  -> failure x
   DefDef defs  -> failure x
-  DefData pardefs  -> failure x
+  DefData datadefs  -> failure x
   DefTrans flagdefs  -> failure x
   DefPar pardefs  -> failure x
   DefOper defs  -> failure x
@@ -113,6 +112,17 @@ transFunDef x = case x of
   FunDef ids exp  -> failure x
 
 
+transDataDef :: DataDef -> Result
+transDataDef x = case x of
+  DataDef id dataconstrs  -> failure x
+
+
+transDataConstr :: DataConstr -> Result
+transDataConstr x = case x of
+  DataId id  -> failure x
+  DataQId id0 id  -> failure x
+
+
 transParDef :: ParDef -> Result
 transParDef x = case x of
   ParDef id parconstrs  -> failure x

src/GF/Source/SourceToGrammar.hs

@@ -144,13 +144,24 @@ transAbsDef x = case x of
   DefDef defs  -> do
     defs' <- liftM concat $ mapM getDefsGen defs
     returnl [(c, G.AbsFun nope pe) | (c,(_,pe)) <- defs']
-  DefData _ -> returnl [] ----
+  DefData ds -> do
+    ds' <- mapM transDataDef ds
+    returnl $ 
+      [(c, G.AbsCat nope (yes ps)) | (c,ps) <- ds'] ++
+      [(f, G.AbsFun nope (yes G.EData))  | (_,fs) <- ds', tf <- fs, f <- funs tf]
   DefTrans defs  -> do
     let (ids,vals) = unzip [(i,v) | FlagDef i v <- defs]
     defs' <- liftM2 zip (mapM transIdent ids) (mapM transIdent vals)
     returnl [(c, G.AbsTrans f) | (c,f) <- defs']
   DefFlag defs -> liftM Right $ mapM transFlagDef defs
   _ -> Bad $ "illegal definition in abstract module:" ++++ printTree x
+ where
+   -- to get data constructors as terms
+   funs t = case t of
+     G.Cn f -> [f]
+     G.Q _ f -> [f]
+     G.QC _ f -> [f]
+     _ -> []
 
 returnl :: a -> Err (Either a b)
 returnl = return . Left
@@ -168,6 +179,14 @@ transFunDef :: FunDef -> Err ([Ident], G.Type)
 transFunDef x = case x of
   FunDef ids typ  -> liftM2 (,) (mapM transIdent ids) (transExp typ)
 
+transDataDef :: DataDef -> Err (Ident,[G.Term])
+transDataDef x = case x of
+  DataDef id ds  -> liftM2 (,) (transIdent id) (mapM transData ds) 
+ where
+   transData d = case d of
+     DataId id  -> liftM G.Cn $ transIdent id
+     DataQId id0 id  -> liftM2 G.QC (transIdent id0) (transIdent id)
+
 transResDef :: TopDef -> Err (Either [(Ident, G.Info)] [GO.Option])
 transResDef x = case x of
   DefPar pardefs -> do
@@ -327,6 +346,8 @@ transExp x = case x of
   ELString (LString str) -> return $ G.K str 
   ELin id -> liftM G.LiT $ transIdent id
 
+  EEqs eqs -> liftM G.Eqs $ mapM transEquation eqs
+
   _ -> Bad $ "translation not yet defined for" +++ printTree x ----
 
 --- this is complicated: should we change Exp or G.Term ?
@@ -421,6 +442,10 @@ transCase (Case pattalts exp) = do
   exp'  <- transExp exp  
   return [(p,exp') | p <- patts]
 
+transEquation :: Equation -> Err G.Equation
+transEquation x = case x of
+  Equ apatts exp -> liftM2 (,) (mapM transPatt apatts) (transExp exp)
+
 transAltern :: Altern -> Err (G.Term, G.Term)
 transAltern x = case x of
   Alt exp0 exp  -> liftM2 (,) (transExp exp0) (transExp exp)

src/GF/Source/TestGF.hs

@@ -6,15 +6,18 @@ import ParGF
 import SkelGF
 import PrintGF
 import AbsGF
+
 import ErrM
 
 type ParseFun a = [Token] -> Err a
 
+myLLexer = myLexer
+
 runFile :: (Print a, Show a) => ParseFun a -> FilePath -> IO()
 runFile p f = readFile f >>= run p
 
 run :: (Print a, Show a) => ParseFun a -> String -> IO()
-run p s = case (p (myLexer s)) of
+run p s = case (p (myLLexer s)) of
            Bad s    -> do  putStrLn "\nParse Failed...\n"
                            putStrLn s
            Ok  tree -> do putStrLn "\nParse Successful!"

src/Today.hs

@@ -1 +1 @@
-module Today where today = "Thu Sep 25 14:49:28 CEST 2003"
+module Today where today = "Wed Oct  1 15:37:15 CEST 2003"