content: {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module Hie.Locate
    ( nestedPkg,
      stackYamlPkgs,
      cabalPkgs,
    )
  where
  
  import Control.Exception
  import Control.Monad.IO.Class
  import Control.Monad.Trans.Maybe
  import Data.Attoparsec.Text (parseOnly)
  import Data.Either
  import Data.List
  import Data.Maybe
  import qualified Data.Text as T
  import qualified Data.Text.IO as T
  import Data.Yaml
  import Hie.Cabal.Parser
  import System.Directory
  import System.FilePath.Posix
  import System.FilePattern.Directory (getDirectoryFiles)
  
  newtype Pkgs = Pkgs [FilePath]
    deriving (Eq, Ord)
  
  instance FromJSON Pkgs where
    parseJSON (Object v) = Pkgs <$> v .:? "packages" .!= ["."]
    parseJSON _ = fail "could not read packages from stack.yaml"
  
  stackYamlPkgs :: FilePath -> MaybeT IO [FilePath]
  stackYamlPkgs p =
    liftIO $
      decodeFileEither (p </> "stack.yaml") >>= \case
        Right (Pkgs f) ->
          liftIO $
            map (p </>)
              <$> getDirectoryFiles p (map (</> "*.cabal") f)
        Left e -> fail $ show e
  
  cabalPkgs :: FilePath -> MaybeT IO [FilePath]
  cabalPkgs p = do
    cp <- cabalP "cabal.project"
    cl <- cabalP "cabal.project.local"
    case concat . rights $ map (parseOnly extractPkgs) $ rights [cp, cl] of
      [] ->
        liftIO (cfs p) >>= \case
          [] -> fail "no cabal files found"
          h : _ -> pure [p </> h]
      xs -> do
        cd <- liftIO $ map (p </>) <$> getDirectoryFiles p (map (matchDirs . T.unpack) xs)
        cf <-
          liftIO $
            mapM (\p -> if takeExtension p == ".cabal" then pure [p] else cfs p) cd
        pure $ concat cf
    where
      cabalP n = liftIO (try $ T.readFile $ p </> n :: IO (Either IOException T.Text))
      cfs d = filter ((".cabal" ==) . takeExtension) <$> listDirectory d
      matchDirs "." = "./*.cabal"
      matchDirs p | "/" `isSuffixOf` p || p == "." = p <> "*.cabal"
      matchDirs p | "*" `isSuffixOf` p || takeExtension p == "" = p <> "/*.cabal"
      matchDirs p = p
  
  nestedPkg :: FilePath -> FilePath -> IO (Maybe Package)
  nestedPkg parrent child = do
    f' <- T.readFile child
    case parsePackage' f' of
      Right (Package n cs) -> do
        let dir =
              fromJust $
                stripPrefix (splitDirectories parrent) $
                  splitDirectories $
                    fst (splitFileName child)
            pkg =
              Package n $
                map
                  ( \(Comp t n p) ->
                      Comp t n (T.pack $ joinPath dir </> T.unpack p)
                  )
                  cs
        pure $ Just pkg
      _ -> pure Nothing
  