packages feed

dawdle (empty) → 0.1.0.0

raw patch · 11 files changed

+480/−0 lines, 11 filesdep +basedep +dawdledep +filepathsetup-changed

Dependencies added: base, dawdle, filepath, parsec, pretty, text, time

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Arnon Shimoni
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,29 @@+# Dawdle - the DDL suggestor tool
+
+Meant as a tool for analyzing CSVs and suggesting a DDL.
+Generates an executable called `dawdle` once installed.
+
+## Usage examples
+`$ dawdle --input="example_with_comma.csv" --with-header -s ","`
+This means analyze the file `example_with_comma.csv`, assume the first line is the header and use a comma as a separator.
+The example output is
+
+    create table example_with_comma (id int not null,
+                                     name varchar(65) not null,
+                                     created_at datetime not null,
+                                     updated_at datetime not null)
+
+To see all command line flags, run `$ dawdle --help`.
+
+## Types
+Currently, the syntax is basic(-ish) SQL.
+Supported types are:
+* tinyint
+* smallint
+* int
+* bigint
+* real
+* float
+* date
+* datetime (==timestamp)
+* varchar
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ bin/main.lhs view
@@ -0,0 +1,51 @@+> {-# LANGUAGE ExplicitForAll,TupleSections,
+>              NoMonomorphismRestriction,OverloadedStrings,
+>              FlexibleContexts, RankNTypes, ViewPatterns #-}
+
+> import Database.Dawdle.Parser
+> import Database.Dawdle.Dawdle
+> import Database.Dawdle.Options
+> import Database.Dawdle.Utils
+> import Database.Dawdle.PrettyPrint
+
+> import qualified Data.Text.Lazy.IO as LT
+> import qualified Data.Text.Lazy as LT
+> import Text.Parsec.Text ()
+ 
+> import Data.Maybe
+> import System.Environment
+> import System.FilePath
+
+
+> main :: IO ()
+> main = do
+>  a <- getArgs
+>  opts <- getOpts a
+>  let source = fromMaybe "stdin" $ (optInput . fst) opts
+>      sepChar = (optSepChar . fst) opts
+>      inputMode = (optInput . fst) opts
+>      withHeader = (optWithHeader . fst) opts
+>  c <- case inputMode of
+>         Just f -> LT.readFile f
+>         Nothing -> do
+>           LT.pack <$> getContents
+>  case parseCsv sepChar source c of
+>    Left e -> do
+>      putStrLn "Error parsing input:"
+>      print e
+>    Right [] -> error "Empty parsing result. Empty CSV?"
+>    Right res@(x:xs) -> do
+>      if withHeader
+>      then if null xs
+>        then error "No content after header. Empty CSV!"
+>        else -- Parser rest with pretty columns
+>             let x' = normalizeNames x
+>             in putStrLn $ either error (pretty (genTbName source) x') $ analyzeFile xs
+>      else -- No header
+>        let colNms = take (length x) [ "col_"++show i | i <- [1..] :: [Int] ]
+>        in putStrLn $ either error (pretty (genTbName source) colNms) $ analyzeFile res
+ 
+>  where
+>    genTbName = takeBaseName
+
+
+ dawdle.cabal view
@@ -0,0 +1,53 @@+-- Initial dawdle.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                dawdle
+version:             0.1.0.0
+synopsis:            Generates DDL suggestions based on a CSV file
+-- description:         
+homepage:            https://github.com/arnons1/dawdle
+license:             MIT
+license-file:        LICENSE
+author:              Arnon Shimoni
+maintainer:          arnon.shimoni@gmail.com
+-- copyright:           
+category:            Database
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+source-repository head
+  type:     git
+  location: https://github.com/arnons1/dawdle.git
+
+library
+  -- exposed-modules:     
+  -- other-modules:       
+  -- other-extensions:    
+  build-depends:       base >=4.8 && <4.9,
+                       parsec >= 3.1.8 && < 3.2,
+                       pretty >= 1.0 && < 1.2,
+                       text >= 0.11.1.13 && < 1.3,
+                       time >= 1.4 && < 1.6
+  hs-source-dirs:      src  
+  default-language:    Haskell2010
+  exposed-modules:     Database.Dawdle.Parser,
+                       Database.Dawdle.Dawdle,
+                       Database.Dawdle.PrettyPrint,
+                       Database.Dawdle.Types,
+                       Database.Dawdle.Options,
+                       Database.Dawdle.Utils,
+                       Paths_dawdle
+  ghc-options:         -Wall -O3
+executable dawdle
+  main-is:             main.lhs
+  other-modules:       Paths_dawdle
+  hs-source-dirs:      bin
+  default-language:    Haskell2010
+  build-depends:       base >=4.8 && <4.9,
+                       parsec >= 3.1.8 && < 3.2,
+                       pretty >= 1.0 && < 1.2,
+                       text >= 0.11.1.13 && < 1.3,
+                       filepath >= 1.4.0.0,
+                       dawdle == 0.1.0.0
+  ghc-options:         -Wall -O3
+ src/Database/Dawdle/Dawdle.lhs view
@@ -0,0 +1,87 @@+> {-# LANGUAGE ExplicitForAll,TupleSections,
+>              NoMonomorphismRestriction,OverloadedStrings,
+>              FlexibleContexts, RankNTypes, ViewPatterns #-}
+
+> module Database.Dawdle.Dawdle
+>        (analyzeFile)
+> where
+> import Database.Dawdle.Types
+> import Database.Dawdle.Utils
+
+> import Data.Char
+> import Data.Int
+> import Data.List
+> import Data.Time.Format
+> import Data.Time.Calendar
+> import Text.Read (readMaybe)
+> import Control.Monad
+
+> analyzeFile :: [[String]] -> Either String [CellType]
+> analyzeFile mtrx = do
+>   let cols = transpose mtrx
+>   -- sanity on structure
+>   unless (allTheSame (map length cols)) $ Left $ "Invalid CSV: Some rows have a different number of columns.\nPerhaps your separator is wrong?"
+>   mapM workOnAColumn cols
+
+> workOnAColumn :: [String] -> Either String CellType
+> workOnAColumn [] = Left "Empty column, no cell types inferred"
+> workOnAColumn cts = do
+>   foldM analyzeCell Unknown cts
+
+> analyzeCell :: CellType -> String -> Either String CellType
+> analyzeCell mp s
+>  | null s || isNullText s = Right $ composeMaxTypesWithNulls mp $ Nullable Unknown
+>  | b <- map toLower s
+>  , b `elem` ["false","true"]
+>  , (removeNull mp) `elem` [CTBool,Unknown] =
+>      Right $ composeMaxTypesWithNulls mp CTBool
+>  | (isDateOrUnknown $ removeNull mp)
+>  , Just fFmt <- msum
+>       [ ptm fmt s | fmt <- (iso8601DateFormat Nothing) : 
+>                            (if length s == 8 then ["%Y%m%d"] else [])] = 
+>      case getDateFormatFromCT mp of
+>        Just oFmt |
+>          oFmt /= fFmt -> return $ composeMaxTypesWithNulls mp $ CTChar (length s)
+>        _ -> return $ composeMaxTypesWithNulls mp $ CTDate fFmt
+>  | (isDateTimeOrUnknown $ removeNull mp)
+>  , Just fFmt <- msum
+>       [ ptm fmt s | fmt <- [iso8601DateFormat $ Just "%H:%M:%S"
+>                                      ,"%Y-%m-%d %H:%M:%S%Q"
+>                                      ,"%Y-%m-%d %H:%M:%S"
+>                                      ,rfc822DateFormat]] =
+>      case getDateFormatFromCT mp of
+>        Just oFmt |
+>          oFmt /= fFmt -> return $ composeMaxTypesWithNulls mp $ CTChar (length s)
+>        _ -> return $ composeMaxTypesWithNulls mp $ CTDateTime fFmt
+>  | isInt s
+>  , (removeNull mp) < CTDateTime "" = do
+>       s' <- maybeToEither ("Can't read integer as Integer (??)") (readMaybe s :: Maybe Integer)
+>       composeMaxTypesWithNulls mp <$> intType' s'
+>  | (not . isInt) s && isCTNumber s
+>  , (removeNull mp) < CTChar 1 = do
+>      s' <- maybeToEither ("Can't read float type as Double (??)") (readMaybe s :: Maybe Double)
+>      composeMaxTypesWithNulls mp <$> floatType s'
+>   | otherwise = Right $ composeMaxTypesWithNulls mp $ CTChar (length s)
+
+
+> isNullText :: String -> Bool
+> isNullText s = (map toLower s == "null") || (s == "\\N")
+
+> ptm :: String -> String -> Maybe String
+> ptm tf ts = maybe Nothing (const $ Just tf) ((parseTimeM True defaultTimeLocale tf ts) :: Maybe Day)
+
+
+> intType' :: Integer -> Either String CellType
+> intType' x
+>   | x < fromIntegral (maxBound :: Int8) && x > fromIntegral (minBound :: Int8) = Right CTInt8
+>   | x < fromIntegral (maxBound :: Int16) && x > fromIntegral (minBound :: Int16) = Right CTInt16
+>   | x < fromIntegral (maxBound :: Int32) && x > fromIntegral (minBound :: Int32) = Right CTInt32
+>   | x < fromIntegral (maxBound :: Int64) && x > fromIntegral (minBound :: Int64) = Right CTInt64
+>   | otherwise = Left "Error: Integer out of bounds"
+
+> floatType :: Double -> Either String CellType
+> floatType x = 
+>   let x' = realToFrac x :: Float
+>   in if (show x') /= (show x)
+>      then Right CTDouble
+>      else Right CTFloat
+ src/Database/Dawdle/Options.lhs view
@@ -0,0 +1,56 @@+> module Database.Dawdle.Options
+>  (Options(..)
+>  ,getOpts)
+> where
+>
+> import System.Console.GetOpt
+> import Data.Maybe ( fromMaybe )
+> import Text.Read ( readMaybe )
+>
+> data Options = Options
+>  { optVerbose     :: Bool
+>  , optInput       :: Maybe FilePath
+>  , optStopAfter   :: Integer
+>  , optWithHeader  :: Bool
+>  , optSepChar     :: Char
+>  } deriving Show
+
+> defaultOptions :: Options
+> defaultOptions    = Options
+>  { optVerbose     = False
+>  , optInput       = Nothing
+>  , optStopAfter   = 10000
+>  , optWithHeader  = False
+>  , optSepChar     = ','
+>  }
+>
+> options :: [OptDescr (Options -> Options)]
+> options =
+>   [Option ['v']     ["verbose"]
+>      (NoArg (\ opts -> opts { optVerbose = True }))
+>      "chatty output on stderr"
+>   ,Option ['f']     ["input"]
+>      (OptArg ((\ f opts -> opts { optInput = Just f }) . fromMaybe "input")
+>              "FILE")
+>      "input FILE"
+>   ,Option ['t']     ["threshold"]
+>      (ReqArg (\ d opts -> opts { optStopAfter = (fromMaybe (1000 :: Integer) (readMaybe d :: Maybe Integer))}) "INTEGER")
+>      "stop after how many lines"
+>   ,Option ['h']     ["with-header"]
+>      (NoArg (\ opts -> opts { optWithHeader = True }))
+>      "is there a header line"
+>   ,Option ['s']     ["separator"]
+>      (ReqArg (\d opts -> opts { optSepChar = headErr' d }) "CHAR") "Separator char"
+>   ]
+
+> headErr' :: [a] -> a
+> headErr' (a:_) = a
+> headErr' _ = error "Head error in Options.lhs"
+
+> getOpts :: [String] -> IO (Options, [String])
+> getOpts argv =
+>   case getOpt Permute options argv of
+>     (o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)
+>     (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
+>   where
+>     header = "Usage: dawdle [OPTION...] files..."
+ src/Database/Dawdle/Parser.lhs view
@@ -0,0 +1,54 @@+> {-# LANGUAGE ExplicitForAll,TupleSections,
+>              NoMonomorphismRestriction,OverloadedStrings,
+>              FlexibleContexts, RankNTypes #-}
+
+> module Database.Dawdle.Parser
+>        (parseCsv)
+> where
+> import Database.Dawdle.Types
+> import Data.Text.Lazy (Text)
+> import Text.Parsec
+
+> parseCsv :: Char -> String -> Text -> Either ParseError [[String]]
+> parseCsv sepChar = parse (csvFile sepChar)
+
+> newLines :: String
+> newLines = "\n\r"
+> quoteChars :: String
+> quoteChars = "'\""
+
+> csvFile :: Char -> SParser [[String]]
+> csvFile sepChar = endBy (line sepChar) eol
+
+> line :: Char -> SParser [String]
+> line sepChar = sepBy (cell sepChar) (char sepChar)
+> cell :: Char -> SParser String
+> cell sepChar = quotedCell <|> many (noneOf (sepChar:newLines))
+
+> quotedCell :: SParser String
+> quotedCell = do
+>        sChar <- (oneOf quoteChars)
+>        content <- many (fmap return nonEscape <|> escape) --(quotedChar sChar)
+>        _ <- char sChar <?> "quote at end of cell"
+>        return $ concat content
+
+ quotedChar :: Char -> SParser Char
+ quotedChar csep =
+        noneOf [csep]
+    <|> try (string (replicate 2 csep) >> return csep)
+
+> nonEscape :: SParser Char
+> nonEscape = noneOf "\\\"\0\n\r\v\t\b\f"
+
+> escape :: SParser String
+> escape = do
+>   d <- char '\\'
+>   c <- oneOf "\\\"0nrvtbf"
+>   return [d,c]
+
+> eol :: SParser String
+> eol =   try (string newLines)
+>     <|> try (string (reverse newLines))
+>     <|> string "\n"
+>     <|> string "\r"
+>     <?> "end of line"
+ src/Database/Dawdle/PrettyPrint.lhs view
@@ -0,0 +1,37 @@+> {-# LANGUAGE ExplicitForAll,LambdaCase,
+>              NoMonomorphismRestriction,OverloadedStrings,
+>              FlexibleContexts, RankNTypes #-}
+
+> module Database.Dawdle.PrettyPrint
+> where
+> import Database.Dawdle.Types
+> import Text.PrettyPrint
+
+> pretty :: String -> [String] -> [CellType] -> String
+> pretty fn colns = render . (ddl fn colns)
+
+> ddl :: String -> [String] -> [CellType] -> Doc
+> ddl fn colns cts = text "create table" <+> text fn <+> body
+>   where
+>     body = parens $ nest 3 $ vcat $ (punctuate comma clnms)
+>     clnms = zipWith (\a b -> text a <+> b) colns $ map (prettyTypes True) cts
+
+> prettyTypes :: Bool -> CellType -> Doc
+> prettyTypes isNullPass = \case
+>   Nullable c -> prettyTypes False c <+> text "null"
+>   CTBool -> intp $ text "bool"
+>   CTInt8 -> intp $ text "tinyint"
+>   CTInt16 -> intp $ text "smallint"
+>   CTInt32 -> intp $ text "int"
+>   CTInt64 -> intp $ text "bigint"
+>   CTFloat -> intp $ text "real"
+>   CTDouble -> intp $ text "float"
+>   CTDate _ -> intp $ text "date"
+>   CTDateTime _ -> intp $ text "datetime"
+>   CTChar i -> intp $ text "varchar" <> (parens $ int i)
+>   Unknown -> intp $ text "!!UNKNOWN!!"
+>   where
+>     intp tn = if isNullPass
+>               then tn <+> text "not null"
+>               else tn
+
+ src/Database/Dawdle/Types.lhs view
@@ -0,0 +1,58 @@+> {-# LANGUAGE FlexibleContexts, DeriveDataTypeable, RankNTypes, KindSignatures #-}
+ 
+> module Database.Dawdle.Types
+>        (SParser
+>        ,CellType(..)
+>        ,isNullable
+>        ,applyNullIfNeeded
+>        ,getDateFormatFromCT
+>        ,removeNull
+>        ,composeNull
+>        ,composeMaxTypesWithNulls
+>        ,isDateOrUnknown
+>        ,isDateTimeOrUnknown)
+> where
+> import Data.Data
+> import Text.Parsec
+
+> type SParser a = forall s u (m :: * -> *). Stream s m Char => ParsecT s u m a
+> data CellType = Nullable CellType | Unknown | 
+>   CTBool | CTInt8 | CTInt16 | CTInt32 | CTInt64 | CTFloat | CTDouble | CTDate String | CTDateTime String | CTChar Int
+>   deriving (Eq,Show,Ord,Data,Typeable)
+
+> isNullable :: CellType -> Bool
+> isNullable (Nullable _) = True
+> isNullable _ = False
+
+> applyNullIfNeeded :: Bool -> CellType -> CellType
+> applyNullIfNeeded True r@Nullable{} = r
+> applyNullIfNeeded True r = Nullable r
+> applyNullIfNeeded False r = r
+
+> getDateFormatFromCT :: CellType -> Maybe String
+> getDateFormatFromCT (CTDateTime s) = Just s
+> getDateFormatFromCT (CTDate s) = Just s
+> getDateFormatFromCT _ = Nothing
+
+> removeNull :: CellType -> CellType
+> removeNull (Nullable x) = x
+> removeNull x = x
+
+> composeNull :: CellType -> CellType -> CellType
+> composeNull _ r@Nullable{} = r
+> composeNull Nullable{} r = Nullable r
+> composeNull _ r = r
+
+> composeMaxTypesWithNulls :: CellType -> CellType -> CellType
+> composeMaxTypesWithNulls mp nt =
+>   composeNull mp (maximum $ map removeNull [mp,nt])
+
+> isDateOrUnknown :: CellType -> Bool
+> isDateOrUnknown CTDate{} = True
+> isDateOrUnknown Unknown = True
+> isDateOrUnknown _ = False
+
+> isDateTimeOrUnknown :: CellType -> Bool
+> isDateTimeOrUnknown CTDateTime{} = True
+> isDateTimeOrUnknown Unknown = True
+> isDateTimeOrUnknown _ = False
+ src/Database/Dawdle/Utils.lhs view
@@ -0,0 +1,33 @@+> module Database.Dawdle.Utils
+>  (getFstIfJust
+>  ,isCTNumber
+>  ,isInt
+>  ,maybeToEither
+>  ,allTheSame
+>  ,normalizeNames
+>   )
+> where
+> import Data.Char
+> import Data.List
+
+> getFstIfJust :: (a, Maybe b) -> Maybe a
+> getFstIfJust (a,Just _) = Just a
+> getFstIfJust _ = Nothing
+
+> isCTNumber :: String -> Bool
+> isCTNumber = all (\x -> isNumber x || x `elem` ['-','.'])
+
+> isInt :: String -> Bool
+> isInt = all (\x -> isNumber x || x =='-')
+
+> maybeToEither :: String -> Maybe a -> Either String a
+> maybeToEither _ (Just x) = Right x
+> maybeToEither s Nothing = Left s
+
+> allTheSame :: (Eq a) => [a] -> Bool
+> allTheSame xs = and $ map (== head xs) (tail xs)
+
+> normalizeNames :: [String] -> [String]
+> normalizeNames = map normalize
+>  where
+>    normalize = map toLower . (filter (\x -> x=='_' || isAlphaNum x)) . intercalate "_" . words