gdritter repos electric-boogaloo / 5e51500
Version bump to 0.2, proper command-line handling Getty Ritter 7 years ago
2 changed file(s) with 77 addition(s) and 28 deletion(s). Collapse all Expand all
+1
-1
electric-boogaloo.cabal less more
11 name: electric-boogaloo
2 version: 0.1.3
2 version: 0.2.0
33 synopsis: Simple opinionated sugar for SQLite
44 description: A basic translator for a straightforward, terse sugar
55 designed for making certain SQLite table definitions
+76
-27
src/Main.hs less more
88 import Data.Text (Text)
99 import qualified Data.Text as T
1010 import qualified Data.Text.IO as T
11 import qualified System.Console.GetOpt as Opt
12 import qualified System.Environment as Sys
13 import qualified System.Exit as Sys
14 import qualified System.IO as Sys
1115
1216 data Decl = Decl
1317 { dName :: Text
6468 in go (d:ds) ls
6569
6670 builtins :: [Text]
67 builtins = [ "null", "int", "integer", "real", "text", "blob", "date" ]
71 builtins = [ "null"
72 , "int"
73 , "integer"
74 , "real"
75 , "text"
76 , "bool"
77 , "blob"
78 , "date"
79 ]
6880
6981 check :: [Decl] -> Either String ()
7082 check ds =
89101 | t `elem` builtins = T.toUpper t
90102 | otherwise = "INTEGER"
91103
92 pprint :: Decl -> IO ()
93 pprint Decl { dName = n, dFields = fs } = do
94 T.putStr "CREATE TABLE IF NOT EXISTS "
95 T.putStrLn n
96 T.putStrLn " ( id INTEGER PRIMARY KEY ASC"
104 pprint :: Decl -> Sys.Handle -> IO ()
105 pprint Decl { dName = n, dFields = fs } h = do
106 T.hPutStr h "CREATE TABLE IF NOT EXISTS "
107 T.hPutStrLn h n
108 T.hPutStrLn h " ( id INTEGER PRIMARY KEY ASC"
97109 mapM_ printField fs
98110 mapM_ printForeign fs
99 T.putStrLn " );"
111 T.hPutStrLn h " );"
100112 where printField Field { fName = f
101113 , fType = t
102114 , fNull = l
103115 , fUniq = u
104116 , fDefault = d
105117 } = do
106 T.putStr " , "
107 T.putStr f
108 T.putStr " "
109 T.putStr (typeName t)
118 T.hPutStr h " , "
119 T.hPutStr h f
120 T.hPutStr h " "
121 T.hPutStr h (typeName t)
110122 when (not l) $
111 T.putStr " NOT NULL"
123 T.hPutStr h " NOT NULL"
112124 when u $
113 T.putStr " UNIQUE"
125 T.hPutStr h " UNIQUE"
114126 case d of
115127 Nothing -> return ()
116 Just dv -> T.putStr (" DEFAULT " <> dv)
117 T.putStrLn ""
128 Just dv -> T.hPutStr h (" DEFAULT " <> dv)
129 T.hPutStrLn h ""
118130 printForeign Field { fName = f, fType = t }
119131 | t `elem` builtins = return ()
120132 | otherwise = do
121 T.putStr " , FOREIGN KEY("
122 T.putStr f
123 T.putStr ") REFERENCES "
124 T.putStr t
125 T.putStrLn "(id)"
133 T.hPutStr h " , FOREIGN KEY("
134 T.hPutStr h f
135 T.hPutStr h ") REFERENCES "
136 T.hPutStr h t
137 T.hPutStrLn h "(id)"
126138
127139 rev :: [Decl] -> [Decl]
128140 rev ds = reverse [ d { dFields = reverse (dFields d) } | d <- ds ]
129141
142 -- *
143
144 data Options = Options
145 { inputFile :: Maybe FilePath
146 , outputFile :: Maybe FilePath
147 }
148
149 options :: [Opt.OptDescr (Options -> Options)]
150 options =
151 [ let inFile (Just f) o
152 | f /= "-" = o { inputFile = Just f }
153 inFile _ o = o { inputFile = Nothing }
154 in Opt.Option ['i'] ["input"] (Opt.OptArg inFile "file")
155 "input Electric Boogaloo schema"
156 , let outFile (Just f) o
157 | f /= "-" = o { outputFile = Just f }
158 outFile _ o = o { outputFile = Nothing }
159 in Opt.Option ['o'] ["output"] (Opt.OptArg outFile "file")
160 "output SQLite schema"
161 ]
162
163 guard :: Either String a -> IO a
164 guard (Left err) = do
165 Sys.hPutStrLn Sys.stderr err
166 Sys.exitFailure
167 guard (Right x) = return x
168
169 header :: String
170 header = "Electric Boogaloo"
171
130172 main :: IO ()
131173 main = do
132 cs <- T.getContents
133 case parse cs of
134 Left err -> putStrLn err
135 Right ds -> do
136 case check ds of
137 Left err -> putStrLn err
138 Right () -> mapM_ pprint (rev ds)
174 args <- Sys.getArgs
175 opts <- guard $ case Opt.getOpt Opt.Permute options args of
176 (optsApp, [], []) -> return optsApp
177 _ -> Left (Opt.usageInfo header options)
178 let o = foldl (.) id opts (Options Nothing Nothing)
179 cs <- case inputFile o of
180 Nothing -> T.getContents
181 Just f -> T.readFile f
182 decls <- guard (parse cs)
183 () <- guard (check decls)
184 outH <- case outputFile o of
185 Nothing -> return Sys.stdout
186 Just f -> Sys.openFile f Sys.ReadMode
187 mapM_ (flip pprint outH) (rev decls)