<div dir="ltr"><div>It looks like you are trying to get time in UTC, then figuring out what date it is?  You should be able to get the answer you are looking for with<br><br>getFormattedDate = do<br></div><div>  utc <- getCurrentTime<br></div><div>  return $ formatTime defaultTimeLocale "%m/%d/%Y" utc<br><br></div>Just keep in mind that that is the date in UTC.  Not in your local time zone and it ignores daylight savings time.  To get it in your time you'll have to replace getCurrentTime with getZonedTime.<br></div><div class="gmail_extra"><br><div class="gmail_quote">On Thu, Nov 10, 2016 at 1:44 PM, sasa bogicevic <span dir="ltr"><<a href="mailto:brutallesale@gmail.com" target="_blank">brutallesale@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Hi All,<br>
<br>
This is a small program<br>
<br>
{-# LANGUAGE OverloadedStrings #-}<br>
module Main where<br>
<br>
import           Control.Monad.IO.Class     (liftIO)<br>
import qualified Data.ByteString.Lazy.Char8 as L<br>
import           Data.Time<br>
import           Network                    (withSocketsDo)<br>
import           Network.HTTP.Conduit<br>
<br>
<br>
createRequestData today = [("index:brKursneListe",""),<br>
 ("index:year","2016"),<br>
 ("index:inputCalendar1", today),<br>
 ("index:vrsta","3"),<br>
 ("index:prikaz","0"),<br>
 ("index:buttonShow","Prikazi")<wbr>]<br>
<br>
<br>
timeFromString  s = parseTimeOrError True defaultTimeLocale "%d %b %Y %l:%M %p" s<br>
<br>
formatDateString time = formatTime defaultTimeLocale "%m/%d/%Y" time<br>
<br>
getDateString = getCurrentTime<br>
<br>
getFormatedDate  = formatDateString $ timeFromString getDateString<br>
<br>
main = do<br>
        print $ getFormatedDate<br>
<br>
<br>
And here is my error<br>
<br>
main.hs:25:54: error:<br>
   • Couldn't match type ‘IO UTCTime’ with ‘[Char]’<br>
     Expected type: String<br>
       Actual type: IO UTCTime<br>
   • In the first argument of ‘timeFromString’, namely ‘getDateString’<br>
     In the second argument of ‘($)’, namely<br>
       ‘timeFromString getDateString’<br>
     In the expression: formatDateString $ timeFromString getDateString<br>
<br>
Thanks!<br>
<br>
______________________________<wbr>_________________<br>
Beginners mailing list<br>
<a href="mailto:Beginners@haskell.org">Beginners@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/beginners</a><br>
</blockquote></div><br></div>