restructure common directives code; simplify language definitions

Author: dschrempf

magix.cabal

@@ -59,11 +59,11 @@ library
     Magix.Build
     Magix.Config
     Magix.Directives
-    Magix.Directives.Common
     Magix.Expression
     Magix.Hash
     Magix.Languages.Bash.Directives
     Magix.Languages.Bash.Expression
+    Magix.Languages.Common.Directives
     Magix.Languages.Haskell.Directives
     Magix.Languages.Haskell.Expression
     Magix.Languages.Python.Directives
@@ -113,10 +113,10 @@ test-suite test-magix
   hs-source-dirs:     test
   other-modules:
     Magix.BuildSpec
-    Magix.Directives.CommonSpec
     Magix.DirectivesSpec
     Magix.Languages.Bash.DirectivesSpec
     Magix.Languages.Bash.ExpressionSpec
+    Magix.Languages.Common.DirectivesSpec
     Magix.Languages.Haskell.DirectivesSpec
     Magix.Languages.Haskell.ExpressionSpec
     Magix.Languages.Python.DirectivesSpec

src/Magix/Directives.hs

@@ -13,6 +13,8 @@ module Magix.Directives
   ( Directives (..),
     getLanguageName,
     pShebang,
+    pMagixDirective,
+    pLanguageDirectives,
     pDirectives,
     getDirectives,
   )
@@ -21,13 +23,13 @@ where
 import Control.Applicative (Alternative (..))
 import Control.Exception (Exception)
 import Data.Bifunctor (Bifunctor (..))
-import Data.Text (Text, unpack)
-import Magix.Directives.Common (Parser, pDirectiveWithValue, pMagixDirective)
+import Data.Text (Text, pack, unpack)
 import Magix.Languages.Bash.Directives (BashDirectives, pBashDirectives)
+import Magix.Languages.Common.Directives (Parser, pDirectiveWithValue)
 import Magix.Languages.Haskell.Directives (HaskellDirectives, pHaskellDirectives)
 import Magix.Languages.Python.Directives (PythonDirectives, pPythonDirectives)
 import Text.Megaparsec (MonadParsec (notFollowedBy, try), chunk, errorBundlePretty, parse)
-import Text.Megaparsec.Char (hspace, newline, space)
+import Text.Megaparsec.Char (alphaNumChar, hspace, newline, space)
 import Prelude hiding (readFile)
 
 data Directives
@@ -45,20 +47,26 @@ getLanguageName (Python _) = "Python"
 pShebang :: Parser Text
 pShebang = pDirectiveWithValue "/usr/bin/env" (chunk "magix")
 
-pLanguageSpecificDirectives :: Parser Directives
-pLanguageSpecificDirectives = do
+pLanguage :: Parser Text
+pLanguage = pack <$> some alphaNumChar
+
+pMagixDirective :: Parser Text
+pMagixDirective = pDirectiveWithValue "magix" pLanguage <* hspace
+
+pLanguageDirectives :: Parser Directives
+pLanguageDirectives = do
   language <- pMagixDirective
-  let newlineWith parser = try (newline *> parser) <|> mempty
+  let withNewline p = try (newline *> p) <|> mempty
   directives <- case language of
-    "bash" -> Bash <$> newlineWith pBashDirectives
-    "haskell" -> Haskell <$> newlineWith pHaskellDirectives
-    "python" -> Python <$> newlineWith pPythonDirectives
+    "bash" -> Bash <$> withNewline pBashDirectives
+    "haskell" -> Haskell <$> withNewline pHaskellDirectives
+    "python" -> Python <$> withNewline pPythonDirectives
     unknownLanguage -> fail $ "unknown language: " <> unpack unknownLanguage
   notFollowedBy $ space *> chunk "#!"
   pure directives
 
 pDirectives :: Parser Directives
