Migrate to polysemy, and rely on Stack's ghci

Speed up file processing when no macros need to be expanded

.gitignore

@@ -34,3 +34,5 @@ flycheck_*.hs
 
 ctags
 TAGS
+
+.stack-work-profile

app/Main.axel

@@ -8,13 +8,12 @@
 (import Axel.Haskell.Project (buildProject runProject))
 (import Axel.Haskell.Stack (axelStackageVersion))
 (import Axel.Parse.Args ((Command Convert File Project Version) commandParser))
-(import Axel.Sourcemap (ModuleInfo))
 (import Control.Monad (void))
-(import Control.Monad.Freer (Eff))
-(import Control.Monad.Freer.State (evalState))
 (importq Data.Map Map (empty))
 (import Options.Applicative (<**> execParser helper info progDesc))
-(def app ((-> Command) (Eff AppEffs Unit)) (((Convert filePath)) (void (convertFileInPlace filePath))) (((File filePath)) (void ((evalState (raw "@ModuleInfo") Map.empty) (transpileFileInPlace filePath)))) (((Project)) (>> buildProject runProject)) (((Version)) (putStrLn (<> "Axel version " axelStackageVersion))))
+(importq Polysemy Sem all)
+(importq Polysemy.State Sem all)
+(def app ((-> Command) (Sem.Sem AppEffs Unit)) (((Convert filePath)) (void (convertFileInPlace filePath))) (((File filePath)) (void ((Sem.evalState Map.empty) (transpileFileInPlace filePath)))) (((Project)) (>> buildProject runProject)) (((Version)) (putStrLn (<> "Axel version " axelStackageVersion))))
 (def main (IO Unit)
  (()
   (do'

app/Main.hs

@@ -1,34 +1,23 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeApplications #-}
-
 module Main where
-
-import Axel.Eff.App (AppEffs, runApp)
-import Axel.Eff.Console (putStrLn)
-import Axel.Haskell.File (convertFileInPlace, transpileFileInPlace)
-import Axel.Haskell.Project (buildProject, runProject)
-import Axel.Haskell.Stack (axelStackageVersion)
 import qualified Axel.Parse.AST as AST
-import Axel.Parse.Args (Command(Convert, File, Project, Version), commandParser)
-import Axel.Sourcemap (ModuleInfo)
-import Control.Monad (void)
-import Control.Monad.Freer (Eff)
-import Control.Monad.Freer.State (evalState)
-import qualified Data.Map as Map (empty)
-import Options.Applicative ((<**>), execParser, helper, info, progDesc)
 import Prelude hiding (putStrLn)
-
+import Axel.Eff.App(AppEffs,runApp)
+import Axel.Eff.Console(putStrLn)
+import Axel.Haskell.File(convertFileInPlace,transpileFileInPlace)
+import Axel.Haskell.Project(buildProject,runProject)
+import Axel.Haskell.Stack(axelStackageVersion)
+import Axel.Parse.Args(Command(Convert,File,Project,Version),commandParser)
+import Control.Monad(void)
+import qualified Data.Map as Map(empty)
+import Options.Applicative((<**>),execParser,helper,info,progDesc)
+import qualified Polysemy as Sem
+import qualified Polysemy.State as Sem
 app (Convert filePath) = (void (convertFileInPlace filePath))
-app (File filePath) =
-  (void ((evalState @ModuleInfo Map.empty) (transpileFileInPlace filePath)))
-app (Project) = ((>>) buildProject runProject)
-app (Version) = (putStrLn ((<>) "Axel version " axelStackageVersion))
-
-app :: (((->) Command) (Eff AppEffs ()))
-main =
-  ((>>=)
-     (execParser
-        (info ((<**>) commandParser helper) (progDesc "The command to run.")))
-     (\modeCommand -> (runApp (app modeCommand))))
-
-main :: (IO ())
+app (File filePath) = (void ((Sem.evalState Map.empty) (transpileFileInPlace filePath)))
+app (Project ) = ((>>) buildProject runProject)
+app (Version ) = (putStrLn ((<>) "Axel version " axelStackageVersion))
+app :: (((->) Command) (Sem.Sem AppEffs ()))
+main  = ((>>=) (execParser (info ((<**>) commandParser helper) (progDesc "The command to run."))) (\modeCommand -> (runApp (app modeCommand))))
+main :: (IO ())

axel.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 6cdc724c94594384a55a9cfc42ffde020330f0b49bbad59f1003426afa3ac897
+-- hash: 02eb56c7e3847de6387a3dd322f45cc761d4d5786775d4ef3e337c2267e03de8
 
 name:           axel
 version:        0.0.11
@@ -27,6 +27,8 @@ extra-source-files:
     scripts/format.sh
     scripts/ghcid.sh
     scripts/lint.sh
+    scripts/onHsFiles.sh
+    scripts/stackProfile.sh
     scripts/test.sh
 data-files:
     resources/autogenerated/macros/AST.hs
@@ -90,7 +92,7 @@ library
       Paths_axel
   hs-source-dirs:
       src
-  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-import-lists -Wno-missing-export-lists -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -optP-Wno-nonportable-include-path
+  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-import-lists -Wno-missing-export-lists -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -optP-Wno-nonportable-include-path -fplugin=Polysemy.Plugin -O2 -flate-specialise -fspecialise-aggressively
   build-tool-depends:
       hpack:hpack
     , tasty-discover:tasty-discover
@@ -102,7 +104,6 @@ library
     , containers
     , directory
     , filepath
-    , freer-simple
     , ghcid
     , hashable
     , haskell-src-exts
@@ -111,6 +112,8 @@ library
     , lens-aeson
     , optparse-applicative
     , parsec
+    , polysemy
+    , polysemy-plugin
     , process
     , profunctors
     , regex-pcre
@@ -132,17 +135,18 @@ executable axel
       Paths_axel
   hs-source-dirs:
       app
-  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-import-lists -Wno-missing-export-lists -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-import-lists -Wno-missing-export-lists -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -optP-Wno-nonportable-include-path -fplugin=Polysemy.Plugin -O2 -flate-specialise -fspecialise-aggressively -threaded -rtsopts -with-rtsopts=-N
   build-tool-depends:
       hpack:hpack
     , tasty-discover:tasty-discover
   build-depends:
       axel
     , base
     , containers
-    , freer-simple
     , hpack
     , optparse-applicative
+    , polysemy
+    , polysemy-plugin
     , tasty-discover
   default-language: Haskell2010
 
@@ -175,7 +179,7 @@ test-suite axel-test
       Paths_axel
   hs-source-dirs:
       test
-  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-import-lists -Wno-missing-export-lists -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N -Wno-missing-import-lists
+  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-import-lists -Wno-missing-export-lists -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -optP-Wno-nonportable-include-path -fplugin=Polysemy.Plugin -O2 -flate-specialise -fspecialise-aggressively -threaded -rtsopts -with-rtsopts=-N
   build-tool-depends:
       hpack:hpack
     , tasty-discover:tasty-discover
@@ -185,10 +189,11 @@ test-suite axel-test
     , bytestring
     , containers
     , filepath
-    , freer-simple
     , hedgehog
     , hpack
     , lens
+    , polysemy
+    , polysemy-plugin
     , split
     , tasty
     , tasty-discover

package.yaml

@@ -23,12 +23,19 @@ ghc-options:
 - -Wno-safe
 - -Wno-unsafe
 - -optP-Wno-nonportable-include-path # https://github.com/haskell/cabal/issues/4739
+# Polysemy https://github.com/polysemy-research/polysemy#necessary-language-extensions
+- -fplugin=Polysemy.Plugin
+- -O2
+- -flate-specialise
+- -fspecialise-aggressively
 build-tools:
 - hpack:hpack
 - tasty-discover:tasty-discover
 dependencies:
 - base
 - hpack
+- polysemy
+- polysemy-plugin
 - tasty-discover
 data-files:
 - resources/**/*
@@ -42,7 +49,6 @@ library:
   - containers
   - directory
   - filepath
-  - freer-simple
   - ghcid
   - hashable
   - haskell-src-exts
@@ -73,7 +79,6 @@ executables:
     dependencies:
     - axel
     - containers
-    - freer-simple
     - optparse-applicative
 tests:
   axel-test:
@@ -83,13 +88,11 @@ tests:
     - -threaded
     - -rtsopts
     - -with-rtsopts=-N
-    - -Wno-missing-import-lists
     dependencies:
     - axel
     - bytestring
     - containers
     - filepath
-    - freer-simple
     - hedgehog
     - lens
     - split

scripts/format.sh

@@ -1 +1 @@
-find app src test -type f | grep -e '^.*\.hs$' | grep -v 'app/Main.hs' | grep -v 'src/Axel/Parse/Args.hs' | grep -v 'src/Axel.hs' | grep -v 'src/Axel/Haskell/Macros.hs' | xargs -L 1 hindent
+./onHsFiles.sh hindent

scripts/ghcid.sh

@@ -1,5 +1 @@
-if [ "$1" == "test" ]; then
-    ghcid --command "stack ghci axel:lib axel:test:axel-test --ghc-options='-Wno-missing-import-lists -O0'" --test "main"
-elif [ -z "$1" ]; then
-    ghcid --command "stack ghci --ghc-options='-O0' axel"
-fi
+ghcid --command "stack ghci axel:lib axel:test:axel-test --ghc-options='-O0'"

scripts/lint.sh

@@ -1 +1 @@
-find app src test -type f | grep '^.*\.hs$' | grep -v 'app/Main.hs' | grep -v 'src/Axel/Parse/Args.hs' | grep -v 'src/Axel.hs' | grep -v 'src/Axel/Haskell/Macros.hs' | xargs -L 1 hlint --color=always | grep -v 'No hints'
+./onHsFiles.sh "hlint --color=always | grep -v 'No hints'"

scripts/onHsFiles.sh

@@ -0,0 +1 @@
+find app src test -type f | grep '^.*\.hs$' | grep -v 'app/Main.hs' | grep -v 'src/Axel/Parse/Args.hs' | grep -v 'src/Axel.hs' | grep -v 'src/Axel/Haskell/Macros.hs' | xargs -L 1 "$1"

scripts/stackProfile.sh

@@ -0,0 +1 @@
+stack --work-dir .stack-work-profile --profile "$@"

scripts/test.sh

@@ -5,4 +5,4 @@ set -o pipefail
 # and consume ridiculous amounts of memory and CPU.
 trap "killall axel-test ghc" EXIT
 
-stack test --fast --ghc-options "-g" --test-arguments "--hide-successes --num-threads 1" "$@"
+stack test --fast --ghc-options "-g" --test-arguments "--hide-successes" "$@"

src/Axel/Eff.hs

@@ -2,8 +2,8 @@
 
 module Axel.Eff where
 
-import Control.Monad.Freer (Eff, Members)
+import Polysemy (Members, Sem)
 
 type Callback effs fn a
    = forall openEffs. (Members effs openEffs) =>
-                        fn (Eff openEffs a)
+                        fn (Sem openEffs a)

src/Axel/Eff/App.hs

@@ -11,15 +11,15 @@ import Axel.Eff.Log (Log, runLogAsFileSystem)
 import Axel.Eff.Process (Process, runProcess)
 import Axel.Eff.Resource (Resource, runResource)
 
-import Control.Monad.Freer (type (~>), Eff, runM)
-import qualified Control.Monad.Freer.Error as Effs (Error)
+import qualified Polysemy as Sem
+import qualified Polysemy.Error as Sem
 
 type AppEffs
-   = '[ Log, Console, Effs.Error Error, FileSystem, Ghci, Process, Resource, IO]
+   = '[ Log, Console, Sem.Error Error, FileSystem, Ghci, Process, Resource, Sem.Embed IO]
 
-runApp :: Eff AppEffs ~> IO
+runApp :: Sem.Sem AppEffs a -> IO a
 runApp =
-  runM .
+  Sem.runM .
   runResource .
   runProcess .
   runGhci .

src/Axel/Eff/Console.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeOperators #-}
@@ -11,27 +12,29 @@ module Axel.Eff.Console where
 import Prelude hiding (putStr, putStrLn)
 import qualified Prelude
 
-import Control.Monad.Freer (type (~>), Eff, LastMember, Member, interpretM)
-import Control.Monad.Freer.TH (makeEffect)
+import qualified Polysemy as Sem
 
 import qualified System.Console.ANSI as ANSI (getTerminalSize)
 
-data Console r where
-  GetTerminalSize :: Console (Maybe (Int, Int))
-  PutStr :: String -> Console ()
+data Console m a where
+  GetTerminalSize :: Console m (Maybe (Int, Int))
+  PutStr :: String -> Console m ()
 
-makeEffect ''Console
+Sem.makeSem ''Console
 
-runConsole :: (LastMember IO effs) => Eff (Console ': effs) ~> Eff effs
+runConsole ::
+     (Sem.Member (Sem.Embed IO) effs)
+  => Sem.Sem (Console ': effs) a
+  -> Sem.Sem effs a
 runConsole =
-  interpretM $ \case
-    GetTerminalSize -> ANSI.getTerminalSize
-    PutStr str -> Prelude.putStr str
+  Sem.interpret $ \case
+    GetTerminalSize -> Sem.embed ANSI.getTerminalSize
+    PutStr str -> Sem.embed $ Prelude.putStr str
 
-putStrLn :: (Member Console effs) => String -> Eff effs ()
+putStrLn :: (Sem.Member Console effs) => String -> Sem.Sem effs ()
 putStrLn = putStr . (<> "\n")
 
-putHorizontalLine :: (Member Console effs) => Eff effs ()
+putHorizontalLine :: (Sem.Member Console effs) => Sem.Sem effs ()
 putHorizontalLine = do
   maybeTerminalSize <- getTerminalSize
   case maybeTerminalSize of

src/Axel/Eff/Error.hs

@@ -3,19 +3,21 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
 
 module Axel.Eff.Error where
 
 import Axel.Parse.AST (Expression, toAxel)
 
 import Control.Monad ((>=>))
-import Control.Monad.Freer (type (~>), Eff)
-import Control.Monad.Freer.Error (runError)
-import qualified Control.Monad.Freer.Error as Effs (Error)
 
 import Data.Semigroup ((<>))
 
+import qualified Polysemy as Sem
+import qualified Polysemy.Error as Sem
+
 data Error where
   ConvertError :: FilePath -> String -> Error
   MacroError :: FilePath -> Expression ann -> String -> Error
@@ -41,5 +43,5 @@ instance Show Error where
 fatal :: String -> String -> a
 fatal context message = error $ "[FATAL] " <> context <> " - " <> message
 
-unsafeRunError :: (Show e) => Eff (Effs.Error e ': effs) ~> Eff effs
-unsafeRunError = runError >=> either (errorWithoutStackTrace . show) pure -- TODO Don't(?) use `error(WithoutStackTrace)` directly
+unsafeRunError :: (Show e) => Sem.Sem (Sem.Error e ': effs) a -> Sem.Sem effs a
+unsafeRunError = Sem.runError >=> either (errorWithoutStackTrace . show) pure -- TODO Don't(?) use `error(WithoutStackTrace)` directly