Format: ormolu

.dir-locals.el

@@ -0,0 +1,4 @@
+; emacs config
+
+((haskell-mode
+   (mode . ormolu-format-0.0.5.0-on-save)))

bowtie-blueprint/Main.hs

@@ -2,9 +2,8 @@ module Main (main) where
 
 import Bowtie.Blueprint
 import Bowtie.Lib.Prelude
-import Options.Applicative
-
 import qualified Data.Text.IO as TIO
+import Options.Applicative
 
 main :: IO ()
 main = do
@@ -25,7 +24,8 @@ configParser =
     parser :: Parser Config
     parser =
       Config
-        <$> argument str
-            (  metavar "FILE"
-            <> help "Path to source file"
-            )
+        <$> argument
+          str
+          ( metavar "FILE"
+              <> help "Path to source file"
+          )

bowtie-blueprint/src/Bowtie/Blueprint.hs

@@ -2,7 +2,6 @@ module Bowtie.Blueprint where
 
 import Bowtie.Lib.Prelude
 import Bowtie.Type.AST (Type, TypeDeclaration)
-
 import qualified Bowtie.Type.Parse as Parse
 import qualified CMark
 import qualified Data.HashMap.Strict as HashMap
@@ -20,26 +19,22 @@ data Item
 
 blueprint :: Text -> Either Text Blueprint
 blueprint src = do
-  let
-    node :: CMark.Node
-    node =
-      CMark.commonmarkToNode mempty src
-
-    codeBlocks :: [Text]
-    codeBlocks =
-      extractCode node
+  let node :: CMark.Node
+      node =
+        CMark.commonmarkToNode mempty src
+      codeBlocks :: [Text]
+      codeBlocks =
+        extractCode node
 
   code <- case codeBlocks of
-            [] ->
-              Left "no code found in markdown file"
-
-            _ ->
-              pure (Text.intercalate "\n" codeBlocks)
+    [] ->
+      Left "no code found in markdown file"
+    _ ->
+      pure (Text.intercalate "\n" codeBlocks)
 
   case parseBlueprint code of
     Left e -> do
       Left (Text.pack (Mega.errorBundlePretty e))
-
     Right bp -> do
       pure bp
 
@@ -48,7 +43,6 @@ blueprintIO src =
   case blueprint src of
     Left e ->
       exitWithError e
-
     Right bp ->
       pure bp
 
@@ -58,17 +52,24 @@ conv items =
   where
     decls :: HashMap Id TypeDeclaration
     decls =
-      let xs = mapMaybe (\a -> case a of
-                                 Decl id def -> Just (id, def)
-                                 Func {} -> Nothing) items
-      in HashMap.fromList xs
-
+      let xs =
+            mapMaybe
+              ( \a -> case a of
+                  Decl id def -> Just (id, def)
+                  Func {} -> Nothing
+              )
+              items
+       in HashMap.fromList xs
     funcs :: HashMap Id Type
     funcs =
-      let xs = mapMaybe (\a -> case a of
-                                 Func id def -> Just (id, def)
-                                 Decl {} -> Nothing) items
-      in HashMap.fromList xs
+      let xs =
+            mapMaybe
+              ( \a -> case a of
+                  Func id def -> Just (id, def)
+                  Decl {} -> Nothing
+              )
+              items
+       in HashMap.fromList xs
 
 parseBlueprint :: Text -> Either (Mega.ParseErrorBundle Text Void) Blueprint
 parseBlueprint =
@@ -85,9 +86,10 @@ programTypesParser = do
 
 parseOne :: Parse.Parser Item
 parseOne =
