tests
This commit is contained in:
+3
-81
@@ -1,84 +1,6 @@
|
||||
{-# LANGUAGE OverloadedLabels #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# LANGUAGE OrPatterns #-}
|
||||
module Main
|
||||
(main)
|
||||
where
|
||||
module Main (main) where
|
||||
|
||||
import Gyehoek.Options
|
||||
import qualified Data.Text.IO as TIO
|
||||
import Data.Text (Text)
|
||||
import Prelude hiding (readFile)
|
||||
import Options.Applicative
|
||||
import Control.Lens
|
||||
import Data.Generics.Labels
|
||||
import System.OsPath (OsPath)
|
||||
import System.FilePath ((-<.>), dropExtension)
|
||||
import Effectful.FileSystem
|
||||
import Effectful
|
||||
import Effectful.FileSystem.IO qualified as FS
|
||||
import Effectful.FileSystem.IO.ByteString qualified as FB
|
||||
import Gyehoek.GenSym (runGenSym, GenSym, gensym, gensym')
|
||||
import qualified Gyehoek.Sexp as Sexp
|
||||
import Data.Text.Lens
|
||||
import Data.List (List)
|
||||
import qualified Gyehoek.Scheme.Syntax as Scm
|
||||
import Effectful.Exception
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import System.IO (Handle)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Cradle as C
|
||||
import Gyehoek.CPS.Convert
|
||||
import Gyehoek.CPS.Lower
|
||||
import Data.Foldable
|
||||
import qualified Gyehoek.Scheme.Syntax
|
||||
import Gyehoek.CPS.Syntax
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Gyehoek.Driver qualified
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
opts <- execParser $ info (helper <*> parser) fullDesc
|
||||
runEff . runFileSystem . runGenSym . driver $ opts
|
||||
|
||||
|
||||
|
||||
hPutStr :: FileSystem :> es => Handle -> Text -> Eff es ()
|
||||
hPutStr h = FB.hPutStr h . T.encodeUtf8
|
||||
|
||||
hPutStrLn :: FileSystem :> es => Handle -> Text -> Eff es ()
|
||||
hPutStrLn h = FB.hPutStrLn h . T.encodeUtf8
|
||||
|
||||
hGetContents :: FileSystem :> es => Handle -> Eff es Text
|
||||
hGetContents h = T.decodeUtf8 <$> FB.hGetContents h
|
||||
|
||||
readFile :: FileSystem :> es => FilePath -> Eff es Text
|
||||
readFile f = FS.withFile f FS.ReadMode hGetContents
|
||||
|
||||
withFile
|
||||
:: (FileSystem :> es)
|
||||
=> FilePath -> FS.IOMode -> (Handle -> Eff es a) -> Eff es a
|
||||
withFile "-" FS.ReadMode k = k FS.stdin
|
||||
withFile "-" (FS.WriteMode; FS.AppendMode) k = k FS.stdout
|
||||
withFile f m k = FS.withFile f m k
|
||||
|
||||
readScm :: FileSystem :> es => FilePath -> Eff es Scm.Exp
|
||||
readScm f =
|
||||
withFile f FS.ReadMode $ \h ->
|
||||
Sexp.parseSexps f <$> hGetContents h
|
||||
>>= either error wrap
|
||||
where
|
||||
wrap [x] = pure x
|
||||
wrap xs = pure . Gyehoek.Scheme.Syntax.ExpBegin $ xs
|
||||
|
||||
driver
|
||||
:: (GenSym :> es, FileSystem :> es, IOE :> es)
|
||||
=> Options -> Eff es ()
|
||||
driver opts = do
|
||||
scm <- readScm opts.sourceFile
|
||||
cps <- convert scm (pure . Halt1)
|
||||
wat <- lower cps
|
||||
withFile opts.output FS.WriteMode \h ->
|
||||
hPutStr h wat
|
||||
main = Gyehoek.Driver.main
|
||||
|
||||
Reference in New Issue
Block a user