
Hi I am trying to write an XML file where the filename is created based on a timestamp. Simplified version below. This won't compile - I get this error in doWrite2 filepathtest.hs|24 col 17 error| Couldn't match expected type `system-filepath-0.4.7:Filesystem.Path.Internal.FilePath' || with actual type `String' || In the second argument of `writeFile', namely `t1' || In a stmt of a 'do' block: writeFile def t1 doc || In the expression: || do { t1 <- tsString; || writeFile def t1 doc } Somehow the String "text.xml" in doWrite1 is converted into a FilePath, but not the String t1 in doWrite2. What am I doing wrong? {-# LANGUAGE OverloadedStrings #-} module Filepathtest where import Text.XML import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Data.Time.Clock (getCurrentTime) import Prelude hiding (writeFile, FilePath) tsString :: IO String tsString = do x <- getCurrentTime let x' = show $ floor $ utcTimeToPOSIXSeconds x return x' doWrite1 :: Document -> IO () doWrite1 doc = writeFile def "test1.xml" doc doWrite2 :: Document -> IO () doWrite2 doc = do t1 <- tsString writeFile def t1 doc

When you use overloadedstrings, it will type all literal strings as
IsString a => a as a type. Unfortunately your tsString is not a literal,
it is a run time function that always returns a string and a string is not
a filepath.
You should be able to do fmap fromString tsString, provided you import
Data.String.
On Mon, Aug 12, 2013 at 4:35 PM, Alan Buxton
Hi****
** **
I am trying to write an XML file where the filename is created based on a timestamp. Simplified version below. This won’t compile – I get this error in doWrite2 ****
** **
*filepathtest.hs|24 col 17 error| Couldn't match expected type `system-filepath-0.4.7:Filesystem.Path.Internal.FilePath' *
*|| with actual type `String'*
*|| In the second argument of `writeFile', namely `t1'*
*|| In a stmt of a 'do' block: writeFile def t1 doc*
*|| In the expression:*
*|| do { t1 <- tsString;*
*|| writeFile def t1 doc }*
* *
Somehow the String “text.xml” in doWrite1 is converted into a FilePath, but not the String t1 in doWrite2. What am I doing wrong?****
** **
{-# LANGUAGE OverloadedStrings #-}****
module Filepathtest where****
****
import Text.XML****
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)****
import Data.Time.Clock (getCurrentTime)****
import Prelude hiding (writeFile, FilePath)****
****
tsString :: IO String****
tsString = do****
x <- getCurrentTime****
let x' = show $ floor $ utcTimeToPOSIXSeconds x****
return x'****
****
doWrite1 :: Document -> IO ()****
doWrite1 doc =****
writeFile def "test1.xml" doc****
****
doWrite2 :: Document -> IO ()****
doWrite2 doc = do****
t1 <- tsString****
writeFile def t1 doc****
** **
** **
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

Thanks David. Spot on.
a
From: Beginners [mailto:beginners-bounces@haskell.org] On Behalf Of David
McBride
Sent: 12 August 2013 21:52
To: The Haskell-Beginners Mailing List - Discussion of primarily
beginner-level topics related to Haskell
Subject: Re: [Haskell-beginners] Text.XML.writeFile question
When you use overloadedstrings, it will type all literal strings as IsString
a => a as a type. Unfortunately your tsString is not a literal, it is a run
time function that always returns a string and a string is not a filepath.
You should be able to do fmap fromString tsString, provided you import
Data.String.
On Mon, Aug 12, 2013 at 4:35 PM, Alan Buxton
participants (2)
-
Alan Buxton
-
David McBride