Adds doctests.
parent
28ff8a99fb
commit
c021ffb845
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Main where
|
||||
|
||||
import qualified Data.ByteString.Lazy as BS
|
||||
|
|
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Ringo.ArgParser (ProgArgs(..), parseArgs) where
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
|
|
@ -1,3 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Ringo.InputParser (parseInput) where
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
|
10
ringo.cabal
10
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
|
||||
main-is: Spec.hs
|
||||
hs-source-dirs: test, src
|
||||
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
|
||||
|
|
190
src/Ringo.hs
190
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
|
||||
|
||||
|
|
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Ringo.Extractor
|
||||
( extractDimensionTables
|
||||
, extractAllDimensionTables
|
||||
|
|
|
@ -1,3 +1,7 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Ringo.Extractor.Internal where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
|
|
@ -1,3 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Ringo.Generator.Create (tableDefnSQL, factTableDefnSQL) where
|
||||
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
|
|
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Ringo.Generator.Internal where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
|
|
@ -1,3 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Ringo.Generator.Populate.Dimension (dimensionTablePopulateSQL) where
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module Ringo.Generator.Populate.Fact (factTablePopulateSQL) where
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.Text (Text)
|
||||
import Data.Map (Map)
|
||||
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)
|
||||
|
|
|
@ -1,3 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Ringo.Utils where
|
||||
|
||||
import qualified Control.Arrow as Arrow
|
||||
|
|
|
@ -1,3 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Ringo.Validator
|
||||
( validateTable
|
||||
, validateFact
|
||||
|
|
|
@ -1,2 +0,0 @@
|
|||
main :: IO ()
|
||||
main = putStrLn "Test suite not yet implemented"
|
|
@ -0,0 +1,2 @@
|
|||
import Test.DocTest
|
||||
main = doctest ["-isrc", "Ringo"]
|
Loading…
Reference in New Issue