Skeleton for getting full definition

Download.hs

@@ -1,15 +1,28 @@
-module Download (downloadHtmlDef) where 
+module Download (downloadHtmlAvailableDef, downloadHtmlDef) where 
 
 import Data.ByteString.Lazy
 import Network.HTTP.Simple
 
 baseUrl = "http://www.cnrtl.fr/definition/"
 
-downloadHtmlDef :: String -> IO ByteString
+downloadHtmlAvailableDef :: String -> IO ByteString
-downloadHtmlDef w = do
+downloadHtmlAvailableDef w = do
-    request <- getRequest w
+    request <- getAvailableDefRequest w
-    response <- httpLBS (request)
+    downloadFromRequest request
+
+downloadHtmlDef :: String -> String -> IO ByteString
+downloadHtmlDef n w = do
+    request <- getDefRequest n w
+    downloadFromRequest request
+    
+downloadFromRequest :: Request -> IO ByteString
+downloadFromRequest r = do
+    response <- httpLBS r
     return (getResponseBody response)
 
-getRequest :: String -> IO Request
+
-getRequest w = parseRequest (baseUrl ++ w)
+getAvailableDefRequest :: String -> IO Request
+getAvailableDefRequest w = parseRequest (baseUrl ++ w)
+
+getDefRequest :: String -> String -> IO Request
+getDefRequest n w = parseRequest (baseUrl ++ w ++ "/" ++ n)

Main.hs

@@ -4,9 +4,20 @@ import System.Environment
 import Download
 import ParseHtml
 import qualified Data.Text.Lazy.Encoding as E
+import qualified Data.ByteString.Lazy.Char8 as L
+
 
 main :: IO ()
-main = do 
+main = getArgs >>= parse
-    args <- getArgs
+
-    htmlResult <- downloadHtmlDef (head args)
+parse [] = usage
-    printDifferentDef (E.decodeUtf8 htmlResult)
+parse ("-d":[]) = usage
+parse ("-d":n:[]) = usage
+parse ("-d":n:fs) = do
+            htmlResult <- downloadHtmlDef n (head fs) 
+            printDef (E.decodeUtf8 htmlResult)
+parse fs = do
+            htmlResult <- downloadHtmlAvailableDef (head fs)
+            printDifferentDef (E.decodeUtf8 htmlResult)
+
+usage   = putStrLn "Usage: dictfr [options] [word]\n\nOPTIONS:\n-d id    the definition id for the word"

ParseHtml.hs

@@ -1,39 +1,23 @@
-module ParseHtml (printDifferentDef, differentDefTags, parseDefTags) where
+module ParseHtml (printDef, printDifferentDef) where
 
 import Text.HTML.TagSoup
 import Prelude
+import WordDef
 import qualified Data.Text.Lazy as T
 
-data WordDefHeader = WordDefHeader WordName WordType
-data WordName = WordName String
-data WordType = WordType String
 
 printDifferentDef :: T.Text -> IO ()
 printDifferentDef x = putStrLn (getDifferentDef x)
 
-
 getDifferentDef :: T.Text -> String
 getDifferentDef x = getDifferentDefMessages (length xs) ++ renderWordList xs 
                     where xs = (parseDefTags . differentDefTags) x
 
-renderWordList :: [WordDefHeader] -> String
-renderWordList [] = ""
-renderWordList (x:xs) = (renderString x) ++ "\n" ++ (renderWordList xs)
-
 getDifferentDefMessages :: Int -> String
 getDifferentDefMessages 0 = "Aucune définition disponible."
 getDifferentDefMessages 1 = "Une définition disponible : \n"
 getDifferentDefMessages _ = "Plusieurs définitions disponibles : \n"
 
-renderString :: WordDefHeader -> String
-renderString (WordDefHeader n t) = (getNameString n) ++ (getTypeString t)
-
-getNameString :: WordName -> String
-getNameString (WordName s) =  s
-
-getTypeString :: WordType -> String
-getTypeString (WordType s) =  s
-
 parseDefTags :: [Tag String] -> [WordDefHeader]
 parseDefTags [] = []
 parseDefTags xs = 
@@ -52,3 +36,18 @@ differentDefTags :: T.Text -> [Tag String]
 differentDefTags =
     filter (~== TagText "") . (takeWhile (~/= "<div id=contentbox>"))
     . (dropWhile (~/= "<div id=vtoolbar>")) . parseTags . T.unpack
+
+printDef :: T.Text -> IO ()
+printDef = putStrLn . getDef 
+
+getDef :: T.Text -> String
+getDef = (renderFullDef . getFullDef . parseFullDefTags)
+
+getFullDef :: [Tag String] -> WordFullDef
+getFullDef x = WordFullDef (WordDefHeader (WordName "lol") (WordType
+               "Interjection")) [WordDefSentence "Laughing Out Loud",
+               WordExampleSentence "ur wrong lol"]
+
+parseFullDefTags :: T.Text -> [Tag String]
+parseFullDefTags = filter (~== "<span class=tlf_cdefinition") . parseTags 
+                 . T.unpack

WordDef.hs

@@ -0,0 +1,37 @@
+module WordDef
+    (
+    WordFullDef(WordFullDef),
+    WordDefHeader(WordDefHeader),
+    WordName(WordName),
+    WordType(WordType),
+    WordSentence(..),
+    renderWordList,
+    renderHeader,
+    renderFullDef
+    ) where
+
+data WordFullDef = WordFullDef WordDefHeader [WordSentence] deriving Show
+
+data WordSentence = WordDefSentence String
+                 | WordExampleSentence String deriving Show
+
+data WordDefHeader = WordDefHeader WordName WordType deriving Show
+data WordName = WordName String deriving Show
+data WordType = WordType String deriving Show
+
+renderFullDef :: WordFullDef -> String
+renderFullDef w = show w
+
+renderHeader :: WordDefHeader -> String
+renderHeader (WordDefHeader n t) = (getNameString n) ++ (getTypeString t)
+
+getNameString :: WordName -> String
+getNameString (WordName s) =  s
+
+getTypeString :: WordType -> String
+getTypeString (WordType s) =  s
+
+renderWordList :: [WordDefHeader] -> String
+renderWordList [] = ""
+renderWordList (x:xs) = (renderHeader x) ++ "\n" ++ (renderWordList xs)
+

makefile

@@ -2,7 +2,7 @@ CC=ghc
 ARGS=--make -dynamic
 FILENAME=dictfr
 all:
-	$(CC) $(ARGS) -o $(FILENAME) Main.hs Download.hs ParseHtml.hs
+	$(CC) $(ARGS) -o $(FILENAME) Main.hs Download.hs ParseHtml.hs WordDef.hs
 
 clean:
 	rm -f *.o *.hi