{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Elm2Nix
    ( convert
    , initialize
    , snapshot
    ) where

import Control.Concurrent.Async (mapConcurrently)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
import Data.List (intercalate)
import Data.String.Here
import Data.Text (Text)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)

import qualified Data.Text as Text

import Elm2Nix.ElmJson (Elm2NixError(..), readElmJson, toErrorMessage)
import Elm2Nix.FixedOutput (FixedDerivation(..), prefetch)
import Elm2Nix.PackagesSnapshot (snapshot)


newtype Elm2Nix a = Elm2Nix { forall a. Elm2Nix a -> ExceptT Elm2NixError IO a
runElm2Nix_ :: ExceptT Elm2NixError IO a }
  deriving ((forall a b. (a -> b) -> Elm2Nix a -> Elm2Nix b)
-> (forall a b. a -> Elm2Nix b -> Elm2Nix a) -> Functor Elm2Nix
forall a b. a -> Elm2Nix b -> Elm2Nix a
forall a b. (a -> b) -> Elm2Nix a -> Elm2Nix b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Elm2Nix a -> Elm2Nix b
fmap :: forall a b. (a -> b) -> Elm2Nix a -> Elm2Nix b
$c<$ :: forall a b. a -> Elm2Nix b -> Elm2Nix a
<$ :: forall a b. a -> Elm2Nix b -> Elm2Nix a
Functor, Functor Elm2Nix
Functor Elm2Nix =>
(forall a. a -> Elm2Nix a)
-> (forall a b. Elm2Nix (a -> b) -> Elm2Nix a -> Elm2Nix b)
-> (forall a b c.
    (a -> b -> c) -> Elm2Nix a -> Elm2Nix b -> Elm2Nix c)
-> (forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b)
-> (forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix a)
-> Applicative Elm2Nix
forall a. a -> Elm2Nix a
forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix a
forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
forall a b. Elm2Nix (a -> b) -> Elm2Nix a -> Elm2Nix b
forall a b c. (a -> b -> c) -> Elm2Nix a -> Elm2Nix b -> Elm2Nix c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Elm2Nix a
pure :: forall a. a -> Elm2Nix a
$c<*> :: forall a b. Elm2Nix (a -> b) -> Elm2Nix a -> Elm2Nix b
<*> :: forall a b. Elm2Nix (a -> b) -> Elm2Nix a -> Elm2Nix b
$cliftA2 :: forall a b c. (a -> b -> c) -> Elm2Nix a -> Elm2Nix b -> Elm2Nix c
liftA2 :: forall a b c. (a -> b -> c) -> Elm2Nix a -> Elm2Nix b -> Elm2Nix c
$c*> :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
*> :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
$c<* :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix a
<* :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix a
Applicative, Applicative Elm2Nix
Applicative Elm2Nix =>
(forall a b. Elm2Nix a -> (a -> Elm2Nix b) -> Elm2Nix b)
-> (forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b)
-> (forall a. a -> Elm2Nix a)
-> Monad Elm2Nix
forall a. a -> Elm2Nix a
forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
forall a b. Elm2Nix a -> (a -> Elm2Nix b) -> Elm2Nix b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Elm2Nix a -> (a -> Elm2Nix b) -> Elm2Nix b
>>= :: forall a b. Elm2Nix a -> (a -> Elm2Nix b) -> Elm2Nix b
$c>> :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
>> :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
$creturn :: forall a. a -> Elm2Nix a
return :: forall a. a -> Elm2Nix a
Monad, Monad Elm2Nix
Monad Elm2Nix => (forall a. IO a -> Elm2Nix a) -> MonadIO Elm2Nix
forall a. IO a -> Elm2Nix a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Elm2Nix a
liftIO :: forall a. IO a -> Elm2Nix a
MonadIO)

