module Language.Preprocessor.Cpphs.ReadFirst
( readFirst
, readFileUTF8
, writeFileUTF8
) where
import System.IO
import System.Directory (doesFileExist)
import Data.List (intersperse)
import Control.Exception as E
import Control.Monad (when)
import Language.Preprocessor.Cpphs.Position (Posn,directory,cleanPath)
readFirst :: String
-> Posn
-> [String]
-> Bool
-> IO ( FilePath
, String
)
readFirst :: String -> Posn -> [String] -> Bool -> IO (String, String)
readFirst String
name Posn
demand [String]
path Bool
warn =
case String
name of
Char
c:Char
':':Char
'\\':String
nm-> String -> Maybe String -> [String] -> IO (String, String)
try String
nm (forall a. a -> Maybe a
Just (Char
cforall a. a -> [a] -> [a]
:Char
':'forall a. a -> [a] -> [a]
:[])) [String
""]
Char
c:Char
':':Char
'/':String
nm -> String -> Maybe String -> [String] -> IO (String, String)
try String
nm (forall a. a -> Maybe a
Just (Char
cforall a. a -> [a] -> [a]
:Char
':'forall a. a -> [a] -> [a]
:[])) [String
""]
Char
c:Char
':':String
nm -> String -> Maybe String -> [String] -> IO (String, String)
try String
nm (forall a. a -> Maybe a
Just (Char
cforall a. a -> [a] -> [a]
:Char
':'forall a. a -> [a] -> [a]
:[])) (forall {t :: * -> *} {a}. Foldable t => t a -> [t a] -> [t a]
cons String
dd (String
"."forall a. a -> [a] -> [a]
:[String]
path))
Char
'/':String
nm -> String -> Maybe String -> [String] -> IO (String, String)
try String
nm forall a. Maybe a
Nothing [String
""]
String
_ -> String -> Maybe String -> [String] -> IO (String, String)
try String
name forall a. Maybe a
Nothing (forall {t :: * -> *} {a}. Foldable t => t a -> [t a] -> [t a]
cons String
dd (String
"."forall a. a -> [a] -> [a]
:[String]
path))
where
dd :: String
dd = Posn -> String
directory Posn
demand
cons :: t a -> [t a] -> [t a]
cons t a
x [t a]
xs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
x then [t a]
xs else t a
xforall a. a -> [a] -> [a]
:[t a]
xs
try :: String -> Maybe String -> [String] -> IO (String, String)
try String
name Maybe String
_ [] = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
warn forall a b. (a -> b) -> a -> b
$
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Warning: Can't find file \""forall a. [a] -> [a] -> [a]
++String
name
forall a. [a] -> [a] -> [a]
++String
"\" in directories\n\t"
forall a. [a] -> [a] -> [a]
++forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. a -> [a] -> [a]
intersperse String
"\n\t" (forall {t :: * -> *} {a}. Foldable t => t a -> [t a] -> [t a]
cons String
dd (String
"."forall a. a -> [a] -> [a]
:[String]
path)))
forall a. [a] -> [a] -> [a]
++String
"\n Asked for by: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
demand)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"missing file: "forall a. [a] -> [a] -> [a]
++String
name,String
"")
try String
name Maybe String
drive (String
p:[String]
ps) = do
let file :: String
file = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. [a] -> [a] -> [a]
(++) Maybe String
drive) forall a b. (a -> b) -> a -> b
$ String -> String
cleanPath String
pforall a. [a] -> [a] -> [a]
++Char
'/'forall a. a -> [a] -> [a]
:String -> String
cleanPath String
name
Bool
ok <- String -> IO Bool
doesFileExist String
file
if Bool -> Bool
not Bool
ok then String -> Maybe String -> [String] -> IO (String, String)
try String
name Maybe String
drive [String]
ps
else do String
content <- String -> IO String
readFileUTF8 String
file
forall (m :: * -> *) a. Monad m => a -> m a
return (String
file,String
content)
readFileUTF8 :: FilePath -> IO String
readFileUTF8 :: String -> IO String
readFileUTF8 String
file = do
Handle
h <- String -> IOMode -> IO Handle
openFile String
file IOMode
ReadMode
(do TextEncoding
utf8r <- String -> IO TextEncoding
mkTextEncoding String
"UTF-8//ROUNDTRIP"
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8r
Handle -> IO String
hGetContents Handle
h) forall a b. IO a -> IO b -> IO a
`E.onException` (Handle -> IO ()
hClose Handle
h)
writeFileUTF8 :: FilePath -> String -> IO ()
writeFileUTF8 :: String -> String -> IO ()
writeFileUTF8 String
f String
txt = forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
hdl->
do TextEncoding
utf8r <- String -> IO TextEncoding
mkTextEncoding String
"UTF-8//ROUNDTRIP"
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
hdl TextEncoding
utf8r
Handle -> String -> IO ()
hPutStr Handle
hdl String
txt
forall a b. IO a -> IO b -> IO a
`E.onException` (Handle -> IO ()
hClose Handle
hdl)