module Ringo.Extractor.Internal where import qualified Data.Map as Map import qualified Data.Text as Text #if MIN_VERSION_base(4,8,0) #else import Control.Applicative ((<$>)) #endif import Control.Monad.Reader (Reader, asks) import Data.Function (on) import Data.Maybe (mapMaybe, fromMaybe, fromJust) import Data.Monoid ((<>)) import Data.List (nub, nubBy) import Data.Text (Text) import Ringo.Types import Ringo.Utils dimColumnName :: Text -> ColumnName -> ColumnName dimColumnName dimName columnName = fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName timeUnitColumnName :: Text -> ColumnName -> TimeUnit -> ColumnName timeUnitColumnName dimIdColName colName timeUnit = colName <> "_" <> timeUnitName timeUnit <> "_" <> dimIdColName factDimFKIdColumnName :: Text -> Text -> TableName -> ColumnName factDimFKIdColumnName dimPrefix dimIdColName dimTableName = fromMaybe dimTableName (Text.stripPrefix dimPrefix dimTableName) <> "_" <> dimIdColName extractedFactTableName :: Text -> Text -> TableName -> TimeUnit -> TableName extractedFactTableName factPrefix factInfix factName timeUnit = factPrefix <> factName <> factInfix <> timeUnitName timeUnit idColTypeToFKIdColType :: Text -> Text idColTypeToFKIdColType typ = case Text.toLower typ of "serial" -> "integer" "smallserial" -> "smallint" "bigserial" -> "bigint" _ -> typ extractDimensionTables :: Fact -> Reader Env [Table] extractDimensionTables fact = do settings <- asks envSettings tables <- asks envTables let table = fromJust . findTable (factTableName fact) $ tables return $ dimsFromIds tables ++ dimsFromVals settings (tableColumns table) where dimsFromIds tables = flip mapMaybe (factColumns fact) $ \fcol -> case fcol of DimId d _ -> findTable d tables _ -> Nothing dimsFromVals Settings {..} tableColumns = map (\(dim, cols) -> Table { tableName = settingDimPrefix <> dim , tableColumns = Column settingDimTableIdColumnName settingDimTableIdColumnType NotNull : cols , tableConstraints = [ PrimaryKey settingDimTableIdColumnName , UniqueKey (map columnName cols) ] }) . Map.toList . Map.mapWithKey (\dim -> map (\col@Column {..} -> col { columnName = dimColumnName dim columnName }) . nub) . Map.fromListWith (flip (++)) . mapMaybe (\fcol -> do DimVal d col <- fcol column <- findColumn col tableColumns return (d, [ column ])) . map Just . factColumns $ fact extractAllDimensionTables :: Fact -> Reader Env [(Fact, Table)] extractAllDimensionTables fact = do myDims <- map (fact,) <$> extractDimensionTables fact parentDims <- concat <$> mapM extract (factParentNames fact) return . nubBy ((==) `on` snd) $ myDims ++ parentDims where extract fName = do facts <- asks envFacts extractAllDimensionTables . fromJust . findFact fName $ facts