-  Mega.label "parseOne"
-    (   Mega.try (fmap (uncurry Decl) Parse.typeDeclarationParser)
-    <|> Mega.try (fmap (uncurry Func) Parse.typeSignatureParser)
+  Mega.label
+    "parseOne"
+    ( Mega.try (fmap (uncurry Decl) Parse.typeDeclarationParser)
+        <|> Mega.try (fmap (uncurry Func) Parse.typeSignatureParser)
     )
 
 -- * Markdown
@@ -101,9 +103,7 @@ extractCode (CMark.Node _ nodeType nodes) =
       case nt of
         CMark.CODE_BLOCK _ t ->
           [t]
-
         CMark.CODE _ ->
           mempty
-
         _ ->
           mempty

bowtie-blueprint/test/Test.hs

@@ -2,13 +2,12 @@ module Main where
 
 import Bowtie.Blueprint
 import Bowtie.Lib.Prelude
-import System.Directory
-import System.FilePath (takeExtension, (</>))
-import Test.Hspec
-
 import qualified Data.List as List
 import qualified Data.Text as Text
 import qualified Data.Text.IO as TIO
+import System.Directory
+import System.FilePath ((</>), takeExtension)
+import Test.Hspec
 
 dir :: FilePath
 dir =
@@ -21,7 +20,6 @@ main = do
   hspec do
     describe "blueprint" $
       for_ blueprintExamples g
-
   where
     g :: FilePath -> Spec
     g path =
@@ -30,16 +28,14 @@ main = do
         case blueprint src of
           Left e ->
             expectationFailure (Text.unpack e)
-
           Right _ ->
             pure ()
 
 getBlueprintExamples :: IO [FilePath]
 getBlueprintExamples = do
   appPaths <- listDirectory dir
-  let
-    (blueprints, other) =
-      List.partition (\path -> takeExtension path == ".md") appPaths
+  let (blueprints, other) =
+        List.partition (\path -> takeExtension path == ".md") appPaths
 
   when
     (other /= mempty)

bowtie-js/Main.hs

@@ -1,11 +1,10 @@
 module Main where
 
+import qualified Bowtie.Interpret as Interpret
 import Bowtie.JS
 import Bowtie.Lib.Prelude
-import Options.Applicative
-
-import qualified Bowtie.Interpret as Interpret
 import qualified Data.Text.IO as TIO
+import Options.Applicative
 
 main :: IO ()
 main = do
@@ -15,7 +14,6 @@ main = do
   case Interpret.sourcesToCore libFiles (name, appSource) of
     Left e ->
       exitWithError (Interpret.prettyError e)
-
     Right (env, coreExpr) ->
       TIO.putStrLn (transpileCore env coreExpr)
 
@@ -32,7 +30,8 @@ configParser =
     parser :: Parser Config
     parser =
       Config
-        <$> argument str
-            (  metavar "FILE"
-            <> help "Path to source file"
-            )
+        <$> argument
+          str
+          ( metavar "FILE"
+              <> help "Path to source file"
+          )

bowtie-js/src/Bowtie/JS.hs

@@ -1,26 +1,26 @@
 {-# LANGUAGE QuasiQuotes #-}
 
 module Bowtie.JS
-  ( transpile
-  , transpileCore
-  , transpileAndExecute
-  , appendConsoleLog
-  , runTextCommand
-  ) where
+  ( transpile,
+    transpileCore,
+    transpileAndExecute,
+    appendConsoleLog,
+    runTextCommand,
+  )
+where
 
+import qualified Bowtie.Core.Expr as Core
+import qualified Bowtie.Interpret as Interpret
 import Bowtie.JS.Imperativize (makeImp)
 import Bowtie.JS.Serialize (serializeTop)
 import Bowtie.Lib.Environment
 import Bowtie.Lib.Prelude
+import qualified Data.ByteString.Lazy as LBS
 import Data.String.QQ (s)
+import qualified Data.Text as Text
 import Data.Text.Encoding (decodeUtf8)
 import System.Process.Typed
 
-import qualified Bowtie.Core.Expr as Core
-import qualified Bowtie.Interpret as Interpret
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Text as Text
-
 -- | Internal.
 builtinJsSource :: Text
 builtinJsSource =
@@ -53,10 +53,8 @@ transpile src = do
 
 transpileCore :: Environment -> Core.Expr -> Text
 transpileCore env expr =
-  let
-    jsAST = makeImp env expr
-  in
-    "'use strict';\n\n" <> builtinJsSource <> "\n" <> serializeTop jsAST
+  let jsAST = makeImp env expr
+   in "'use strict';\n\n" <> builtinJsSource <> "\n" <> serializeTop jsAST
 
 transpileAndExecute :: Text -> IO Text
 transpileAndExecute src = do
@@ -70,28 +68,31 @@ appendConsoleLog js =
 -- * Below should be in a lib somewhere
 
 -- | NOTE: Only used with trused input!
-runTextCommand
-  :: Text -- ^ Command injection vulnerability when passed untrusted input.
-  -> Text -- ^ Command injection vulnerability when passed untrusted input.
-  -> IO Text
+runTextCommand ::
+  -- | Command injection vulnerability when passed untrusted input.
+  Text ->
+  -- | Command injection vulnerability when passed untrusted input.
+  Text ->
+  IO Text
 runTextCommand cmd input = do
   res <- runCommand cmd "" (encodeUtf8 input)
   pure (decodeUtf8 res) -- todo
 
 -- | NOTE: Only used with trused input!
-runCommand
-  :: Text -- ^ Command injection vulnerability when passed untrusted input.
-  -> Text -- ^ Command injection vulnerability when passed untrusted input.
-  -> ByteString
-  -> IO ByteString
+runCommand ::
+  -- | Command injection vulnerability when passed untrusted input.
+  Text ->
+  -- | Command injection vulnerability when passed untrusted input.
+  Text ->
+  ByteString ->
+  IO ByteString
 runCommand cmd arg input = do
   fmap LBS.toStrict (readProcessStdout_ proc2)
   where
     -- Command with argument
     proc1 :: ProcessConfig () () ()
     proc1 =
       shell (Text.unpack cmd <> " " <> Text.unpack arg)
-
     -- Command with argument and stdin
     proc2 :: ProcessConfig () () ()
     proc2 =

bowtie-js/src/Bowtie/JS/AST.hs

@@ -7,24 +7,24 @@ data AST
   = Var Id
   | Lam Id AST
   | App AST AST
-
   | Assignment AST AST
   | Block [AST]
   | Return AST
-
   | Array [AST]
   | IndexArray AST Natural
   | IfThen AST AST
   | Else AST
   | Throw AST -- Will only be used with JSString
   | Equal AST AST
-  | LambdaUnit AST -- ^ @(() => { " <> ast <> "})()@
-
+  | -- | @(() => { " <> ast <> "})()@
+    LambdaUnit AST
   | JSInt Integer
   | JSString Text
-
   | Compare AST AST
-  | Plus AST AST -- ^ Only works on Ints
-  | Multiply AST AST -- ^ Only works on Ints
-  | ShowInt AST -- ^ Only works on Int
+  | -- | Only works on Ints
+    Plus AST AST
+  | -- | Only works on Ints
+    Multiply AST AST
+  | -- | Only works on Int
+    ShowInt AST
   deriving (Eq, Show)