{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

-- | Module that contains high-level checking for an entire directory
module CheckDir (recursiveCheckDir)  where

import           CheckMap              (MapResult, loadAndLintMap,
                                        mapresultDepends)
import           Data.Aeson            (ToJSON)
import           Data.Functor          ((<&>))
import           Data.Map              (Map)
import qualified Data.Map              as M
import           Data.Maybe            (mapMaybe)
import           Data.Text             (Text)
import qualified Data.Text             as T
import           GHC.Generics          (Generic)
import           Paths                 (normalise)
import           System.FilePath       (splitPath, (</>))
import qualified System.FilePath       as FP
import           System.FilePath.Posix (takeDirectory)
import           Types                 (Dep (LocalMap))
import           Util                  (PrettyPrint (prettyprint))

-- based on the startling observation that Data.Map has lower complexity
-- for difference than Data.Set, but the same complexity for fromList
type Set a = Map a ()
setFromList :: Ord a => [a] -> Set a
setFromList  = M.fromList . flip zip (repeat ())
listFromSet :: Set a -> [a]
listFromSet = map fst . M.toList

-- | Result of linting an entire directory / repository
data DirResult = DirResult
  { dirresultMaps :: Map FilePath MapResult
  , dirresultDeps :: [Text]
  } deriving (Generic, ToJSON)


instance PrettyPrint DirResult where
  prettyprint res = T.concat
    (map (\(p,lints) -> "\nin " <> T.pack p <> ":\n" <> prettyprint lints) $ M.toList $ dirresultMaps res)

instance Semigroup DirResult where
  a <> b = DirResult
    { dirresultMaps = dirresultMaps a <> dirresultMaps b
    , dirresultDeps = dirresultDeps a <> dirresultDeps b
    }

instance Monoid DirResult where
  mempty = DirResult
    { dirresultMaps = mempty
    , dirresultDeps = []
    }


-- | The nice function to check an entire repository with.
-- gets a prefix (i.e. the bare path to the repository) and
-- a root (i.e. the name of the file containing the entrypoint
-- map within that file)
recursiveCheckDir :: FilePath -> FilePath -> IO DirResult
recursiveCheckDir prefix root = recursiveCheckDir' prefix [root] mempty mempty

-- | The less-nice function for checking an entire repository.
--
-- Strictly speaking it probably doesn't need to have `done` and
-- `acc` since they are essentially the same thing, but doing it
-- like this seemed convenient at the time
recursiveCheckDir' :: FilePath -> [FilePath] -> Set FilePath -> DirResult -> IO DirResult
recursiveCheckDir' prefix paths done acc = do
  putStrLn $ "linting " <> show paths

  -- lint all maps in paths
  lints <-
    let lintPath p = loadAndLintMap (prefix </> p) depth <&> (p,)
          where depth = length (splitPath p) - 1
    in mapM lintPath paths


  let mapdeps = concatMap
       (\(m,res) ->
          let ps = mapMaybe
                (\case {LocalMap p -> Just p; _ -> Nothing})
                (mapresultDepends res)
          in map (FP.normalise . normalise (takeDirectory m)) ps
       )
       lints

  -- build a Set containing all newly found dependencies, with paths
  -- from the repository's directory, normalised not to start with ./ etc.
  let setdeps = setFromList
       mapdeps
  -- that which is yet to do (O(m+n))
  let unknowns = listFromSet $ M.difference setdeps done
  -- that which is done
  let knowns = M.union done $ setFromList paths

  -- Monoids!
  let acc' = acc <> DirResult
                { dirresultMaps = M.fromList lints
                , dirresultDeps = [] }
  -- Tail recursion!
  case unknowns of
    [] -> pure acc'
    _  -> recursiveCheckDir' prefix unknowns knowns acc'