Adds doctests.

app/Main.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 module Main where
 
 import qualified Data.ByteString.Lazy as BS

app/Ringo/ArgParser.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 module Ringo.ArgParser (ProgArgs(..), parseArgs) where
 
 import qualified Data.Text as Text

app/Ringo/InputParser.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE CPP #-}
 module Ringo.InputParser (parseInput) where
 
 import qualified Data.Text as Text

ringo.cabal

@@ -34,8 +34,6 @@ library
                        raw-strings-qq >=1.0 && <1.2,
                        hssqlppp       ==0.5.23
   ghc-options:         -Wall -fno-warn-unused-do-bind -funbox-strict-fields -fno-warn-orphans -O2
-  default-extensions:  OverloadedStrings, RecordWildCards, ScopedTypeVariables, BangPatterns,
-                       TupleSections, CPP, NamedFieldPuns
   default-language:    Haskell2010
 
 executable ringo
@@ -55,16 +53,16 @@ executable ringo
                        aeson                >=0.8     && <0.11,
                        ringo
   ghc-options:         -Wall -fno-warn-unused-do-bind -funbox-strict-fields -fno-warn-orphans -O2
-  default-extensions:  OverloadedStrings, RecordWildCards, ScopedTypeVariables, BangPatterns,
-                       TupleSections, CPP, NamedFieldPuns
   default-language:    Haskell2010
 
 test-suite ringo-test
   type:                exitcode-stdio-1.0
-  hs-source-dirs:      test
+  hs-source-dirs:      test, src
-  main-is:             Spec.hs
+  main-is:             doctests.hs
   build-depends:       base
                      , ringo
+                     , pretty-show >=1.6 && <1.7
+                     , doctest     >=0.9 && <0.11
   default-language:    Haskell2010
 
 source-repository head

src/Ringo.hs

