module Hix.New where

import Exon (exon)
import Path (parseRelDir, parseRelFile, reldir, relfile, (</>))
import Text.Casing (pascal)

import qualified Hix.Data.NewProjectConfig
import Hix.Data.NewProjectConfig (
  Author,
  HixUrl (HixUrl),
  NewProjectConfig (NewProjectConfig),
  ProjectName (ProjectName),
  )
import qualified Hix.Data.ProjectFile
import Hix.Data.ProjectFile (ProjectFile (ProjectFile), createFile)
import Hix.Monad (M, noteEnv)

license :: Author -> Text
license :: Author -> Text
license Author
author =
  [exon|Copyright (c) 2023 ##{author}

Redistribution and use in source and binary forms, with or without modification, are permitted provided that the
following conditions are met:

  1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following
  disclaimer.
  2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
  disclaimer in the documentation and/or other materials provided with the distribution.

Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those
receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except
for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,
import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired
or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by:

  (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of
  contributors, in source or binary form) alone; or
  (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such
  copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to
  be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution.

Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this
license, whether expressly, by implication, estoppel or otherwise.

DISCLAIMER

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|]

flake :: NewProjectConfig -> Text
flake :: NewProjectConfig -> Text
flake NewProjectConfig {$sel:name:NewProjectConfig :: NewProjectConfig -> ProjectName
name = ProjectName Text
name, $sel:hixUrl:NewProjectConfig :: NewProjectConfig -> HixUrl
hixUrl = HixUrl Text
url, Bool
Author
packages :: Bool
author :: Author
$sel:packages:NewProjectConfig :: NewProjectConfig -> Bool
$sel:author:NewProjectConfig :: NewProjectConfig -> Author
..} =
  [exon|{
  description = "A Haskell project";

  inputs.hix.url = "#{url}";

  outputs = {hix, ...}: hix.lib.flake {
    hackage.versionFile = "ops/version.nix";

    cabal = {
      license = "BSD-2-Clause-Patent";
      license-file = "LICENSE";
      author = "##{author}";
      ghc-options = ["-Wall"];
    };

    packages.#{name} = {
      src = ./#{src};
      cabal.meta.synopsis = "A Haskell project";

      library = {
        enable = true;
        dependencies = [
          "containers"
        ];
      };

      executable.enable = true;

      test = {
        enable = true;
        dependencies = [
          "hedgehog >= 1.1 && < 1.3"
          "tasty ^>= 1.4"
          "tasty-hedgehog >= 1.3 && < 1.5"
        ];
      };

    };
  };
}
|]
  where
    src :: Text
src | Bool
packages = [exon|packages/#{name}|]
        | Bool
otherwise = Text
"."

libModule :: NewProjectConfig -> Text -> Text
libModule :: NewProjectConfig -> Text -> Text
libModule NewProjectConfig
conf Text
modName =
  [exon|module #{modName} where

name :: String
name = "#{conf.name.unProjectName}"
|]

appMainModule :: Text -> Text
appMainModule :: Text -> Text
appMainModule Text
modName =
  [exon|module Main where

import #{modName} (name)

main :: IO ()
main = putStrLn ("Hello " <> name)
|]

testMainModule :: Text -> Text
testMainModule :: Text -> Text
testMainModule Text
modName =
  [exon|module Main where

import Hedgehog (property, test, withTests)
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.Hedgehog (testProperty)
import #{modName}.Test.NameTest (test_name)

tests :: TestTree
tests =
  testGroup "all" [
    testProperty "name" (withTests 1 (property (test test_name)))
  ]

main :: IO ()
main = defaultMain tests
|]

nameTestModule :: NewProjectConfig -> Text -> Text
nameTestModule :: NewProjectConfig -> Text -> Text
nameTestModule NewProjectConfig
conf Text
modName =
  [exon|module #{modName}.Test.NameTest where

import Hedgehog (TestT, (===))

import #{modName} (name)

test_name :: TestT IO ()
test_name = "#{conf.name.unProjectName}" === name
|]

newProjectFiles :: NewProjectConfig -> M [ProjectFile]
newProjectFiles :: NewProjectConfig -> M [ProjectFile]
newProjectFiles NewProjectConfig
conf = do
  Path Rel Dir
nameDir <- Maybe (Path Rel Dir) -> M (Path Rel Dir)
forall {a}. Maybe a -> M a
pathError (String -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir String
modNameS)
  let packageDir :: Path Rel Dir
packageDir = if NewProjectConfig
conf.packages then [reldir|packages|] Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
nameDir else [reldir|.|]
  Path Rel File
libFile <- Maybe (Path Rel File) -> M (Path Rel File)
forall {a}. Maybe a -> M a
pathError (String -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile [exon|#{modNameS}.hs|])
  pure [
    ProjectFile {$sel:path:ProjectFile :: Path Rel File
path = [relfile|flake.nix|], $sel:content:ProjectFile :: Text
content = NewProjectConfig -> Text
flake NewProjectConfig
conf},
    ProjectFile {$sel:path:ProjectFile :: Path Rel File
path = Path Rel Dir
packageDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|LICENSE|], $sel:content:ProjectFile :: Text
content = Author -> Text
license NewProjectConfig
conf.author},
    ProjectFile {$sel:path:ProjectFile :: Path Rel File
path = Path Rel Dir
packageDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|ops/version.nix|], $sel:content:ProjectFile :: Text
content = [exon|"0.1.0.0"|]},
    ProjectFile {$sel:path:ProjectFile :: Path Rel File
path = Path Rel Dir
packageDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [reldir|lib|] Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
libFile, $sel:content:ProjectFile :: Text
content = NewProjectConfig -> Text -> Text
libModule NewProjectConfig
conf Text
modName},
    ProjectFile {$sel:path:ProjectFile :: Path Rel File
path = Path Rel Dir
packageDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|app/Main.hs|], $sel:content:ProjectFile :: Text
content = Text -> Text
appMainModule Text
modName},
    ProjectFile {$sel:path:ProjectFile :: Path Rel File
path = Path Rel Dir
packageDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|test/Main.hs|], $sel:content:ProjectFile :: Text
content = Text -> Text
testMainModule Text
modName},
    ProjectFile {
      $sel:path:ProjectFile :: Path Rel File
path = Path Rel Dir
packageDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [reldir|test|] Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
nameDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|Test/NameTest.hs|],
      $sel:content:ProjectFile :: Text
content = NewProjectConfig -> Text -> Text
nameTestModule NewProjectConfig
conf Text
modName
    }
    ]
  where
    pathError :: Maybe a -> M a
pathError = Text -> Maybe a -> M a
forall a. Text -> Maybe a -> M a
noteEnv Text
"Can't convert project name to file path"
    modName :: Text
modName = String -> Text
forall a. ToText a => a -> Text
toText String
modNameS
    modNameS :: String
modNameS = String -> String
pascal (Text -> String
forall a. ToString a => a -> String
toString NewProjectConfig
conf.name.unProjectName)

newProject :: NewProjectConfig -> M ()
newProject :: NewProjectConfig -> M ()
newProject NewProjectConfig
conf = do
  (ProjectFile -> M ()) -> [ProjectFile] -> M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ProjectFile -> M ()
createFile ([ProjectFile] -> M ()) -> M [ProjectFile] -> M ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NewProjectConfig -> M [ProjectFile]
newProjectFiles NewProjectConfig
conf