refactor commonality...

yesss
vmchale · May 13, 2024 · df78ed3 · df78ed3
1 parent 0fcd743
commit df78ed3
Show file tree

Hide file tree

Showing 4 changed files with 40 additions and 53 deletions.
diff --git a/apple.cabal b/apple.cabal
@@ -137,8 +137,8 @@ library
 
 library as
     exposed-modules:
-        As
-        Nasm
+        H
+    other-modules: Nasm, As
 
     hs-source-dirs:   as
     default-language: Haskell2010
@@ -220,10 +220,7 @@ executable writeo
     build-depends:
         base,
         as,
-        apple,
         optparse-applicative >=0.14.0.0,
-        bytestring,
-        prettyprinter,
         text
 
     if impl(ghc >=8.10)
@@ -297,12 +294,9 @@ test-suite apple-o
         tasty-hunit,
         temporary,
         process,
-        bytestring,
         text,
         filepath,
-        directory,
-        apple,
-        prettyprinter
+        directory
 
     if impl(ghc >=8.10)
         ghc-options: -Wunused-packages

diff --git a/as/H.hs b/as/H.hs
@@ -0,0 +1,22 @@
+module H ( Arch (..), run ) where
+
+import qualified As
+import           CGen
+import           Control.Exception         (throwIO)
+import qualified Data.ByteString.Lazy      as BSL
+import qualified Data.Text                 as T
+import qualified Nasm
+import           P
+import           Prettyprinter.Render.Text (hPutDoc)
+import           System.IO                 (IOMode (WriteMode), withFile)
+
+data Arch = Aarch64 | X64
+
+run :: (FilePath, Arch, T.Text) -> IO ()
+run (fpϵ, a, n) = do
+    contents <- BSL.readFile fpϵ
+    t <- either throwIO (pure.fst) (getTy contents)
+    ct <- either throwIO pure $ pCty n t
+    let asm=case a of {X64 -> Nasm.writeO; Aarch64 -> As.writeO}
+    asm n contents True
+    withFile (T.unpack n <> ".h") WriteMode $ \h -> hPutDoc h ct
diff --git a/exe/Main.hs b/exe/Main.hs
@@ -1,19 +1,11 @@
 module Main (main) where
 
-import qualified As
-import           CGen
-import           Control.Exception         (throwIO)
-import qualified Data.ByteString.Lazy      as BSL
-import qualified Data.Text                 as T
-import qualified Data.Version              as V
-import qualified Nasm
+import qualified Data.Text           as T
+import qualified Data.Version        as V
+import           H
 import           Options.Applicative
-import           P
-import qualified Paths_apple               as P
-import           Prettyprinter.Render.Text (hPutDoc)
-import           System.Info               (arch)
-import           System.IO                 (IOMode (WriteMode), withFile)
-
+import qualified Paths_apple         as P
+import           System.Info         (arch)
 
 fp :: Parser FilePath
 fp = argument str
@@ -26,8 +18,6 @@ fun = strOption
     <> metavar "FUNCTION"
     <> help "Function name in generated .o")
 
-data Arch = Aarch64 | X64
-
 farch :: Parser Arch
 farch = fmap parseArch $ optional $ strOption
     (long "arch"
@@ -58,12 +48,3 @@ versionMod = infoOption (V.showVersion P.version) (short 'V' <> long "version" <
 
 main :: IO ()
 main = run =<< execParser wrapper
-
-run :: (FilePath, Arch, T.Text) -> IO ()
-run (fpϵ, a, n) = do
-    contents <- BSL.readFile fpϵ
-    t <- either throwIO (pure.fst) (getTy contents)
-    ct <- either throwIO pure $ pCty n t
-    let asm=case a of {X64 -> Nasm.writeO; Aarch64 -> As.writeO}
-    asm n contents True
-    withFile (T.unpack n <> ".h") WriteMode $ \h -> hPutDoc h ct
diff --git a/of/Test.hs b/of/Test.hs
@@ -1,21 +1,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main (main) where
 
-import           As
-import           CGen
-import           Control.Exception         (throwIO)
-import qualified Data.ByteString.Lazy      as BSL
-import           Data.Functor              (void)
-import qualified Data.Text                 as T
-import           P                         (getTy)
-import           Prettyprinter.Render.Text (hPutDoc)
-import           System.Directory          (getCurrentDirectory, setCurrentDirectory)
-import           System.FilePath           ((</>))
-import           System.IO                 (IOMode (WriteMode), withFile)
-import           System.IO.Temp            (withSystemTempDirectory)
-import           System.Process            (proc, readCreateProcess)
-import           Test.Tasty                (TestTree, defaultMain, testGroup)
-import           Test.Tasty.HUnit          (testCase, (@?=))
+import           Data.Functor     (void)
+import qualified Data.Text        as T
+import           H
+import           System.Directory (getCurrentDirectory, setCurrentDirectory)
+import           System.FilePath  ((</>))
+import           System.IO.Temp   (withSystemTempDirectory)
+import           System.Process   (proc, readCreateProcess)
+import           Test.Tasty       (TestTree, defaultMain, testGroup)
+import           Test.Tasty.HUnit (testCase, (@?=))
 
 readCc :: FilePath -- ^ Apple source file
        -> T.Text
@@ -24,12 +18,8 @@ readCc aSrc tyt = do
     pwd <- getCurrentDirectory
     withSystemTempDirectory "apple" $ \dir -> do
         setCurrentDirectory dir
-        contents <- BSL.readFile (pwd </> aSrc)
         let n=T.unpack tyt
-        t <- either throwIO (pure.fst) (getTy contents)
-        ct <- either throwIO pure $ pCty tyt t
-        writeO tyt contents True
-        withFile (n <> ".h") WriteMode $ \h -> hPutDoc h ct
+        run (pwd </> aSrc, Aarch64, tyt)
         let c = pwd </> "test/harness" </> n <> "_harness.c"
         void $ readCreateProcess (proc "cc" [n <> ".o", c, "-I", dir, "-I", pwd </> "include"]) ""
         readCreateProcess (proc (dir </> "a.out") []) ""