← Back to branch summary

~ubuntu-branches/ubuntu/wily/agda/wily-proposed

« back to all changes in this revision

Viewing changes to src/pkg/Main.hs

  • Committer: Package Import Robot
  • Author(s): Iain Lane
  • Date: 2014-08-05 06:38:12 UTC
  • mfrom: (1.1.6)
  • Revision ID: package-import@ubuntu.com-20140805063812-io8e77niomivhd49
Tags: 2.4.0.2-1
* [6e140ac] Imported Upstream version 2.4.0.2
* [2049fc8] Update Build-Depends to match control
* [93dc4d4] Install the new primitives
* [e48f40f] Fix typo dev→doc

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/pkg/Main.hs
1
 
module Main where
2
 
 
3
 
import           Control.Applicative
4
 
import qualified Data.ByteString.Char8
5
 
  as BS
6
 
import           System.Console.GetOpt
7
 
import           System.Environment
8
 
 
9
 
import qualified Agda.Packaging.Config
10
 
  as Agda
11
 
import qualified Agda.Packaging.Database
12
 
  as Agda
13
 
import qualified Agda.Packaging.Monad
14
 
  as Agda
15
 
 
16
 
import Interface.Command
17
 
import Interface.Exit
18
 
import Interface.Options
19
 
import Interface.Usage
20
 
import Interface.Version
21
 
 
22
 
-------------------------------------------------------------------------------
23
 
 
24
 
main :: IO ()
25
 
main = do
26
 
  progName  <- getProgName
27
 
  givenArgs <- getArgs
28
 
  case getOpt Permute allOpts givenArgs of
29
 
    -- if --help was given
30
 
    (givenOpts, _givenCmds, []) | OptHelp    `elem` givenOpts ->
31
 
      bye $ usageInfo (BS.unpack (usageHeader (BS.pack progName))) allOpts
32
 
 
33
 
    -- if --version was given
34
 
    (givenOpts, _givenCmds, []) | OptVersion `elem` givenOpts ->
35
 
      bye $ versionString
36
 
 
37
 
    -- if a command was given
38
 
    (givenOpts,  givenCmds, [])                               ->
39
 
      processCmds progName givenOpts givenCmds
40
 
 
41
 
    -- anything else
42
 
    (_givenOpts, _givenCmds, errors)                          ->
43
 
      die $  concat errors
44
 
          ++ "See --help for usage info."
45
 
 
46
 
  where
47
 
    -- Process the commands (not the args prefixed with '--'),
48
 
    -- determine the package database stack, and initialize the
49
 
    -- environment for the AgdaPkg monad
50
 
    processCmds :: String -> [Opt] -> [Cmd] -> IO ()
51
 
    processCmds progName givenOpts givenCmds = do
52
 
      pkgDBPathStack <-
53
 
        -- if only --global was given
54
 
        if        (OptDBGlobal `elem` givenOpts
55
 
          &&  not (OptDBUser   `elem` givenOpts))
56
 
        then
57
 
          pure (:)
58
 
            <*> Agda.getPkgDBPathGlobal
59
 
            <*> pure []
60
 
        else
61
 
          -- if only --user was given
62
 
          if        (OptDBGlobal `elem` givenOpts
63
 
            &&  not (OptDBUser   `elem` givenOpts))
64
 
          then
65
 
            pure (:)
66
 
              <*> Agda.getPkgDBPathUser
67
 
              <*> pure []
68
 
          else
69
 
            -- if neither or both of --global and --user were given
70
 
            pure (\ db1 db2 -> db1 : db2 : [])
71
 
              <*> Agda.getPkgDBPathGlobal
72
 
              <*> Agda.getPkgDBPathUser
73
 
      -- load the package databases from the path stack
74
 
      pkgDBStack <- Agda.getPkgDBs pkgDBPathStack
75
 
      let initConfig = Agda.AgdaPkgConfig
76
 
            { Agda.configOpts       = givenOpts
77
 
            , Agda.configOrigBroken = [] -- FIXME
78
 
            , Agda.configPkgDBStack = pkgDBStack
79
 
            , Agda.configProgName   = progName }
80
 
      -- process the commands
81
 
      -- FIXME: this runReaderT should be hidden by the API
82
 
      Agda.runReaderT (Agda.runAgdaPkg dispatch) initConfig
83
 
 
84
 
      where
85
 
        -- Take some action according to the commands (not the args
86
 
        -- prefixed with '--').  The interface follows the
87
 
        -- specification outlined in the 'Haskell Cabal' document,
88
 
        -- with deviations to conform to essential parts of the
89
 
        -- current GHC interface.
90
 
        dispatch :: Agda.AgdaPkg Opt ()
91
 
        dispatch =
92
 
          case givenCmds of
93
 
            []                                 ->
94
 
              -- FIXME: this liftIO should be hidden by API
95
 
              Agda.liftIO $ die $  "no command specified\n"
96
 
                                ++ "See --help for usage info."
97
 
 
98
 
            ["describe"  , _pkgId]             ->
99
 
              error "describe"
100
 
 
101
 
            ["expose"    , pkgId]              ->
102
 
              exposePkg pkgId
103
 
 
104
 
            ["dump"]                           ->
105
 
              dumpPkgs
106
 
 
107
 
            ["field"     , _pkgId, _fields]    ->
108
 
              error "field"
109
 
 
110
 
            ["hide"      , pkgId]              ->
111
 
              hidePkg pkgId
112
 
 
113
 
            ["list"]                           ->
114
 
              listPkgs
115
 
 
116
 
            ["register"  , fileName]           ->
117
 
              registerPkg fileName
118
 
 
119
 
            ["unregister", _pkgId]             ->
120
 
              error "unregister"
121
 
 
122
 
            ["update"    , fileName]           ->
123
 
              -- FIXME
124
 
              registerPkg fileName
125
 
 
126
 
            cmd:_                              ->
127
 
              -- FIXME: This liftIO should be hidden by API
128
 
              Agda.liftIO $ die $  "unrecognized command "
129
 
                                ++ "`" ++ cmd ++ "'\n"
130
 
                                ++ "See --help for usage info."