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

module Elm2Nix
    ( convert
    , initialize
    , snapshot
    ) where

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

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as AK
import qualified Data.Aeson.KeyMap as HM
#else
import qualified Data.HashMap.Strict as HM
#endif

import qualified Data.ByteString.Lazy as LBS
import qualified Data.Aeson as Json
import qualified Data.Text as Text

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 -> 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
<$ :: forall a b. a -> Elm2Nix b -> Elm2Nix a
$c<$ :: forall a b. a -> Elm2Nix b -> Elm2Nix a
fmap :: forall a b. (a -> b) -> Elm2Nix a -> Elm2Nix b
$cfmap :: forall a b. (a -> b) -> Elm2Nix a -> Elm2Nix b
Functor, Functor 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
<* :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix a
$c<* :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix a
*> :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
$c*> :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
liftA2 :: forall a b c. (a -> b -> c) -> Elm2Nix a -> Elm2Nix b -> Elm2Nix c
$cliftA2 :: forall a b c. (a -> b -> c) -> Elm2Nix a -> Elm2Nix b -> Elm2Nix c
<*> :: forall a b. Elm2Nix (a -> b) -> Elm2Nix a -> Elm2Nix b
$c<*> :: forall a b. Elm2Nix (a -> b) -> Elm2Nix a -> Elm2Nix b
pure :: forall a. a -> Elm2Nix a
$cpure :: forall a. a -> Elm2Nix a
Applicative, Applicative 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
return :: forall a. a -> Elm2Nix a
$creturn :: forall a. a -> Elm2Nix a
>> :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
$c>> :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
>>= :: forall a b. Elm2Nix a -> (a -> Elm2Nix b) -> Elm2Nix b
$c>>= :: forall a b. Elm2Nix a -> (a -> Elm2Nix b) -> Elm2Nix b
Monad, Monad Elm2Nix
forall a. IO a -> Elm2Nix a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Elm2Nix a
$cliftIO :: forall a. IO a -> Elm2Nix a
MonadIO)

type Dep = (String, String)

data Elm2NixError =
    ElmJsonReadError String
  | UnexpectedValue Value
  | KeyNotFound Text
  deriving Int -> Elm2NixError -> ShowS
[Elm2NixError] -> ShowS
Elm2NixError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Elm2NixError] -> ShowS
$cshowList :: [Elm2NixError] -> ShowS
show :: Elm2NixError -> String
$cshow :: Elm2NixError -> String
showsPrec :: Int -> Elm2NixError -> ShowS
$cshowsPrec :: Int -> Elm2NixError -> ShowS
Show

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

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

parseElmJsonDeps :: Text -> Value -> Either Elm2NixError [Dep]
parseElmJsonDeps :: Text -> Value -> Either Elm2NixError [(String, String)]
parseElmJsonDeps Text
depsKey Value
obj =
  case Value
obj of
    Object Object
hm -> do
      Value
deps <- Object -> Text -> Either Elm2NixError Value
tryLookup Object
hm Text
depsKey
      case Value
deps of
        Object Object
dhm -> do
          Value
direct   <- Object -> Text -> Either Elm2NixError Value
tryLookup Object
dhm Text
"direct"
          Value
indirect <- Object -> Text -> Either Elm2NixError Value
tryLookup Object
dhm Text
"indirect"
          forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. [a] -> [a] -> [a]
(++) (Value -> Either Elm2NixError [(String, String)]
parseDeps Value
direct) (Value -> Either Elm2NixError [(String, String)]
parseDeps Value
indirect)
        Value
v -> forall a b. a -> Either a b
Left (Value -> Elm2NixError
UnexpectedValue Value
v)
    Value
v -> forall a b. a -> Either a b
Left (Value -> Elm2NixError
UnexpectedValue Value
v)
  where
#if MIN_VERSION_aeson(2,0,0)
    parseDep :: Json.Key -> Value -> Either Elm2NixError Dep
    parseDep :: Key -> Value -> Either Elm2NixError (String, String)
parseDep Key
name (String Text
ver) = forall a b. b -> Either a b
Right (Text -> String
Text.unpack (Key -> Text
AK.toText Key
name), Text -> String
Text.unpack Text
ver)
#else
    parseDep :: Text -> Value -> Either Elm2NixError Dep
    parseDep name (String ver) = Right (Text.unpack name, Text.unpack ver)
