diff --git a/app/Main.hs b/app/Main.hs index 1fcb73e..b4447b6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -5,6 +5,7 @@ module Main where import Control.Monad import Control.Monad.Trans.Maybe import Data.Maybe +import Hie.Cabal.Parser import Hie.Locate import Hie.Yaml import System.Directory @@ -16,27 +17,29 @@ import System.IO main :: IO () main = do pwd <- getCurrentDirectory - name <- resolveName pwd - cfs <- runMaybeT $ case name of - "cabal" -> cabalPkgs pwd - _ -> stackYamlPkgs pwd + ct <- resolveCradleType pwd + cfs <- runMaybeT $ case ct of + CabalCradle -> cabalPkgs pwd + StackCradle -> stackYamlPkgs pwd when (null cfs) $ die $ - "Used " <> name + "Used " + <> cradleTypeName ct <> "\n No .cabal files found under" <> pwd <> "\n You may need to run stack build." pkgs <- catMaybes <$> mapM (nestedPkg pwd) (concat cfs) - putStr <$> hieYaml name $ fmtPkgs name pkgs + putStr <$> hieYaml ct $ fmtPkgs ct pkgs -resolveName :: FilePath -> IO String -resolveName pwd = do +resolveCradleType :: FilePath -> IO CradleType +resolveCradleType pwd = do args <- getArgs files <- listDirectory pwd when ("--help" `elem` args || "-h" `elem` args) $ do progName <- getProgName hPutStrLn stderr $ - "Usage: " <> progName + "Usage: " + <> progName <> " [ --cabal | --stack ]\n\n\ \If neither argument is given then " <> progName @@ -44,13 +47,13 @@ resolveName pwd = do \looking for dist-newstyle, .stack-work, cabal.project and stack.yaml in that order." exitSuccess let fileNames = map takeFileName files - name = + ct = if - | "--cabal" `elem` args -> "cabal" - | "--stack" `elem` args -> "stack" - | "dist-newstyle" `elem` fileNames -> "cabal" - | ".stack-work" `elem` fileNames -> "stack" - | "cabal.project" `elem` fileNames -> "cabal" - | "stack.yaml" `elem` fileNames -> "stack" - | otherwise -> "cabal" - return name + | "--cabal" `elem` args -> CabalCradle + | "--stack" `elem` args -> StackCradle + | "dist-newstyle" `elem` fileNames -> CabalCradle + | ".stack-work" `elem` fileNames -> StackCradle + | "cabal.project" `elem` fileNames -> CabalCradle + | "stack.yaml" `elem` fileNames -> StackCradle + | otherwise -> CabalCradle + return ct diff --git a/src/Hie/Cabal/Parser.hs b/src/Hie/Cabal/Parser.hs index fbedb31..7cc3703 100644 --- a/src/Hie/Cabal/Parser.hs +++ b/src/Hie/Cabal/Parser.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -6,6 +7,9 @@ module Hie.Cabal.Parser Component (..), CompType (..), Name, + CradleType (..), + CradlePer (..), + cradleTypeName, extractPkgs, parsePackage', ) @@ -71,6 +75,17 @@ data Component = Comp CompType Name Path deriving (Show, Eq, Ord) +data CradleType = StackCradle | CabalCradle + deriving (Eq, Show) + +cradleTypeName :: CradleType -> String +cradleTypeName = \case + StackCradle -> "stack" + CabalCradle -> "cabal" + +data CradlePer = PerSrcDir | PerModule + deriving (Eq, Show) + parseQuoted :: Parser Text parseQuoted = do q <- char '"' <|> char '\'' diff --git a/src/Hie/Yaml.hs b/src/Hie/Yaml.hs index 0f11682..b2583a3 100644 --- a/src/Hie/Yaml.hs +++ b/src/Hie/Yaml.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Hie.Yaml @@ -6,17 +7,18 @@ module Hie.Yaml fmtPkgs, cabalComponent, stackComponent, + component, ) where import qualified Data.Text as T import Hie.Cabal.Parser -hieYaml :: String -> String -> String -hieYaml sOrC pkgs = +hieYaml :: CradleType -> String -> String +hieYaml ct pkgs = "cradle:\n" <> indent' - (sOrC <> ":\n" <> indent' pkgs) + (cradleTypeName ct <> ":\n" <> indent' pkgs) indent' :: String -> String indent' = @@ -28,6 +30,11 @@ indent' = ) . lines +component :: CradleType -> Name -> Component -> (FilePath, String) +component = \case + CabalCradle -> cabalComponent + StackCradle -> stackComponent + cabalComponent :: Name -> Component -> (FilePath, String) cabalComponent n (Comp Lib "" p) = (T.unpack p, T.unpack $ "lib:" <> n) cabalComponent n (Comp Lib cn p) = (T.unpack p, T.unpack $ n <> ":lib:" <> cn) @@ -54,11 +61,10 @@ fmtComponent (p, c) = dropLast :: [a] -> [a] dropLast l = take (length l - 1) l -fmtPkgs :: String -> [Package] -> String -fmtPkgs sOrC pkgs = dropLast $ unlines l +fmtPkgs :: CradleType -> [Package] -> String +fmtPkgs ct pkgs = dropLast $ unlines l where - comp = if sOrC == "cabal" then cabalComponent else stackComponent - f (Package n cs) = map ((<> "\n") . fmtComponent . comp n) cs + f (Package n cs) = map ((<> "\n") . fmtComponent . component ct n) cs l = concatMap f pkgs dQuote :: String -> String