@@ -1,5 +1,11 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 module Ringo
-       ( module Ringo.Types
+       ( -- | The examples in this module assume the following code has been run.
+         --   The :{ and :} will only work in GHCi.
+
+         -- $setup
+         module Ringo.Types
        , extractFactTable
        , extractDimensionTables
        , extractDependencies
@@ -19,18 +25,200 @@ import qualified Ringo.Extractor as E
 import qualified Ringo.Generator as G
 import qualified Ringo.Validator as V
 
+-- $setup
+-- >>> :set -XOverloadedStrings
+-- >>> import Ringo
+-- >>> import qualified Data.Map as Map
+-- >>> import qualified Data.Text as Text
+-- >>> import Text.Show.Pretty
+-- >>> :{
+--let sessionEventsTable =
+--      Table { tableName = "session_events"
+--            , tableColumns =
+--              [ Column "id" "uuid"                                                   NotNull
+--              , Column "created_at" "timestamp without time zone"                    Null
+--              , Column "member_id" "integer"                                         Null
+--              , Column "publisher_id" "integer"                                      NotNull
+--              , Column "user_agent" "character varying(1024)"                        Null
+--              , Column "browser_name" "character varying(50)"                        Null
+--              , Column "os" "character varying(50)"                                  Null
+--              , Column "geo_country_name" "character varying(50)"                    Null
+--              , Column "geo_city_name" "character varying(50)"                       Null
+--              , Column "geo_continent_name" "character varying(15)"                  Null
+--              , Column "geo_most_specific_subdivision_name" "character varying(100)" Null
+--              , Column "geo_longitude" "numeric(9,6)"                                Null
+--              , Column "geo_latitude" "numeric(9,6)"                                 Null
+--              , Column "geo_time_zone" "character varying(20)"                       Null
+--              , Column "geo_postal_code" "character varying(20)"                     Null
+--              , Column "user_agent_name" "character varying(100)"                    Null
+--              , Column "user_agent_type" "character varying(15)"                     Null
+--              , Column "user_agent_version" "character varying(100)"                 Null
+--              , Column "user_agent_device" "character varying(15)"                   Null
+--              ]
+--            , tableConstraints =
+--              [ PrimaryKey "id" ]
+--            }
+--    sessionFact =
+--      Fact { factName = "session"
+--           , factTableName = "session_events"
+--           , factParentNames = []
+--           , factColumns =
+--             [ DimTime "created_at"
+--             , NoDimId "publisher_id"
+--             , DimVal "user_agent" "browser_name"
+--             , DimVal "user_agent" "os"
+--             , DimVal "user_agent" "user_agent_name"
+--             , DimVal "user_agent" "user_agent_type"
+--             , DimVal "user_agent" "user_agent_device"
+--             , DimVal "geo" "geo_country_name"
+--             , DimVal "geo" "geo_city_name"
+--             , DimVal "geo" "geo_continent_name"
+--             , DimVal "geo" "geo_most_specific_subdivision_name"
+--             , DimVal "geo" "geo_time_zone"
+--             , FactCount Nothing "session_count"
+--             ]
+--           }
+--    tables = [sessionEventsTable]
+--    facts = [sessionFact]
+--    typeDefaults = Map.fromList [ ("integer", "-1")
+--                                , ("timestamp", "'00-00-00 00:00:00'")
+--                                , ("character", "'__UNKNOWN_VAL__'")
+--                                , ("uuid", "'00000000-0000-0000-0000-000000000000'::uuid")
+--                                , ("boolean", "false")
+--                                , ("json", "'{}'::json")
+--                                , ("numeric", "-1")
+--                                , ("text", "'__UNKNOWN_VAL__'")
+--                                ]
+--    settings = defSettings { settingTableNameSuffixTemplate = "" }
+--    env = Env tables facts settings typeDefaults
+-- :}
+
+-- |
+--
+-- >>> print $ extractFactTable env sessionFact
+-- Table fact_session_by_minute
+-- Column created_at_minute_id bigint NOT NULL
+-- Column publisher_id integer NOT NULL
+-- Column session_count integer NOT NULL
+-- Column geo_id integer NOT NULL
+-- Column user_agent_id integer NOT NULL
+-- UniqueKey (created_at_minute_id, publisher_id, geo_id, user_agent_id)
+-- <BLANKLINE>
 extractFactTable :: Env -> Fact -> Table
 extractFactTable env = flip runReader env . E.extractFactTable
 
+-- |
+--
+-- >>> mapM_ print $ extractDimensionTables env sessionFact
+-- Table dim_geo
+-- Column id serial NOT NULL
+-- Column country_name character varying(50) NOT NULL
+-- Column city_name character varying(50) NOT NULL
+-- Column continent_name character varying(15) NOT NULL
+-- Column most_specific_subdivision_name character varying(100) NOT NULL
+-- Column time_zone character varying(20) NOT NULL
+-- PrimaryKey id
+-- UniqueKey (country_name, city_name, continent_name, most_specific_subdivision_name, time_zone)
+-- <BLANKLINE>
+-- Table dim_user_agent
+-- Column id serial NOT NULL
+-- Column browser_name character varying(50) NOT NULL
+-- Column os character varying(50) NOT NULL
+-- Column name character varying(100) NOT NULL
+-- Column type character varying(15) NOT NULL
+-- Column device character varying(15) NOT NULL
+-- PrimaryKey id
+-- UniqueKey (browser_name, os, name, type, device)
+-- <BLANKLINE>
 extractDimensionTables :: Env -> Fact -> [Table]
 extractDimensionTables env = flip runReader env . E.extractDimensionTables
 
+-- |
+--
+-- >>> putStrLn . ppShow $ extractDependencies env sessionFact
+-- fromList
+--   [ ( "dim_geo" , [ "session_events" ] )
+--   , ( "dim_user_agent" , [ "session_events" ] )
+--   , ( "fact_session_by_minute"
+--     , [ "session_events" , "dim_user_agent" , "dim_geo" ]
+--     )
+--   ]
 extractDependencies :: Env -> Fact -> Dependencies
 extractDependencies env = flip runReader env . E.extractDependencies
 
+-- |
+--
+-- >>> let storySessionDimTables = extractDimensionTables env sessionFact
+-- >>> let sqls = map (tableDefnSQL env) storySessionDimTables
+-- >>> mapM_ (\sqls -> mapM_ (putStr . Text.unpack) sqls >> putStrLn "--------" ) sqls
+-- create table dim_geo (
+--   id serial not null,
+--   country_name character varying(50) not null,
+--   city_name character varying(50) not null,
+--   continent_name character varying(15) not null,
+--   most_specific_subdivision_name character varying(100) not null,
+--   time_zone character varying(20) not null
+-- )
+-- ;
+-- <BLANKLINE>
+-- alter table dim_geo add primary key (id);
+-- <BLANKLINE>
+-- alter table dim_geo add unique (country_name,
+--                                 city_name,
+--                                 continent_name,
+--                                 most_specific_subdivision_name,
+--                                 time_zone);
+-- <BLANKLINE>
+-- --------
+-- create table dim_user_agent (
+--   id serial not null,
+--   browser_name character varying(50) not null,
+--   os character varying(50) not null,
+--   name character varying(100) not null,
+--   type character varying(15) not null,
+--   device character varying(15) not null
+-- )
+-- ;
+-- <BLANKLINE>
+-- alter table dim_user_agent add primary key (id);
+-- <BLANKLINE>
+-- alter table dim_user_agent add unique (browser_name,
+--                                        os,
+--                                        name,
+--                                        type,
+--                                        device);
+-- <BLANKLINE>
+-- --------
 tableDefnSQL :: Env -> Table -> [Text]
 tableDefnSQL env = flip runReader env . G.tableDefnSQL
 
+-- |
+--
+-- >>> let storySessionFactTable = extractFactTable env sessionFact
+-- >>> let sqls = factTableDefnSQL env sessionFact storySessionFactTable
+-- >>> mapM_ (putStr . Text.unpack) sqls
+-- create table fact_session_by_minute (
+--   created_at_minute_id bigint not null,
+--   publisher_id integer not null,
+--   session_count integer not null,
+--   geo_id integer not null,
+--   user_agent_id integer not null
+-- )
+-- ;
+-- <BLANKLINE>
+-- alter table fact_session_by_minute add unique (created_at_minute_id,
+--                                                publisher_id,
+--                                                geo_id,
+--                                                user_agent_id);
+-- <BLANKLINE>
+-- create index  on fact_session_by_minute (created_at_minute_id)
+-- ;
+-- create index  on fact_session_by_minute (publisher_id)
+-- ;
+-- create index  on fact_session_by_minute (geo_id)
+-- ;
+-- create index  on fact_session_by_minute (user_agent_id)
+-- ;
 factTableDefnSQL :: Env -> Fact -> Table -> [Text]
 factTableDefnSQL env fact = flip runReader env . G.factTableDefnSQL fact
 

src/Ringo/Extractor.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 module Ringo.Extractor
        ( extractDimensionTables
        , extractAllDimensionTables

src/Ringo/Extractor/Internal.hs

@@ -1,3 +1,7 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP #-}
 module Ringo.Extractor.Internal where
 
 import qualified Data.Map  as Map

src/Ringo/Generator/Create.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE CPP #-}
 module Ringo.Generator.Create (tableDefnSQL, factTableDefnSQL) where
 
 #if MIN_VERSION_base(4,8,0)

src/Ringo/Generator/Internal.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 module Ringo.Generator.Internal where
 
 import qualified Data.Map as Map

src/Ringo/Generator/Populate/Dimension.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE CPP #-}
 module Ringo.Generator.Populate.Dimension (dimensionTablePopulateSQL) where
 
 import qualified Data.Text as Text

src/Ringo/Generator/Populate/Fact.hs

@@ -1,3 +1,8 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Ringo.Generator.Populate.Fact (factTablePopulateSQL) where
 

src/Ringo/Generator/Sql.hs

@@ -3,7 +3,6 @@ module Ringo.Generator.Sql where
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy as TL
 
-
 import Database.HsSqlPpp.Annotation
 import Database.HsSqlPpp.Dialect (postgresDialect)
 import Database.HsSqlPpp.Pretty

src/Ringo/Types.hs

@@ -1,32 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE BangPatterns #-}
 module Ringo.Types where
 
 import qualified Data.Text as Text
 
-import Data.Map  (Map)
+import Data.Map    (Map)
-import Data.Text (Text)
+import Data.Monoid ((<>))
+import Data.Text   (Text)
+
+showColNames :: [Text] -> String
+showColNames cols = Text.unpack $ "(" <> Text.intercalate ", " cols <> ")"
 
 type ColumnName = Text
 type ColumnType = Text
 type TableName  = Text
 
-data Nullable = Null | NotNull deriving (Eq, Enum, Show)
+data Nullable = Null | NotNull deriving (Eq, Enum)
+
+instance Show Nullable where
+  show Null    = "NULL"
+  show NotNull = "NOT NULL"
 
 data Column = Column
               { columnName     :: !ColumnName
               , columnType     :: !ColumnType
               , columnNullable :: !Nullable
-              } deriving (Eq, Show)
+              } deriving (Eq)
+
+instance Show Column where
+  show Column {..} = "Column "
+                       ++ Text.unpack columnName ++ " "
+                       ++ Text.unpack columnType ++ " "
+                       ++ show columnNullable
 
 data TableConstraint = PrimaryKey !ColumnName
                      | UniqueKey  ![ColumnName]
                      | ForeignKey !TableName ![(ColumnName, ColumnName)]
-                     deriving (Eq, Show)
+                     deriving (Eq)
+
+instance Show TableConstraint where
+  show (PrimaryKey col)          = "PrimaryKey " ++ Text.unpack col
+  show (UniqueKey cols)          = "UniqueKey " ++ showColNames cols
+  show (ForeignKey tName colMap) = "ForeignKey " ++ showColNames (map fst colMap) ++ " "
+                                     ++ Text.unpack tName ++  " " ++ showColNames (map snd colMap)
 
 data Table = Table
              { tableName        :: !TableName
              , tableColumns     :: ![Column]
              , tableConstraints :: ![TableConstraint]
-             } deriving (Eq, Show)
+             } deriving (Eq)
+
+instance Show Table where
+  show Table {..} =
+    unlines $ ("Table " ++ Text.unpack tableName) : (map show tableColumns) ++ (map show tableConstraints)
 
 data TimeUnit = Second | Minute | Hour | Day | Week
                 deriving (Eq, Enum, Show, Read)

src/Ringo/Utils.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE CPP #-}
 module Ringo.Utils where
 
 import qualified Control.Arrow as Arrow

src/Ringo/Validator.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE CPP #-}
 module Ringo.Validator
        ( validateTable
        , validateFact

test/Spec.hs

@@ -1,2 +0,0 @@
-main :: IO ()
-main = putStrLn "Test suite not yet implemented"

test/doctests.hs

@@ -0,0 +1,2 @@
+import Test.DocTest
+main = doctest ["-isrc", "Ringo"]