-pDirectives = pShebang *> hspace *> newline *> space *> pLanguageSpecificDirectives
+pDirectives = pShebang *> hspace *> newline *> pLanguageDirectives
 
 data DirectivesParseError = DirectivesParseError
   { _directives :: !Text,

src/Magix/Languages/Bash/Directives.hs

@@ -16,14 +16,15 @@ module Magix.Languages.Bash.Directives
 where
 
 import Data.Text (Text)
-import Magix.Directives.Common (Parser, pDirectiveWithValues, pLanguageDirectives)
+import Magix.Languages.Common.Directives
+  ( Parser,
+    pDirectiveWithValues,
+    pManyDirectives,
+  )
 import Prelude hiding (readFile)
 
 newtype BashDirectives = BashDirectives {_packages :: [Text]}
   deriving (Eq, Show, Semigroup, Monoid)
 
-pPackages :: Parser BashDirectives
-pPackages = BashDirectives <$> pDirectiveWithValues "packages"
-
 pBashDirectives :: Parser BashDirectives
-pBashDirectives = pLanguageDirectives pPackages
+pBashDirectives = pManyDirectives $ BashDirectives <$> pDirectiveWithValues "packages"

src/Magix/Directives/Common.hs renamed to src/Magix/Languages/Common/Directives.hs

@@ -1,5 +1,5 @@
 -- |
--- Module      :  Magix.Directives.Common
+-- Module      :  Magix.Languages.Common.Directives
 -- Description :  Common tools for parsing directives
 -- Copyright   :  2024 Dominik Schrempf
 -- License     :  GPL-3.0-or-later
@@ -9,12 +9,11 @@
 -- Portability :  portable
 --
 -- Creation date: Fri Oct 18 09:17:40 2024.
-module Magix.Directives.Common
+module Magix.Languages.Common.Directives
   ( Parser,
     pDirectiveWithValue,
     pDirectiveWithValues,
-    pMagixDirective,
-    pLanguageDirectives,
+    pManyDirectives,
   )
 where
 
@@ -40,9 +39,6 @@ type Parser = Parsec Void Text
 pDirective :: Text -> Parser Text
 pDirective d = chunk "#!" *> chunk d
 
-pLanguage :: Parser Text
-pLanguage = pack <$> some alphaNumChar
-
 pValue :: Parser Text
 pValue = pack <$> some (alphaNumChar <|> punctuationChar <|> symbolChar)
 
@@ -52,10 +48,5 @@ pDirectiveWithValue d p = pDirective d *> hspace *> p
 pDirectiveWithValues :: Text -> Parser [Text]
 pDirectiveWithValues d = pDirectiveWithValue d (sepEndBy1 pValue hspace)
 
-pMagixDirective :: Parser Text
-pMagixDirective = pDirectiveWithValue "magix" pLanguage <* hspace
-
-pLanguageDirectives :: (Monoid b) => Parser b -> Parser b
-pLanguageDirectives pLanguageDirective =
-  mconcat
-    <$> sepEndBy pLanguageDirective (hspace <* newline)
+pManyDirectives :: (Monoid b) => Parser b -> Parser b
+pManyDirectives p = mconcat <$> sepEndBy p (hspace <* newline)

src/Magix/Languages/Haskell/Directives.hs

@@ -17,7 +17,11 @@ where
 
 import Control.Applicative (Alternative (..))
 import Data.Text (Text)
-import Magix.Directives.Common (Parser, pDirectiveWithValues, pLanguageDirectives)
+import Magix.Languages.Common.Directives
+  ( Parser,
+    pDirectiveWithValues,
+    pManyDirectives,
+  )
 import Text.Megaparsec (try)
 import Prelude hiding (readFile)
 
@@ -46,8 +50,5 @@ pGhcFlags = do
   flags <- pDirectiveWithValues "ghcFlags"
   pure $ HaskellDirectives [] flags
 
-pHaskellDirective :: Parser HaskellDirectives
-pHaskellDirective = try pHaskellPackages <|> pGhcFlags
-
 pHaskellDirectives :: Parser HaskellDirectives
-pHaskellDirectives = pLanguageDirectives pHaskellDirective
+pHaskellDirectives = pManyDirectives $ try pHaskellPackages <|> pGhcFlags

src/Magix/Languages/Python/Directives.hs

@@ -16,14 +16,17 @@ module Magix.Languages.Python.Directives
 where
 
 import Data.Text (Text)
-import Magix.Directives.Common (Parser, pDirectiveWithValues, pLanguageDirectives)
+import Magix.Languages.Common.Directives
+  ( Parser,
+    pDirectiveWithValues,
+    pManyDirectives,
+  )
 import Prelude hiding (readFile)
 
 newtype PythonDirectives = PythonDirectives {_pythonPackages :: [Text]}
   deriving (Eq, Show, Semigroup, Monoid)
 
-pPythonPackages :: Parser PythonDirectives
-pPythonPackages = PythonDirectives <$> pDirectiveWithValues "pythonPackages"
-
 pPythonDirectives :: Parser PythonDirectives
-pPythonDirectives = pLanguageDirectives pPythonPackages
+pPythonDirectives =
+  pManyDirectives $
+    PythonDirectives <$> pDirectiveWithValues "pythonPackages"

test/Magix/Directives/CommonSpec.hs

@@ -17,7 +17,13 @@ where
 import Data.Either (isLeft, isRight)
 import Data.Text (Text, unlines)
 import Data.Text.IO (readFile)
-import Magix.Directives (Directives (..), pDirectives, pShebang)
+import Magix.Directives
+  ( Directives (..),
+    pDirectives,
+    pLanguageDirectives,
+    pMagixDirective,
+    pShebang,
+  )
 import Magix.Languages.Bash.Directives (BashDirectives (..))
 import Magix.Languages.Haskell.Directives (HaskellDirectives (..))
 import Magix.Tools (parse')
@@ -37,44 +43,6 @@ fnMinimalHaskell = "test-scripts/haskell/minimal"
 readMinimalHaskell :: IO Text
 readMinimalHaskell = readFile fnMinimalHaskell
 
-spaceTest :: Text
-spaceTest =
-  unlines
-    [ "#!/usr/bin/env magix",
-      "#!magix bash",
-      "#!packages a ",
-      ""
-    ]
-
-newlineTest :: Text
-newlineTest =
-  unlines
-    [ "#!/usr/bin/env magix",
-      "#!magix bash",
-      "#!packages a",
-      ""
-    ]
-
-newlineEmptyTest :: Text
-newlineEmptyTest =
-  unlines
-    [ "#!/usr/bin/env magix",
-      "#!magix bash",
-      ""
-    ]
-
-emptySpaceTest :: Text
-emptySpaceTest =
-  unlines
-    [ "#!/usr/bin/env \t magix\t ",
-      "#!magix \t bash \t"
-    ]
-
-directiveNotNewlineTest :: Text
-directiveNotNewlineTest =
-  unlines
-    ["#!/usr/bin/env \t magix\t #!magix \t bash \t"]
-
 spec :: Spec
 spec = do
   describe "pShebang" $ do
@@ -89,6 +57,31 @@ spec = do
       parse pShebang "" "#/usr/bin/env magix" `shouldSatisfy` isLeft
       parse pShebang "" "#/usr/bin/env3magix" `shouldSatisfy` isLeft
 
+  describe "pMagixDirective" $ do
+    it "parses sample Magix directives" $ do
+      parse pMagixDirective "" "#!magix haskell" `shouldBe` Right "haskell"
+      parse pMagixDirective "" "#!magix foo" `shouldBe` Right "foo"
+
+    it "fails on wrong Magix directives" $ do
+      parse pMagixDirective "" "#!magic haskell" `shouldSatisfy` isLeft
+      parse pMagixDirective "" "#!magic" `shouldSatisfy` isLeft
+
+  describe "pLanguageDirectives" $ do
+    it "parses sample language directives" $ do
+      parse pLanguageDirectives "" "#!magix bash\n#!packages bar" `shouldSatisfy` isRight
+      parse pLanguageDirectives "" "#!magix bash" `shouldSatisfy` isRight
+      parse pLanguageDirectives "" "#!magix bash\t" `shouldSatisfy` isRight
+      parse pLanguageDirectives "" "#!magix \tbash\t" `shouldSatisfy` isRight
+      parse pLanguageDirectives "" "#!magix \tbash\n\n" `shouldSatisfy` isRight
+
+    it "fails on wrong language directives" $ do
+      parse pLanguageDirectives "" "#! bar" `shouldSatisfy` isLeft
+      parse pLanguageDirectives "" "#!magix bash\n\n#!packages bar" `shouldSatisfy` isLeft
+      parse pLanguageDirectives "" "#!magix bash #!packages bar" `shouldSatisfy` isLeft
+      parse pLanguageDirectives "" "#! magix bash\n#!packages bar" `shouldSatisfy` isLeft
+      parse pLanguageDirectives "" "#!magix bash\n\n#!" `shouldSatisfy` isLeft
+      parse pLanguageDirectives "" "#!magix bash\n\n#!foo" `shouldSatisfy` isLeft
+
   describe "pDirectives" $ do
     it "parses minimal sample scripts" $ do
       minimalBash <- readMinimalBash
@@ -99,10 +92,38 @@ spec = do
         `shouldBe` Right (Haskell (HaskellDirectives ["bytestring"] ["-threaded"]))
 
     it "parses some edge cases" $ do
+      let spaceTest :: Text =
+            unlines
+              [ "#!/usr/bin/env magix",
+                "#!magix bash",
+                "#!packages a ",
+                ""
+              ]
       parse' pDirectives spaceTest `shouldBe` Bash (BashDirectives ["a"])
+      let newlineTest :: Text =
+            unlines
+              [ "#!/usr/bin/env magix",
+                "#!magix bash",
+                "#!packages a",
+                ""
+              ]
       parse' pDirectives newlineTest `shouldBe` Bash (BashDirectives ["a"])
+      let newlineEmptyTest :: Text =
+            unlines
+              [ "#!/usr/bin/env magix",
+                "#!magix bash",
+                ""
+              ]
       parse' pDirectives newlineEmptyTest `shouldBe` Bash (BashDirectives [])
+      let emptySpaceTest :: Text =
+            unlines
+              [ "#!/usr/bin/env \t magix\t ",
+                "#!magix \t bash \t"
+              ]
       parse' pDirectives emptySpaceTest `shouldBe` Bash (BashDirectives [])
 
     it "fails on some edge cases" $
-      parse pDirectives "" directiveNotNewlineTest `shouldSatisfy` isLeft
+      let directiveNotNewlineTest :: Text =
+            unlines
+              ["#!/usr/bin/env \t magix\t #!magix \t bash \t"]
+       in parse pDirectives "" directiveNotNewlineTest `shouldSatisfy` isLeft