{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Parse Cabal files.
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

{- | First I look for the library section, then get two things from it:

    > Section (Name _ "library") [] fields
    > Field (Name _ "hs-source-dirs") [FieldLine _ dir]
    > Field (Name _ "exposed-modules") [name | FieldLine _ name]
-}
extract :: Show ann => [Parser.Field ann]
    -> Either String (FilePath, [FilePath]) -- ^ (hsSrcDir, modulePath)
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
        -- to support it, I'd have to search myself.  Too much bother.
        dir : _ -> Right $ Text.unpack dir
        -- dirs -> Left $ "multiple hs-source-dirs: " <> show dirs
    exposed = map moduleToFile . commaField . findField "exposed-modules"
    -- executable-only packages have no library section
    library = maybe (Right []) Right . find isLibrary
    isLibrary (Parser.Section (Parser.Name _ name) [] fields)
        | caseEq name "library" = Just fields
    isLibrary _ = Nothing

-- | exposed-modules might be comma separated.  It might not.  It might have
-- spaces.  Or it might not.  Who knows, it's cabal!
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

-- | Ancient ghc doesn't have Data.Bifunctor.
first :: (a -> c) -> Either a b -> Either c b
first f (Left a) = Left (f a)
first _ (Right b) = Right b

#endif