{-# LANGUAGE Arrows #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

module Niv.Local.Cmd where

import Control.Arrow
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Text as T
import Niv.Cmd
import Niv.Sources
import Niv.Update
import qualified Options.Applicative as Opts
import qualified Options.Applicative.Help.Pretty as Opts

localCmd :: Cmd
localCmd :: Cmd
localCmd =
  Cmd :: (forall a. InfoMod a)
-> (Text -> Maybe (PackageName, Object))
-> Parser PackageSpec
-> Update () ()
-> Text
-> (Attrs -> [Text])
-> Cmd
Cmd
    { description :: forall a. InfoMod a
description = forall a. InfoMod a
describeLocal,
      parseCmdShortcut :: Text -> Maybe (PackageName, Object)
parseCmdShortcut = Text -> Maybe (PackageName, Object)
parseLocalShortcut,
      parsePackageSpec :: Parser PackageSpec
parsePackageSpec = Parser PackageSpec
parseLocalPackageSpec,
      updateCmd :: Update () ()
updateCmd = proc () -> do
        Text -> Update (Box Text) (Box Text)
forall a. JSON a => Text -> Update (Box a) (Box a)
useOrSet Text
"type" -< (Box Text
"local" :: Box T.Text)
        Update () ()
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (),
      name :: Text
name = Text
"local",
      extraLogs :: Attrs -> [Text]
extraLogs = [Text] -> Attrs -> [Text]
forall a b. a -> b -> a
const []
    }

parseLocalShortcut :: T.Text -> Maybe (PackageName, Aeson.Object)
parseLocalShortcut :: Text -> Maybe (PackageName, Object)
parseLocalShortcut Text
txt =
  if (Text -> Text -> Bool
T.isPrefixOf Text
"./" Text
txt Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isPrefixOf Text
"/" Text
txt)
    then do
      let n :: Text
n = [Text] -> Text
forall a. [a] -> a
last ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"/" Text
txt
      (PackageName, Object) -> Maybe (PackageName, Object)
forall a. a -> Maybe a
Just (Text -> PackageName
PackageName Text
n, [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList [(Key
"path", Text -> Value
Aeson.String Text
txt)])
    else Maybe (PackageName, Object)
forall a. Maybe a
Nothing

parseLocalPackageSpec :: Opts.Parser PackageSpec
parseLocalPackageSpec :: Parser PackageSpec
parseLocalPackageSpec = Object -> PackageSpec
PackageSpec (Object -> PackageSpec)
-> ([(Key, Value)] -> Object) -> [(Key, Value)] -> PackageSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, Value)] -> PackageSpec)
-> Parser [(Key, Value)] -> Parser PackageSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(Key, Value)]
parseParams
  where
    parseParams :: Opts.Parser [(K.Key, Aeson.Value)]
    parseParams :: Parser [(Key, Value)]
parseParams = [(Key, Value)]
-> ((Key, Value) -> [(Key, Value)])
-> Maybe (Key, Value)
-> [(Key, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Key, Value) -> [(Key, Value)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Key, Value) -> [(Key, Value)])
-> Parser (Maybe (Key, Value)) -> Parser [(Key, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Key, Value) -> Parser (Maybe (Key, Value))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opts.optional Parser (Key, Value)
parsePath
    parsePath :: Parser (Key, Value)
parsePath =
      (Key
"path",) (Value -> (Key, Value)) -> (Text -> Value) -> Text -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
Aeson.String
        (Text -> (Key, Value)) -> Parser Text -> Parser (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opts.strOption
          ( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"path"
              Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
"PATH"
          )

describeLocal :: Opts.InfoMod a
describeLocal :: InfoMod a
describeLocal =
  [InfoMod a] -> InfoMod a
forall a. Monoid a => [a] -> a
mconcat
    [ InfoMod a
forall a. InfoMod a
Opts.fullDesc,
      String -> InfoMod a
forall a. String -> InfoMod a
Opts.progDesc String
"Add a local dependency. Experimental.",
      Maybe Doc -> InfoMod a
forall a. Maybe Doc -> InfoMod a
Opts.headerDoc (Maybe Doc -> InfoMod a) -> Maybe Doc -> InfoMod a
forall a b. (a -> b) -> a -> b
$
        Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
          Doc
"Examples:"
            Doc -> Doc -> Doc
Opts.<$$> Doc
""
            Doc -> Doc -> Doc
Opts.<$$> Doc
"  niv add local ./foo/bar"
    ]