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 (String -> Maybe String
forall a. a -> Maybe a
Just (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:[])) [String
""]
Char
c:Char
':':Char
'/':String
nm -> String -> Maybe String -> [String] -> IO (String, String)
try String
nm (String -> Maybe String
forall a. a -> Maybe a
Just (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:[])) [String
""]
Char
c:Char
':':String
nm -> String -> Maybe String -> [String] -> IO (String, String)
try String
nm (String -> Maybe String
forall a. a -> Maybe a
Just (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:[])) (String -> [String] -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [t a] -> [t a]
cons String
dd (String
"."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
path))
Char
'/':String
nm -> String -> Maybe String -> [String] -> IO (String, String)
try String
nm Maybe String
forall a. Maybe a
Nothing [String
""]
String
_ -> String -> Maybe String -> [String] -> IO (String, String)
try String
name Maybe String
forall a. Maybe a
Nothing (String -> [String] -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [t a] -> [t a]
cons String
dd (String
"."String -> [String] -> [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 t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
x then [t a]
xs else t a
xt a -> [t a] -> [t a]
forall a. a -> [a] -> [a]
:[t a]
xs
try :: String -> Maybe String -> [String] -> IO (String, String)
try String
name Maybe String
_ [] = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
warn (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Warning: Can't find file \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name
String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\" in directories\n\t"
String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\n\t" (String -> [String] -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [t a] -> [t a]
cons String
dd (String
"."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
path)))
String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n Asked for by: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
demand)
(String, String) -> IO (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"missing file: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name,String
"")
try String
name Maybe String
drive (String
p:[String]
ps) = do
let file :: String
file = ((String -> String)
-> (String -> String -> String) -> Maybe String -> String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> String
forall a. a -> a
id String -> String -> String
forall a. [a] -> [a] -> [a]
(++) Maybe String
drive) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
cleanPath String
pString -> String -> String
forall a. [a] -> [a] -> [a]
++Char
'/'Char -> String -> String
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
(String, String) -> IO (String, String)
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) IO String -> IO () -> IO String
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 = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
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
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`E.onException` (Handle -> IO ()
hClose Handle
hdl)