{-# LANGUAGE StrictData #-}
module Language.Cimple.IO
( parseFile
, parseFiles
, parseProgram
, parseText
) where
import Control.Monad.State.Lazy (State, evalState, get, put)
import qualified Data.ByteString as BS
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Language.Cimple.AST (Node (..))
import Language.Cimple.Lexer (Lexeme, runAlex)
import Language.Cimple.Parser (parseCimple)
import Language.Cimple.Program (Program)
import qualified Language.Cimple.Program as Program
import Language.Cimple.TranslationUnit (TranslationUnit)
type CacheState a = State (Map String Text) a
cacheText :: String -> CacheState Text
cacheText :: String -> CacheState Text
cacheText String
s = do
Map String Text
m <- StateT (Map String Text) Identity (Map String Text)
forall s (m :: * -> *). MonadState s m => m s
get
case String -> Map String Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
s Map String Text
m of
Maybe Text
Nothing -> do
let text :: Text
text = String -> Text
Text.pack String
s
Map String Text -> StateT (Map String Text) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Map String Text -> StateT (Map String Text) Identity ())
-> Map String Text -> StateT (Map String Text) Identity ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> Map String Text -> Map String Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
s Text
text Map String Text
m
Text -> CacheState Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
text
Just Text
text ->
Text -> CacheState Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
text
process :: [Node (Lexeme String)] -> [Node (Lexeme Text)]
process :: [Node (Lexeme String)] -> [Node (Lexeme Text)]
process [Node (Lexeme String)]
stringAst =
State (Map String Text) [Node (Lexeme Text)]
-> Map String Text -> [Node (Lexeme Text)]
forall s a. State s a -> s -> a
evalState ((Node (Lexeme String)
-> StateT (Map String Text) Identity (Node (Lexeme Text)))
-> [Node (Lexeme String)]
-> State (Map String Text) [Node (Lexeme Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Lexeme String -> StateT (Map String Text) Identity (Lexeme Text))
-> Node (Lexeme String)
-> StateT (Map String Text) Identity (Node (Lexeme Text))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> CacheState Text)
-> Lexeme String -> StateT (Map String Text) Identity (Lexeme Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> CacheState Text
cacheText)) [Node (Lexeme String)]
stringAst) Map String Text
forall k a. Map k a
Map.empty
parseText :: Text -> Either String [Node (Lexeme Text)]
parseText :: Text -> Either String [Node (Lexeme Text)]
parseText Text
contents =
[Node (Lexeme String)] -> [Node (Lexeme Text)]
process ([Node (Lexeme String)] -> [Node (Lexeme Text)])
-> Either String [Node (Lexeme String)]
-> Either String [Node (Lexeme Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String [Node (Lexeme String)]
res
where
res :: Either String [Node (Lexeme String)]
res :: Either String [Node (Lexeme String)]
res = String
-> Alex [Node (Lexeme String)]
-> Either String [Node (Lexeme String)]
forall a. String -> Alex a -> Either String a
runAlex (Text -> String
Text.unpack Text
contents) Alex [Node (Lexeme String)]
parseCimple
parseFile :: FilePath -> IO (Either String (TranslationUnit Text))
parseFile :: String -> IO (Either String (TranslationUnit Text))
parseFile String
source =
Either String [Node (Lexeme Text)]
-> Either String (TranslationUnit Text)
forall b. Either String b -> Either String (String, b)
addSource (Either String [Node (Lexeme Text)]
-> Either String (TranslationUnit Text))
-> (ByteString -> Either String [Node (Lexeme Text)])
-> ByteString
-> Either String (TranslationUnit Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String [Node (Lexeme Text)]
parseText (Text -> Either String [Node (Lexeme Text)])
-> (ByteString -> Text)
-> ByteString
-> Either String [Node (Lexeme Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Either String (TranslationUnit Text))
-> IO ByteString -> IO (Either String (TranslationUnit Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
source
where
addSource :: Either String b -> Either String (String, b)
addSource (Left String
err) = String -> Either String (String, b)
forall a b. a -> Either a b
Left (String -> Either String (String, b))
-> String -> Either String (String, b)
forall a b. (a -> b) -> a -> b
$ String
"In file \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
source String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
addSource (Right b
ok) = (String, b) -> Either String (String, b)
forall a b. b -> Either a b
Right (String
source, b
ok)
parseFiles :: [FilePath] -> IO (Either String [TranslationUnit Text])
parseFiles :: [String] -> IO (Either String [TranslationUnit Text])
parseFiles [String]
sources = [Either String (TranslationUnit Text)]
-> Either String [TranslationUnit Text]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([Either String (TranslationUnit Text)]
-> Either String [TranslationUnit Text])
-> IO [Either String (TranslationUnit Text)]
-> IO (Either String [TranslationUnit Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Either String (TranslationUnit Text)))
-> [String] -> IO [Either String (TranslationUnit Text)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO (Either String (TranslationUnit Text))
parseFile [String]
sources
parseProgram :: [FilePath] -> IO (Either String (Program Text))
parseProgram :: [String] -> IO (Either String (Program Text))
parseProgram [String]
sources = (Either String [TranslationUnit Text]
-> ([TranslationUnit Text] -> Either String (Program Text))
-> Either String (Program Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TranslationUnit Text] -> Either String (Program Text)
Program.fromList) (Either String [TranslationUnit Text]
-> Either String (Program Text))
-> IO (Either String [TranslationUnit Text])
-> IO (Either String (Program Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> IO (Either String [TranslationUnit Text])
parseFiles [String]
sources