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

module Elm2Nix
    ( convert
    , initialize
    , snapshot
    ) where

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

import qualified Data.HashMap.Strict as HM
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 { Elm2Nix a -> ExceptT Elm2NixError IO a
runElm2Nix_ :: ExceptT Elm2NixError IO a }
  deriving (a -> Elm2Nix b -> Elm2Nix a
(a -> b) -> Elm2Nix a -> Elm2Nix b
(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
<$ :: a -> Elm2Nix b -> Elm2Nix a
$c<$ :: forall a b. a -> Elm2Nix b -> Elm2Nix a
fmap :: (a -> b) -> Elm2Nix a -> Elm2Nix b
$cfmap :: forall a b. (a -> b) -> Elm2Nix a -> Elm2Nix b
Functor, Functor Elm2Nix
a -> Elm2Nix a
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
Elm2Nix a -> Elm2Nix b -> Elm2Nix b
Elm2Nix a -> Elm2Nix b -> Elm2Nix a
Elm2Nix (a -> b) -> Elm2Nix a -> Elm2Nix b
(a -> b -> c) -> Elm2Nix a -> Elm2Nix b -> Elm2Nix c
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
<* :: Elm2Nix a -> Elm2Nix b -> Elm2Nix a
$c<* :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix a
*> :: Elm2Nix a -> Elm2Nix b -> Elm2Nix b
$c*> :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
liftA2 :: (a -> b -> c) -> Elm2Nix a -> Elm2Nix b -> Elm2Nix c
$cliftA2 :: forall a b c. (a -> b -> c) -> Elm2Nix a -> Elm2Nix b -> Elm2Nix c
<*> :: Elm2Nix (a -> b) -> Elm2Nix a -> Elm2Nix b
$c<*> :: forall a b. Elm2Nix (a -> b) -> Elm2Nix a -> Elm2Nix b
pure :: a -> Elm2Nix a
$cpure :: forall a. a -> Elm2Nix a
$cp1Applicative :: Functor Elm2Nix
Applicative, Applicative Elm2Nix
a -> Elm2Nix a
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
Elm2Nix a -> (a -> Elm2Nix b) -> Elm2Nix b
Elm2Nix a -> Elm2Nix b -> Elm2Nix b
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 :: a -> Elm2Nix a
$creturn :: forall a. a -> Elm2Nix a
>> :: Elm2Nix a -> Elm2Nix b -> Elm2Nix b
$c>> :: forall a b. Elm2Nix a -> Elm2Nix b -> Elm2Nix b
>>= :: Elm2Nix a -> (a -> Elm2Nix b) -> Elm2Nix b
$c>>= :: forall a b. Elm2Nix a -> (a -> Elm2Nix b) -> Elm2Nix b
$cp1Monad :: Applicative Elm2Nix
Monad, Monad Elm2Nix
Monad Elm2Nix -> (forall a. IO a -> Elm2Nix a) -> MonadIO Elm2Nix
IO a -> Elm2Nix a
forall a. IO a -> Elm2Nix a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Elm2Nix a
$cliftIO :: forall a. IO a -> Elm2Nix a
$cp1MonadIO :: Monad Elm2Nix
MonadIO)

type Dep = (String, String)

data Elm2NixError =
    ElmJsonReadError String
  | UnexpectedValue Value
  | KeyNotFound Text
  deriving Int -> Elm2NixError -> ShowS
[Elm2NixError] -> ShowS
Elm2NixError -> String
(Int -> Elm2NixError -> ShowS)
-> (Elm2NixError -> String)
-> ([Elm2NixError] -> ShowS)
-> Show Elm2NixError
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 :: 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 :: 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)

parseElmJsonDeps :: Text -> Value -> Either Elm2NixError [Dep]
parseElmJsonDeps :: Text -> Value -> Either Elm2NixError [Dep]
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"
          ([Dep] -> [Dep] -> [Dep])
-> Either Elm2NixError [Dep]
-> Either Elm2NixError [Dep]
-> Either Elm2NixError [Dep]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [Dep] -> [Dep] -> [Dep]
forall a. [a] -> [a] -> [a]
(++) (Value -> Either Elm2NixError [Dep]
parseDeps Value
direct) (Value -> Either Elm2NixError [Dep]
parseDeps Value
indirect)
        Value
v -> Elm2NixError -> Either Elm2NixError [Dep]
forall a b. a -> Either a b
Left (Value -> Elm2NixError
UnexpectedValue Value
v)
    Value
v -> Elm2NixError -> Either Elm2NixError [Dep]
forall a b. a -> Either a b
Left (Value -> Elm2NixError
UnexpectedValue Value
v)
  where
    parseDep :: Text -> Value -> Either Elm2NixError Dep
    parseDep :: Text -> Value -> Either Elm2NixError Dep
parseDep Text
name (String Text
ver) = Dep -> Either Elm2NixError Dep
forall a b. b -> Either a b
Right (Text -> String
Text.unpack Text
name, Text -> String
Text.unpack Text
ver)
    parseDep Text
_ Value
v               = Elm2NixError -> Either Elm2NixError Dep
forall a b. a -> Either a b
Left (Value -> Elm2NixError
UnexpectedValue Value
v)

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

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

    tryLookup :: HashMap Text Value -> Text -> Either Elm2NixError Value
    tryLookup :: Object -> Text -> Either Elm2NixError Value
tryLookup Object
hm Text
key =
      Elm2NixError -> Maybe Value -> Either Elm2NixError Value
forall b a. b -> Maybe a -> Either b a
maybeToRight (Text -> Elm2NixError
KeyNotFound Text
key) (Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
key Object
hm)

-- 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 (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 <- IO (Either String Value) -> Elm2Nix (Either String Value)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((ByteString -> Either String Value)
-> IO ByteString -> IO (Either String Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Json.eitherDecode (String -> IO ByteString
LBS.readFile String
"elm.json"))
  Value
elmJson <- (String -> Elm2Nix Value)
-> (Value -> Elm2Nix Value) -> Either String Value -> Elm2Nix Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Elm2NixError -> Elm2Nix Value
forall a. Elm2NixError -> Elm2Nix a
throwErr (Elm2NixError -> Elm2Nix Value)
-> (String -> Elm2NixError) -> String -> Elm2Nix Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Elm2NixError
ElmJsonReadError) Value -> Elm2Nix Value
forall (m :: * -> *) a. Monad m => a -> m a
return Either String Value
res

  [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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value -> Either Elm2NixError [Dep]
parseElmJsonDeps Text
"dependencies" Value
elmJson)
  [Dep]
testDeps <- (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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value -> Either Elm2NixError [Dep]
parseElmJsonDeps Text
"test-dependencies" Value
elmJson)
  IO () -> Elm2Nix ()
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 (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 [Dep] -> [Dep] -> [Dep]
forall a. [a] -> [a] -> [a]
++ [Dep]
testDeps))
  IO () -> Elm2Nix ()
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 (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 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 :: 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 (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 Elm2NixError
err =
  Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      case Elm2NixError
err of
        UnexpectedValue Value
v -> String
"Unexpected Value: \n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v
        ElmJsonReadError String
s -> String
"Error reading json: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
        KeyNotFound Text
key -> String
"Key not found in json: " String -> ShowS
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}";
      };|]