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 name :: String
name demand :: Posn
demand path :: [String]
path warn :: Bool
warn =
case String
name of
c :: Char
c:':':'\\':nm :: 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 -> String -> String
forall a. a -> [a] -> [a]
:[])) [""]
c :: Char
c:':':'/':nm :: 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 -> String -> String
forall a. a -> [a] -> [a]
:[])) [""]
c :: Char
c:':':nm :: 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 -> 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]
forall a. a -> [a] -> [a]
:[String]
path))
'/':nm :: String
nm -> String -> Maybe String -> [String] -> IO (String, String)
try String
nm Maybe String
forall a. Maybe a
Nothing [""]
_ -> 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]
forall a. a -> [a] -> [a]
:[String]
path))
where
dd :: String
dd = Posn -> String
directory Posn
demand
cons :: t a -> [t a] -> [t a]
cons x :: t a
x xs :: [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 name :: String
name _ [] = 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 ("Warning: Can't find file \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name
String -> String -> String
forall a. [a] -> [a] -> [a]
++"\" 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 "\n\t" (String -> [String] -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [t a] -> [t a]
cons String
dd ("."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
path)))
String -> String -> String
forall a. [a] -> [a] -> [a]
++"\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 ("missing file: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name,"")
try name :: String
name drive :: Maybe String
drive (p :: String
p:ps :: [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 -> 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 file :: String
file = do
Handle
h <- String -> IOMode -> IO Handle
openFile String
file IOMode
ReadMode
(do TextEncoding
utf8r <- String -> IO TextEncoding
mkTextEncoding "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 f :: String
f txt :: 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
$ \hdl :: Handle
hdl->
do TextEncoding
utf8r <- String -> IO TextEncoding
mkTextEncoding "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)