#endif
    parseDep Key
_ Value
v               = forall a b. a -> Either a b
Left (Value -> Elm2NixError
UnexpectedValue Value
v)

    parseDeps :: Value -> Either Elm2NixError [Dep]
    parseDeps :: Value -> Either Elm2NixError [(String, String)]
parseDeps (Object Object
hm) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Either Elm2NixError (String, String)
parseDep) (forall v. KeyMap v -> [(Key, v)]
HM.toList Object
hm)
    parseDeps Value
v           = forall a b. a -> Either a b
Left (Value -> Elm2NixError
UnexpectedValue Value
v)

    maybeToRight :: b -> Maybe a -> Either b a
    maybeToRight :: forall b a. b -> Maybe a -> Either b a
maybeToRight b
_ (Just a
x) = forall a b. b -> Either a b
Right a
x
    maybeToRight b
y Maybe a
Nothing  = forall a b. a -> Either a b
Left b
y

#if MIN_VERSION_aeson(2,0,0)
    tryLookup :: HM.KeyMap Value -> Text -> Either Elm2NixError Value
    tryLookup :: Object -> Text -> Either Elm2NixError Value
tryLookup Object
hm Text
key =
      forall b a. b -> Maybe a -> Either b a
maybeToRight (Text -> Elm2NixError
KeyNotFound Text
key) (forall v. Key -> KeyMap v -> Maybe v
HM.lookup (Text -> Key
AK.fromText Text
key) Object
hm)
#else
    tryLookup :: HashMap Text Value -> Text -> Either Elm2NixError Value
    tryLookup hm key =
      maybeToRight (KeyNotFound key) (HM.lookup key hm)
#endif

-- CMDs

convert :: IO ()
convert :: IO ()
convert = forall a. Elm2Nix a -> IO a
runCLI forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Resolving elm.json dependencies into Nix ...")
  Either String Value
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. FromJSON a => ByteString -> Either String a
Json.eitherDecode (String -> IO ByteString
LBS.readFile String
"elm.json"))
  Value
elmJson <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Elm2NixError -> Elm2Nix a
throwErr forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Elm2NixError
ElmJsonReadError) forall (m :: * -> *) a. Monad m => a -> m a
return Either String Value
res

  [(String, String)]
deps <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Elm2NixError -> Elm2Nix a
throwErr forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value -> Either Elm2NixError [(String, String)]
parseElmJsonDeps Text
"dependencies" Value
elmJson)
  [(String, String)]
testDeps <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Elm2NixError -> Elm2Nix a
throwErr forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value -> Either Elm2NixError [(String, String)]
parseElmJsonDeps Text
"test-dependencies" Value
elmJson)
  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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO FixedDerivation
prefetch) (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [(String, String)]
deps forall a. [a] -> [a] -> [a]
++ [(String, String)]
testDeps))
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn ([FixedDerivation] -> String
generateNixSources [FixedDerivation]
sources))

initialize :: IO ()
initialize :: IO ()
initialize = forall a. Elm2Nix a -> IO a
runCLI forall a b. (a -> b) -> a -> b
$
  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 = Text -> Text -> Text -> Text
Text.replace Text
"/" Text
"-"
    name :: String
    name :: String
name = Text -> String
Text.unpack (Text -> Text
toNixName Text
baseName forall a. Semigroup a => a -> a -> a
<> 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 <- forall a. Elm2Nix a -> IO (Either Elm2NixError a)
runElm2Nix Elm2Nix a
m
  case Either Elm2NixError a
result of
        Right a
a ->
          forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        Left Elm2NixError
err -> do
          Elm2NixError -> IO ()
depErrToStderr Elm2NixError
err
          forall a. IO a
exitFailure

depErrToStderr :: Elm2NixError -> IO ()
depErrToStderr :: Elm2NixError -> IO ()
depErrToStderr Elm2NixError
err =
  Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$
      case Elm2NixError
err of
        UnexpectedValue Value
v -> String
"Unexpected Value: \n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Value
v
        ElmJsonReadError String
s -> String
"Error reading json: " forall a. [a] -> [a] -> [a]
++ String
s
        KeyNotFound Text
key -> String
"Key not found in json: " forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
key

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}";
      };|]