{-# 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 { 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 forall a. JSON a => Text -> Update (Box a) (Box a) useOrSet Text "type" -< (Box Text "local" :: Box T.Text) forall (a :: * -> * -> *) b. Arrow a => a b b returnA -< (), name :: Text name = Text "local", extraLogs :: Attrs -> [Text] extraLogs = 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 = forall a. [a] -> a last forall a b. (a -> b) -> a -> b $ Text -> Text -> [Text] T.splitOn Text "/" Text txt forall a. a -> Maybe a Just (Text -> PackageName PackageName Text n, forall v. [(Key, v)] -> KeyMap v KM.fromList [(Key "path", Text -> Value Aeson.String Text txt)]) else forall a. Maybe a Nothing parseLocalPackageSpec :: Opts.Parser PackageSpec parseLocalPackageSpec :: Parser PackageSpec parseLocalPackageSpec = Object -> PackageSpec PackageSpec forall b c a. (b -> c) -> (a -> b) -> a -> c . forall v. [(Key, v)] -> KeyMap v KM.fromList 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 = forall b a. b -> (a -> b) -> Maybe a -> b maybe [] forall (f :: * -> *) a. Applicative f => a -> f a pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) Opts.optional Parser (Key, Value) parsePath parsePath :: Parser (Key, Value) parsePath = (Key "path",) forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Value Aeson.String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall s. IsString s => Mod OptionFields s -> Parser s Opts.strOption ( forall (f :: * -> *) a. HasName f => String -> Mod f a Opts.long String "path" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a Opts.metavar String "PATH" ) describeLocal :: Opts.InfoMod a describeLocal :: forall a. InfoMod a describeLocal = forall a. Monoid a => [a] -> a mconcat [ forall a. InfoMod a Opts.fullDesc, forall a. String -> InfoMod a Opts.progDesc String "Add a local dependency. Experimental.", forall a. Maybe Doc -> InfoMod a Opts.headerDoc forall a b. (a -> b) -> a -> b $ forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ Doc "Examples:" Doc -> Doc -> Doc Opts.<$$> Doc "" Doc -> Doc -> Doc Opts.<$$> Doc " niv add local ./foo/bar" ]