jsnx / system-uuid

Haskell bindings to UUID generators for Linux, OS X and Windows.

This URL has Read+Write access

system-uuid / Main.hs
100644 129 lines (101 sloc) 3.594 kb
raw blame history 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
  SYNOPSIS
    hooty (-1|-4)? (-n <number to make>)?
 
  DESCRIPTION
 
    The `hooty` program generates any number of UUIDs (one by default), using
    either the version 1 (time and MAC) or version 4 (random) algorithm
    (version 1 is the default). On all platforms, `hooty` uses the native
    implementation.
 
  OPTIONS
 
    -n, --number <number>
        Create such-and-such many UUIDs in one go.
 
    -1, --sequential
        Create UUIDs using the version 1 (time and MAC) algorithm.
 
    -4, --random
        Create UUIDs using the version 4 (random) algorithm.
 
    -h, -?, --help
        Print this help and exit.
 
    --version
        Print version and exit.
 
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
 
{-# LANGUAGE TemplateHaskell
           , PatternGuards
  #-}
 
import qualified System.UUID.V1 as V1
import qualified System.UUID.V4 as V4
import Options
import Messages 
import qualified Macros as Macros
import System.Environment
import System.Exit
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Word
import qualified Data.Map as Map
 
main                         =  do
  m                         <-  opts
  let
    lk                       =  (`Map.lookup` m)
  when (isJust $ lk "h") $ do
    stdout << usage
    exitWith ExitSuccess
  when (isJust $ lk "version") $ do
    stdout << version
    exitWith ExitSuccess
  when (all (isJust . lk) ["1","4"]) $ do
    bail "Please specify either version 1 or version 4, not both."
  let
    n                       ::  Word
    n                        =  fromMaybe 1 $ maybeRead =<< lk "n"
    gen =
      if isJust $ lk "4"
        then  V4.uuid
        else  V1.uuid
  mapM_ (const $ print =<< gen) [1..n]
 
 
bail                        ::  String -> IO a
bail s                       =  do 
  stderr << s
  stderr << usage
  exitFailure
 
 
usage                        =  $(Macros.usage)
 
version                      =  "hooty-" ++ $(Macros.version)
 
 
opts                         =  do
  args                      <-  getArgs
  case runParser options () "command line arguments" args of
    Right list              ->  return $ foldr ($) Map.empty list
    Left e                  ->  bail $ show e
 
 
options                      =  do
  res                       <-  choice
    [ eof >> return []
    , many1 options'
    ]
  eof
  return res
 
 
options'                     =  do
  o                         <-  choice opts
  opt o
 where
  opt o@[c]
    | c `elem` "h14"         =  return $ Map.insert o ""
    | c == 'n'               =  choice
          [ eof >> fail "Option requires an argument."
          , try $ do
              s             <-  initialChar '-'
              fail $ "Option requiring argument followed by:\n  " ++ s
          , fmap (Map.insert o) anyString
          ]
    | otherwise              =  prb $ "unimplemented option '" ++ o ++ "'"
  opt "version"              =  return $ Map.insert "version" ""
  opt o                      =  prb $ "unimplemented option '" ++ o ++ "'"
  prb s                      =  fail $ "Please report a bug -- " ++ s ++ "."
  opts                       =  map try
    [ option    "h?"            ["help"]
    , option    "1"             ["sequential"]
    , option    "4"             ["random"]
    , option    "n"             ["number"]
    , option    ""              ["version"]
    ] ++ [ fail "Invalid option." ]
 
 
maybeRead s
  | [(a, _)]     <- reads s  =  Just a
  | otherwise                =  Nothing