{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module FastTags.Cabal (parse) where
#if ! MIN_VERSION_Cabal(2, 2, 0)
parse :: FilePath -> IO (Either String (FilePath, [FilePath]))
parse = const $ return $ Left "cabal parsing not supported <Cabal-2.2.0"
#else
import qualified Control.Monad as Monad
import Control.Applicative ((<*>))
import Control.Monad ((<=<))
import qualified Data.ByteString as ByteString
import Data.Functor ((<$>))
import Data.Monoid ((<>))
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Encoding
import qualified Data.Text.Encoding.Error as Encoding.Error
#if MIN_VERSION_Cabal(3, 0, 0)
import qualified Distribution.Fields.Parser as Parser
#else
import qualified Distribution.Parsec.Parser as Parser
#endif
parse :: FilePath -> IO (Either String (FilePath, [FilePath]))
parse fname =
first ((fname <> ": ")<>) . (extract <=< first show . Parser.readFields) <$>
ByteString.readFile fname
extract :: Show ann => [Parser.Field ann]
-> Either String (FilePath, [FilePath])
extract parsed = do
fields <- library parsed
(,) <$> hsSourceDir fields <*> return (exposed fields)
where
hsSourceDir fields = case commaField (findField "hs-source-dirs" fields) of
[] -> Right "."
[dir] -> Right $ Text.unpack dir
dir : _ -> Right $ Text.unpack dir
exposed = map moduleToFile . commaField . findField "exposed-modules"
library = maybe (Right []) Right . find isLibrary
isLibrary (Parser.Section (Parser.Name _ name) [] fields)
| caseEq name "library" = Just fields
isLibrary _ = Nothing
commaField :: Text.Text -> [Text.Text]
commaField = Text.words . Text.replace "," " "
moduleToFile :: Text.Text -> FilePath
moduleToFile = Text.unpack . (<>".hs") . Text.replace "." "/"
findField :: Text.Text -> [Parser.Field ann] -> Text.Text
findField name = Text.unwords . maybe [] (map get) . find (isField name)
where
get (Parser.FieldLine _ fieldName) = utf8 fieldName
isField name (Parser.Field (Parser.Name _ fieldName) lines)
| caseEq fieldName name = Just lines
isField _ _ = Nothing
find :: (a -> Maybe b) -> [a] -> Maybe b
find f = Monad.msum . map f
caseEq :: ByteString.ByteString -> Text.Text -> Bool
caseEq bytes text = Text.toLower (utf8 bytes) == text
utf8 :: ByteString.ByteString -> Text.Text
utf8 = Encoding.decodeUtf8With Encoding.Error.lenientDecode
first :: (a -> c) -> Either a b -> Either c b
first f (Left a) = Left (f a)
first _ (Right b) = Right b
#endif