[Haskell-cafe] Simple Parsec example, question

Peter Schmitz ps.haskell at gmail.com
Tue Sep 14 21:23:01 EDT 2010


Simple Parsec example, question

I am learning Parsec and have been studying some great reference and
tutorial sites I have found (much thanks to the authors), including:

http://legacy.cs.uu.nl/daan/download/parsec/parsec.html#UserGuide
http://legacy.cs.uu.nl/daan/download/parsec/parsec.html#ReferenceGuide
http://book.realworldhaskell.org/read/using-parsec.html
http://lstephen.wordpress.com/2007/06/19/first-go-with-parsec/
http://jonathan.tang.name/files/scheme_in_48/tutorial/overview.html
http://www.defmacro.org/ramblings/lisp-in-haskell.html

I'm having trouble coding a simple parser to count the number of
lines in a text file.

"lineCount" fails to compile; the compiler error text is below it.

Any advice, code, etc. would be appreciated.

For those using Gtk2Hs + Glade, I have included the glade file after
the Haskell code, in case you want to try it. (You will need to
remove the leading "> " and fix some lines that the email wrapped.)

If you do wish to offer code, feel free to remove or rewrite: eol,
textLines and lineCount entirely. I'm looking for the simplest
way to code this.

Thanks very much,
-- Peter



> -- A parsing demo, using:
> -- Haskell + Gtk2Hs + Glade (GtkBuilder) + Parsec
> module Main where
>
> -- import Data.IORef
> import Graphics.UI.Gtk
> import Graphics.UI.Gtk.Builder
> import Graphics.UI.Gtk.Selectors.FileChooser
> -- import System.Cmd          -- e.g., for invoking a shell cmd
> import System.Glib.GError
> import Text.ParserCombinators.Parsec
>
> main :: IO ()
> main = do
>    initGUI
>
>    -- create builder; load UI file
>    builder <- builderNew
>    handleGError (\(GError dom code msg) -> fail msg) $
>       builderAddFromFile builder "demo.glade"
>       -- Error message would look something like:
>       -- app.exe: user error (Failed to open file 'app.glade':
>       --    No such file or directory)
>
>    -- get widget handles       (reduce boilerplate?)
>    mainWindow     <- builderGetObject builder castToWindow "mainWindow"
>    pickFileButton <-
>       builderGetObject builder castToFileChooserButton "pickFileButton"
>    parseButton    <- builderGetObject builder castToButton "parseButton"
>    exitButton     <- builderGetObject builder castToButton "exitButton"
>
>    -- signal handlers --
>
>    -- parse selected file
>    onClicked parseButton $ do
>       file <- fileChooserGetFilename pickFileButton
>
>       case file of
>          Nothing -> do
>             putStrLn "\nPlease first select a file."
>             return ()
>          Just file -> do
>             putStrLn $ "\nParsing file: " ++ show file
>             result <- parseFromFile lineCount file
>             case (result) of
>                Left err -> print err
>                Right x -> putStrLn $ "Line count = " ++ show x
>             return ()
>
>    -- exit
>    onDestroy mainWindow mainQuit
>    onClicked exitButton mainQuit
>
>    -- go
>    widgetShowAll mainWindow
>    mainGUI
>
> -----------------
> eol = char '\n'
>
> --      from RWH; perhaps use in future:
> -- eol =   try (string "\n\r")
> --     <|> try (string "\r\n")
> --     <|> string "\n"
> --     <|> string "\r"
> --     <?> "end of line"
>
> textLines = endBy eol
>
> lineCount :: Parser Int
> lineCount = do
>    xs <- textLines
>    return (length xs)
>
>
> -- demo.hs:72:3:
> --     Couldn't match expected type `GenParser Char () Int'
> --            against inferred type `GenParser Char st sep -> b'
> --     In a stmt of a 'do' expression: xs <- textLines
> --     In the expression:
> --         do { xs <- textLines;
> --              return (length xs) }
> --     In the definition of `lineCount':
> --         lineCount = do { xs <- textLines;
> --                          return (length xs) }


-- demo.glade follows --

> <?xml version="1.0"?>
> <interface>
>   <requires lib="gtk+" version="2.16"/>
>   <!-- interface-naming-policy project-wide -->
>   <object class="GtkWindow" id="mainWindow">
>     <property name="visible">True</property>
>     <property name="title" translatable="yes">demo v.8</property>
>     <child>
>       <object class="GtkVBox" id="vbox1">
>         <property name="visible">True</property>
>         <property name="border_width">6</property>
>         <property name="orientation">vertical</property>
>         <property name="spacing">10</property>
>         <child>
>           <object class="GtkLabel" id="label1">
>             <property name="visible">True</property>
>             <property name="tooltip_text" translatable="yes">You can hover over the buttons below for some information about them.
>
> You can also resize this window, to make the buttons bigger.
> </property>
>             <property name="label" translatable="yes">Demo: Haskell + Gtk2Hs + Glade (GtkBuilder) + Parsec
> </property>
>           </object>
>           <packing>
>             <property name="position">0</property>
>           </packing>
>         </child>
>         <child>
>           <object class="GtkHBox" id="hbox1">
>             <property name="visible">True</property>
>             <property name="spacing">5</property>
>             <child>
>               <object class="GtkFrame" id="pickFileframe">
>                 <property name="visible">True</property>
>                 <property name="tooltip_text" translatable="yes">Use this File Chooser widget to select the file to parse.
> </property>
>                 <property name="label_xalign">0</property>
>                 <property name="shadow_type">none</property>
>                 <child>
>                   <object class="GtkAlignment" id="alignment1">
>                     <property name="visible">True</property>
>                     <property name="left_padding">12</property>
>                     <child>
>                       <object class="GtkFileChooserButton" id="pickFileButton">
>                         <property name="visible">True</property>
>                         <property name="title" translatable="yes">Select file</property>
>                       </object>
>                     </child>
>                   </object>
>                 </child>
>                 <child type="label">
>                   <object class="GtkLabel" id="pickFileLabel">
>                     <property name="visible">True</property>
>                     <property name="label" translatable="yes">&lt;b&gt;Select file to parse:&lt;/b&gt;</property>
>                     <property name="use_markup">True</property>
>                   </object>
>                 </child>
>               </object>
>               <packing>
>                 <property name="position">0</property>
>               </packing>
>             </child>
>             <child>
>               <object class="GtkButton" id="parseButton">
>                 <property name="label" translatable="yes">P_arse</property>
>                 <property name="visible">True</property>
>                 <property name="can_focus">True</property>
>                 <property name="receives_default">True</property>
>                 <property name="tooltip_text" translatable="yes">Use this to parse the file you have selected.</property>
>                 <property name="use_underline">True</property>
>               </object>
>               <packing>
>                 <property name="position">1</property>
>               </packing>
>             </child>
>             <child>
>               <object class="GtkButton" id="exitButton">
>                 <property name="label" translatable="yes">E_xit</property>
>                 <property name="visible">True</property>
>                 <property name="can_focus">True</property>
>                 <property name="receives_default">True</property>
>                 <property name="tooltip_text" translatable="yes">Exit this program and close both windows.</property>
>                 <property name="use_underline">True</property>
>               </object>
>               <packing>
>                 <property name="position">2</property>
>               </packing>
>             </child>
>           </object>
>           <packing>
>             <property name="position">1</property>
>           </packing>
>         </child>
>       </object>
>     </child>
>   </object>
> </interface>

-- end --


More information about the Haskell-Cafe mailing list