{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module NixFromNpm.ConvertToNix where

import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import Data.Text (Text)
import qualified Data.Text as T

import NixFromNpm.Common
import Nix.Expr
import Nix.Parser
import NixFromNpm.NpmTypes
import NixFromNpm.SemVer
import NixFromNpm.Parsers.SemVer
import NixFromNpm.NpmLookup


_startingSrc :: Text
_startingSrc = unlines [
  "{nixpkgs ? import <nixpkgs> {}}:",
  "let",
  "  allPkgs = nixpkgs // nodePkgs // {inherit (nixpkgs.nodePackages)",
  "      buildNodePackage;};",
  "  callPackage = pth: overrides: let",
  "    f = import pth;",
  "  in",
  "    f ((builtins.intersectAttrs (builtins.functionArgs f) allPkgs)",
  "       // overrides);",
  "  nodePkgs = byVersion // defaults;",
  "in",
  "nodePkgs"
  ]

_startingExpr :: NixExpr
_startingExpr = fromRight $ parseNix _startingSrc

callPackage :: NixExpr -> NixExpr
callPackage e = Apply (Apply (Var "callPackage") e) (Set False [])

fixName :: Name -> Name
fixName = T.replace "." "-"

toDepName :: Name -> SemVer -> Name
toDepName name (a, b, c) = concat [fixName name, "_", pack $
                                   intercalate "-" $ map show [a, b, c]]

toDotNix :: SemVer -> Text
toDotNix (a,b,c) = pack $ intercalate "." (map show [a,b,c]) <> ".nix"

distInfoToNix :: DistInfo -> NixExpr
distInfoToNix DistInfo{..} = Apply (Var "fetchurl") $ Set False
  [ "url" =$= str diUrl,
    "sha1" =$=  str diShasum ]

metaNotEmpty :: PackageMeta -> Bool
metaNotEmpty PackageMeta{..} = isJust pmDescription

metaToNix :: PackageMeta -> NixExpr
metaToNix PackageMeta{..} = case pmDescription of
  Nothing -> Set False []
  Just d -> Set False ["description" =$= str d]

resolvedPkgToNix :: ResolvedPkg -> NixExpr
resolvedPkgToNix ResolvedPkg{..} = do
  let deps = map (Var . uncurry toDepName) $ H.toList rpDependencies
      _funcParams = map (uncurry toDepName) (H.toList rpDependencies)
                    <> ["buildNodePackage", "fetchurl"]
      funcParams = toKwargs $ map (\x -> (x, Nothing)) _funcParams
  let args = Set False $ catMaybes [
        Just $ "name" =$= str rpName,
        Just $ "version" =$= (str $ renderSV rpVersion),
        Just $ "src" =$= distInfoToNix rpDistInfo,
        maybeIf (length deps > 0) $ "deps" =$= List deps,
        maybeIf (metaNotEmpty rpMeta) $ "meta" =$= metaToNix rpMeta
        ]
  Function funcParams $ Apply (Var "buildNodePackage") args

mkDefault :: Record (HashMap SemVer a) -> NixExpr
mkDefault rec = do
  let mkPath name ver = fromText $ concat ["./", name, "/", toDotNix ver]
      mkAssign name ver = Assign [Plain $ toDepName name ver]
                                 (callPackage $ Path $ mkPath name ver)
      mkAssigns name vers = map (mkAssign name) vers
      mkDefVer name vers = do
        Assign [Plain $ fixName name] (Var $ toDepName name $ maximum vers)
      -- This bit of map gymnastics will create a list of pairs of names
      -- with all of the versions of that name that we have.
      versOnly = map (map (map fst)) $ H.toList $ map H.toList rec
      byVersion = Set False $ concatMap (uncurry mkAssigns) versOnly
      defaults = With (Var "byVersion") $
        Set False $ map (uncurry mkDefVer) versOnly
      newAssigns = ["byVersion" =$= byVersion, "defaults" =$= defaults]
      Function params (Let assigns e) = _startingExpr
  Function params (Let (assigns <> newAssigns) e)

dumpPkgs :: MonadIO m
         => String
         -> Record (HashMap SemVer (Either NixExpr ResolvedPkg))
         -> m ()
dumpPkgs path rPkgs = liftIO $ do
  createDirectoryIfMissing True path
  withDir path $ forM_ (H.toList rPkgs) $ \(pkgName, pkgVers) -> do
    writeFile "default.nix" $ renderIndented 2 $ mkDefault rPkgs
    let subdir = path </> unpack pkgName
    createDirectoryIfMissing False subdir
    withDir subdir $ forM_ (H.toList pkgVers) $ \(ver, rpkg) -> do
      let nixexpr = case rpkg of
            Left e -> e
            Right r -> resolvedPkgToNix r
      writeFile (unpack $ toDotNix ver) $ renderIndented 2 nixexpr

parseVersion :: String -> IO (Maybe (SemVer, NixExpr))
parseVersion pth = do
  case parseSemVer . pack $ dropSuffix ".nix" $ takeBaseName pth of
    Left _ -> return Nothing -- not a version file
    Right version -> parseNix . pack <$> readFile pth >>= \case
      Left err -> do
        putStrsLn [pack pth, " failed to parse: ", pack $ show err]
        return Nothing -- invalid nix, should overwrite
      Right expr -> return $ Just (version, expr)

findExisting :: String -> IO (Record (HashMap SemVer NixExpr))
findExisting path = do
  putStrLn "Searching for existing expressions..."
  doesDirectoryExist path >>= \case
    False -> return mempty
    True -> withDir path $ do
      contents <- getDirectoryContents "."
      verMaps <- forM contents $ \dir -> do
        exprs <- doesDirectoryExist dir >>= \case
          True -> withDir dir $ do
            contents <- getDirectoryContents "."
            let files = filter (endswith ".nix") contents
            catMaybes <$> mapM parseVersion files
          False -> do
            putStrsLn [pack dir, " is not a directory"]
            return mempty -- not a directory
        case exprs of
          [] -> return Nothing
          vs -> return $ Just (pack dir, H.fromList exprs)
      let total = sum $ map (H.size . snd) $ catMaybes verMaps
      putStrsLn ["Found ", render total, " existing expressions"]
      return $ H.fromList $ catMaybes verMaps

-- | Various options we have available for nixfromnpm. As of right now,
-- most of these are unimplemented.
data NixFromNpmOptions = NixFromNpmOptions {
  nfnoPkgName :: Name,
  nfnoOutputPath :: Text,
  nfnoNoCache :: Bool,
  nfnoExtendPaths :: [Text],
  nfnoTest :: Bool,
  nfnoRegistries :: [Text],
  nfnoTimeout :: Int
} deriving (Show, Eq)

defaultOptions :: Name -> Text -> NixFromNpmOptions
defaultOptions pkgName outputPath = NixFromNpmOptions {
  nfnoPkgName = pkgName,
  nfnoOutputPath = outputPath,
  nfnoNoCache = False,
  nfnoExtendPaths = [],
  nfnoTest = False,
  nfnoTimeout = 10,
  nfnoRegistries = []
  }              

dumpPkgNamed :: Bool -> Text -> Text -> IO ()
dumpPkgNamed noExistCheck name path = do
  existing <- if noExistCheck then pure mempty else findExisting $ unpack path
  getPkg name existing >>= dumpPkgs (unpack path)

dumpPkgFromOptions :: NixFromNpmOptions -> IO ()
dumpPkgFromOptions NixFromNpmOptions{..} = do
  dumpPkgNamed nfnoNoCache nfnoPkgName nfnoOutputPath