gdritter repos electric-boogaloo / ffccb77
Refactored field parsing, added uniqueness + defaults Fixes #1, with the syntax indicated Getty Ritter 8 years ago
2 changed file(s) with 48 addition(s) and 17 deletion(s). Collapse all Expand all
+8
-3
README.md less more
2727
2828 or the name of a table declared in the source file. By default
2929 all values are given the `NOT NULL` qualifier, but this can be
30 avoided by ending a type name with a `?` operator.
30 avoided by ending a type name with a `?` operator. Additionally,
31 rows can be made `UNIQUE` by adding a `!` operator, and a
32 default value can be set by adding `= value` to the end of a
33 row for whatever value you choose.
3134
3235 All tables get an implicit `id` column of the form
3336
4346
4447 ~~~
4548 books
46 title: text
49 title: text!
50 pages: int = 0
4751 author_name: authors
4852 published: date
4953
5761 ~~~.sql
5862 CREATE TABLE books
5963 ( id INTEGER PRIMARY KEY ASC
60 , title TEXT NOT NULL
64 , title TEXT NOT NULL UNIQUE
65 , pages INT NOT NULL DEFAULT 0
6166 , author_name INTEGER NOT NULL
6267 , published DATE NOT NULL
6368 , FOREIGN KEY(author_name) REFERENCES authors(id)
+40
-14
src/Main.hs less more
11 module Main where
22
3 import Control.Monad (when)
34 import Data.Char (isSpace, isAlphaNum)
5 import Data.Monoid ((<>))
46 import Data.Text (Text)
57 import qualified Data.Text as T
68 import qualified Data.Text.IO as T
1113 } deriving (Eq, Show)
1214
1315 data Field = Field
14 { fName :: Text
15 , fType :: Text
16 , fNull :: Bool
16 { fName :: Text
17 , fType :: Text
18 , fNull :: Bool
19 , fUniq :: Bool
20 , fDefault :: Maybe Text
1721 } deriving (Eq, Show)
1822
1923 uncomment :: Text -> Text
2226 isValid :: Text -> Bool
2327 isValid = T.all (\ x -> isAlphaNum x || x == '_')
2428
29 isSpecial :: Char -> Bool
30 isSpecial c = c == '?' || c == '!'
31
32 parseField :: Text -> Field
33 parseField ln =
34 let (name, tt) = T.break (== ':') (T.strip ln)
35 (typ, def) = T.break (== '=') (T.strip tt)
36 in Field
37 { fName = T.strip name
38 , fType = T.strip (T.drop 1 (T.filter (not . isSpecial) typ))
39 , fNull = T.any (== '?') typ
40 , fUniq = T.any (== '!') typ
41 , fDefault =
42 case def of
43 "" -> Nothing
44 rs -> Just (T.strip (T.drop 1 rs))
45 }
46
2547 parse :: Text -> Either String [Decl]
2648 parse = go [] . map uncomment . T.lines
2749 where go ds [] = return ds
2850 go ds (l:ls)
2951 | T.length (T.takeWhile isSpace l) > 0 =
30 let (n, t) = T.break (== ':') (T.strip l)
31 f = Field { fName = T.strip n
32 , fType = T.strip (T.drop 1 (T.filter (/= '?') t))
33 , fNull = T.any (== '?') t
34 }
52 let f = parseField l
3553 in case ds of
3654 (d:ds') -> go (d { dFields = f : dFields d } : ds') ls
3755 [] -> Left "indented line outside of table decl"
8098 where printField Field { fName = f
8199 , fType = t
82100 , fNull = l
101 , fUniq = u
102 , fDefault = d
83103 } = do
84104 T.putStr " , "
85105 T.putStr f
86106 T.putStr " "
87107 T.putStr (typeName t)
88 if not l
89 then T.putStrLn " NOT NULL"
90 else T.putStrLn ""
108 when (not l) $
109 T.putStr " NOT NULL"
110 when u $
111 T.putStr " UNIQUE"
112 case d of
113 Nothing -> return ()
114 Just dv -> T.putStr (" DEFAULT " <> dv)
115 T.putStrLn ""
91116 printForeign Field { fName = f, fType = t }
92117 | t `elem` builtins = return ()
93118 | otherwise = do
105130 cs <- T.getContents
106131 case parse cs of
107132 Left err -> putStrLn err
108 Right ds -> case check ds of
109 Left err -> putStrLn err
110 Right () -> mapM_ pprint (rev ds)
133 Right ds -> do
134 case check ds of
135 Left err -> putStrLn err
136 Right () -> mapM_ pprint (rev ds)