runElm2Nix :: Elm2Nix a -> IO (Either Elm2NixError a)
runElm2Nix :: forall a. Elm2Nix a -> IO (Either Elm2NixError a)
runElm2Nix = ExceptT Elm2NixError IO a -> IO (Either Elm2NixError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Elm2NixError IO a -> IO (Either Elm2NixError a))
-> (Elm2Nix a -> ExceptT Elm2NixError IO a)
-> Elm2Nix a
-> IO (Either Elm2NixError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elm2Nix a -> ExceptT Elm2NixError IO a
forall a. Elm2Nix a -> ExceptT Elm2NixError IO a
runElm2Nix_

throwErr :: Elm2NixError -> Elm2Nix a
throwErr :: forall a. Elm2NixError -> Elm2Nix a
throwErr Elm2NixError
e = ExceptT Elm2NixError IO a -> Elm2Nix a
forall a. ExceptT Elm2NixError IO a -> Elm2Nix a
Elm2Nix (Elm2NixError -> ExceptT Elm2NixError IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Elm2NixError
e)

-- CMDs

convert :: IO ()
convert :: IO ()
convert = Elm2Nix () -> IO ()
forall a. Elm2Nix a -> IO a
runCLI (Elm2Nix () -> IO ()) -> Elm2Nix () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  IO () -> Elm2Nix ()
forall a. IO a -> Elm2Nix a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Resolving elm.json dependencies into Nix ...")

  [Dep]
deps <- (Elm2NixError -> Elm2Nix [Dep])
-> ([Dep] -> Elm2Nix [Dep])
-> Either Elm2NixError [Dep]
-> Elm2Nix [Dep]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Elm2NixError -> Elm2Nix [Dep]
forall a. Elm2NixError -> Elm2Nix a
throwErr [Dep] -> Elm2Nix [Dep]
forall a. a -> Elm2Nix a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Elm2NixError [Dep] -> Elm2Nix [Dep])
-> Elm2Nix (Either Elm2NixError [Dep]) -> Elm2Nix [Dep]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either Elm2NixError [Dep])
-> Elm2Nix (Either Elm2NixError [Dep])
forall a. IO a -> Elm2Nix a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Either Elm2NixError [Dep])
readElmJson String
"elm.json")
  IO () -> Elm2Nix ()
forall a. IO a -> Elm2Nix a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Prefetching tarballs and computing sha256 hashes ...")

  [FixedDerivation]
sources <- IO [FixedDerivation] -> Elm2Nix [FixedDerivation]
forall a. IO a -> Elm2Nix a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Dep -> IO FixedDerivation) -> [Dep] -> IO [FixedDerivation]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently ((String -> String -> IO FixedDerivation)
-> Dep -> IO FixedDerivation
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO FixedDerivation
prefetch) [Dep]
deps)
  IO () -> Elm2Nix ()
forall a. IO a -> Elm2Nix a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn ([FixedDerivation] -> String
generateNixSources [FixedDerivation]
sources))

initialize :: IO ()
initialize :: IO ()
initialize = Elm2Nix () -> IO ()
forall a. Elm2Nix a -> IO a
runCLI (Elm2Nix () -> IO ()) -> Elm2Nix () -> IO ()
forall a b. (a -> b) -> a -> b
$
  IO () -> Elm2Nix ()
forall a. IO a -> Elm2Nix a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn [template|data/default.nix|])
  where
    -- | Converts Package.Name to Nix friendly name
    baseName :: Text
    baseName :: Text
baseName = Text
"elm-app"
    version :: Text
    version :: Text
version = Text
"0.1.0"
    toNixName :: Text -> Text
    toNixName :: Text -> Text
toNixName = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"/" Text
"-"
    name :: String
    name :: String
name = Text -> String
Text.unpack (Text -> Text
toNixName Text
baseName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
version)
    srcdir :: String
    srcdir :: String
srcdir = String
"./src" -- TODO: get from elm.json

-- Utils

runCLI :: Elm2Nix a -> IO a
runCLI :: forall a. Elm2Nix a -> IO a
runCLI Elm2Nix a
m = do
  Either Elm2NixError a
result <- Elm2Nix a -> IO (Either Elm2NixError a)
forall a. Elm2Nix a -> IO (Either Elm2NixError a)
runElm2Nix Elm2Nix a
m
  case Either Elm2NixError a
result of
        Right a
a ->
          a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        Left Elm2NixError
err -> do
          Elm2NixError -> IO ()
depErrToStderr Elm2NixError
err
          IO a
forall a. IO a
exitFailure

depErrToStderr :: Elm2NixError -> IO ()
depErrToStderr :: Elm2NixError -> IO ()
depErrToStderr = Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ())
-> (Elm2NixError -> String) -> Elm2NixError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elm2NixError -> String
toErrorMessage

generateNixSources :: [FixedDerivation] -> String
generateNixSources :: [FixedDerivation] -> String
generateNixSources [FixedDerivation]
dss =
  [iTrim|
{
${intercalate "\n" (map f dss)}
}
  |]
  where
    f :: FixedDerivation -> String
    f :: FixedDerivation -> String
f FixedDerivation
ds =
      [i|
      "${drvName ds}" = {
        sha256 = "${drvHash ds}";
        version = "${drvVersion ds}";
      };|]