diff --git a/anansi.cabal b/anansi.cabal --- a/anansi.cabal +++ b/anansi.cabal @@ -1,5 +1,5 @@ name: anansi -version: 0.2.1.2 +version: 0.2.1.3 synopsis: Simple literate programming preprocessor license: GPL-3 license-file: license.txt @@ -30,10 +30,10 @@ base >=4.0 && < 5.0 , parsec >= 3.0 && < 3.2 , bytestring >= 0.9 && < 0.10 - , text >= 0.7 && < 0.11 + , text >= 0.7 && < 0.12 , monads-tf >= 0.1 && < 0.2 , containers >= 0.1 && < 0.5 - , filepath >= 1.1 && < 1.2 + , system-filepath >= 0.1.1 && < 0.2 exposed-modules: Anansi @@ -62,8 +62,8 @@ build-depends: base >=4.0 && < 5.0 , bytestring >= 0.9 && < 0.10 - , text >= 0.7 && < 0.11 + , text >= 0.7 && < 0.12 , monads-tf >= 0.1 && < 0.2 - , filepath >= 1.1 && < 1.3 + , system-filepath >= 0.1.1 && < 0.2 , directory >= 1.0 && < 1.2 , anansi diff --git a/lib/Anansi/Parser.hs b/lib/Anansi/Parser.hs --- a/lib/Anansi/Parser.hs +++ b/lib/Anansi/Parser.hs @@ -32,7 +32,8 @@ import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import qualified Data.Map as Map -import System.FilePath (replaceFileName) +import System.FilePath (FilePath) +import qualified System.FilePath.CurrentOS as FP import Anansi.Types import Anansi.Util @@ -68,7 +69,7 @@ getPosition :: Monad m => P.ParsecT s u m Position getPosition = do pos <- P.getPosition - return $ Position (TL.pack (P.sourceName pos)) (toInteger (P.sourceLine pos)) + return $ Position (FP.fromString (P.sourceName pos)) (toInteger (P.sourceLine pos)) parseLines :: P.Parsec String u [Line] parseLines = do @@ -181,20 +182,25 @@ text <- untilChar '\n' return . ContentText pos $ text -type FilePath = TL.Text type FileMap = Map.Map FilePath [Line] genLines :: Monad m => (FilePath -> m [Line]) -> FilePath -> S.StateT FileMap m [Line] genLines getLines = genLines' where genLines' path = lift (getLines path) >>= concatMapM (resolveIncludes path) - relative x y = TL.pack $ replaceFileName (TL.unpack x) (TL.unpack y) + textToPath :: TL.Text -> FilePath + textToPath = FP.fromString . TL.unpack + relative :: FilePath -> TL.Text -> FilePath + relative x y = FP.append (FP.parent x) (textToPath y) + + -- relative x y = TL.pack $ replaceFileName (TL.unpack x) (TL.unpack y) + resolveIncludes root line = case line of LineCommand _ (CommandInclude path) -> genLines' $ relative root path _ -> return [line] -parseFile :: TL.Text -> IO (Either ParseError [Block]) +parseFile :: FilePath -> IO (Either ParseError [Block]) parseFile root = io where io = E.handle onError $ do lines' <- S.evalStateT (genLines getLines root) Map.empty @@ -204,10 +210,10 @@ getLines :: FilePath -> IO [Line] getLines path = do - -- TODO: encode 'path' into UTF-8? - let path' = TL.unpack path - bytes <- B.readFile path' - case P.parse parseLines path' (T.unpack $ TE.decodeUtf8 bytes) of + let strPath = FP.toString path + bytes <- B.readFile strPath + let contents = T.unpack (TE.decodeUtf8 bytes) + case P.parse parseLines strPath contents of Right x -> return x Left err -> let msg = TL.pack $ "getLines parse failed (internal error): " ++ show err diff --git a/lib/Anansi/Tangle.hs b/lib/Anansi/Tangle.hs --- a/lib/Anansi/Tangle.hs +++ b/lib/Anansi/Tangle.hs @@ -15,12 +15,16 @@ -- {-# LANGUAGE OverloadedStrings #-} module Anansi.Tangle (tangle) where + +import Prelude hiding (FilePath) import Control.Monad (when) import Control.Monad.Trans (lift) import qualified Control.Monad.State as S import qualified Control.Monad.Writer as W import qualified Data.Text.Lazy as TL import qualified Data.Map as Map +import System.FilePath (FilePath) +import qualified System.FilePath.CurrentOS as FP import Anansi.Types type ContentMap = Map.Map TL.Text [Content] @@ -52,7 +56,7 @@ S.put $ Map.insertWith accum name content files tangle :: Monad m - => (TL.Text -> TL.Text -> m ()) + => (FilePath -> TL.Text -> m ()) -> Bool -- ^ Enable writing #line declarations -> [Block] -> m () @@ -64,7 +68,7 @@ putFile (path, content) = do text <- W.execWriterT (mapM_ (putContent enableLine) content) - lift $ writeFile' path text + lift $ writeFile' (FP.fromString (TL.unpack path)) text putContent :: Monad m => Bool -> Content -> TangleT m () putContent enableLine (ContentText pos t) = do diff --git a/lib/Anansi/Types.hs b/lib/Anansi/Types.hs --- a/lib/Anansi/Types.hs +++ b/lib/Anansi/Types.hs @@ -18,7 +18,9 @@ , Content (..) , Position (..) ) where +import Prelude hiding (FilePath) import Data.Text.Lazy (Text) +import System.FilePath.CurrentOS (FilePath) data Block = BlockText Text @@ -32,7 +34,7 @@ deriving (Show) data Position = Position - { positionFile :: Text + { positionFile :: FilePath , positionLine :: Integer } deriving (Show, Eq) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -15,9 +15,9 @@ -- {-# LANGUAGE OverloadedStrings #-} module Main (main) where - import Anansi +import Prelude hiding (FilePath) import Control.Monad.Writer import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TLIO @@ -28,14 +28,15 @@ import System.Directory import System.Environment import System.Exit -import System.FilePath -import System.IO hiding (withFile) +import System.FilePath (FilePath) +import qualified System.FilePath.CurrentOS as FP +import System.IO hiding (withFile, FilePath) data Output = Tangle | Weave data Option = OptionOutput Output - | OptionOutputPath TL.Text + | OptionOutputPath FilePath | OptionLoom TL.Text | OptionNoLines @@ -45,7 +46,7 @@ "Generate tangled source code (default)" , Option ['w'] ["weave"] (NoArg (OptionOutput Weave)) "Generate woven markup" - , Option ['o'] ["out", "output"] (ReqArg (OptionOutputPath . TL.pack) "PATH") + , Option ['o'] ["out", "output"] (ReqArg (OptionOutputPath . FP.fromString) "PATH") "Output path (directory for tangle, file for weave)" , Option ['l'] ["loom"] (ReqArg (OptionLoom . TL.pack) "NAME") "Which loom should be used to weave output" @@ -62,16 +63,16 @@ OptionOutput o -> o _ -> getOutput xs -getPath :: [Option] -> TL.Text +getPath :: [Option] -> FilePath getPath [] = "" getPath (x:xs) = case x of OptionOutputPath p -> p _ -> getPath xs -withFile :: TL.Text -> (Handle -> IO a) -> IO a -withFile path io = case path of - "" -> io stdout - _ -> withBinaryFile (TL.unpack path) WriteMode io +withFile :: FilePath -> (Handle -> IO a) -> IO a +withFile path io = if FP.null path + then io stdout + else withBinaryFile (FP.toString path) WriteMode io loomMap :: [(TL.Text, Loom)] loomMap = [(loomName l, l) | l <- looms] @@ -117,19 +118,20 @@ texts = execWriter $ loomWeave loom blocks in withFile path $ \h -> BL.hPut h $ encodeUtf8 texts -debugTangle :: TL.Text -> TL.Text -> IO () +debugTangle :: FilePath -> TL.Text -> IO () debugTangle path text = do + let strPath = FP.toString path putStr "\n" - TLIO.putStrLn path - putStrLn $ replicate (fromIntegral (TL.length path)) '=' + putStrLn strPath + putStrLn $ replicate (fromIntegral (length strPath)) '=' TLIO.putStr text -realTangle :: TL.Text -> TL.Text -> TL.Text -> IO () +realTangle :: FilePath -> FilePath -> TL.Text -> IO () realTangle root path text = do - let fullpath = combine (TL.unpack root) (TL.unpack path) - createDirectoryIfMissing True $ takeDirectory fullpath + let fullpath = FP.append root path + createDirectoryIfMissing True (FP.toString (FP.parent fullpath)) let bytes = encodeUtf8 text - withBinaryFile fullpath ReadWriteMode $ \h -> do + withBinaryFile (FP.toString fullpath) ReadWriteMode $ \h -> do equal <- fileContentsEqual h bytes unless equal $ do hSetFileSize h 0 @@ -151,7 +153,7 @@ parseInputs :: [String] -> IO (Either ParseError [Block]) parseInputs inputs = do - eithers <- mapM (parseFile . TL.pack) inputs + eithers <- mapM (parseFile . FP.fromString) inputs return $ case catEithers eithers of Left err -> Left err Right bs -> Right $ concat bs @@ -159,7 +161,7 @@ formatError :: ParseError -> String formatError err = concat [filename, ":", line, ": error: ", message] where pos = parseErrorPosition err - filename = TL.unpack $ positionFile pos + filename = FP.toString (positionFile pos) line = show $ positionLine pos message = TL.unpack $ parseErrorMessage err