Commit becfa51f authored by Sophie Herold's avatar Sophie Herold 🌼

Adds first code for writing yaml structures

parent 14d43539
Pipeline #810 passed with stage
in 4 minutes and 6 seconds
......@@ -53,6 +53,7 @@ library
Database.HamSql.Internal.Stmt
Database.HamSql.Internal.Utils
Database.HamSql.Setup
Database.HamSql.Write
Database.YamSql
Database.YamSql.Internal.Basic
Database.YamSql.Internal.Commons
......@@ -88,6 +89,7 @@ library
bytestring >=0.10 && <0.11,
containers >=0.5 && <0.6,
directory >=1.3 && <1.4,
directory-tree == 0.12.1.*,
doctemplates >=0.1 && <0.2,
file-embed >=0.0 && <0.1,
filepath >=1.4 && <1.5,
......
module Database.HamSql
( module X
( module Database.HamSql.Internal.DbUtils
, module Database.HamSql.Internal.Documentation
, module Database.HamSql.Internal.Load
, module Database.HamSql.Internal.Option
, module Database.HamSql.Internal.PostgresCon
, module Database.HamSql.Internal.Stmt
, module Database.HamSql.Internal.Stmt.Create
, module Database.HamSql.Internal.Utils
) where
import Database.HamSql.Internal.DbUtils as X
import Database.HamSql.Internal.Documentation as X
import Database.HamSql.Internal.Load as X
import Database.HamSql.Internal.Option as X
import Database.HamSql.Internal.PostgresCon as X
import Database.HamSql.Internal.Stmt as X
import Database.HamSql.Internal.Stmt.Create as X
import Database.HamSql.Internal.Utils as X
import Database.HamSql.Internal.DbUtils
import Database.HamSql.Internal.Documentation
import Database.HamSql.Internal.Load
import Database.HamSql.Internal.Option
import Database.HamSql.Internal.PostgresCon
import Database.HamSql.Internal.Stmt
import Database.HamSql.Internal.Stmt.Create
import Database.HamSql.Internal.Utils
......@@ -14,11 +14,6 @@ import Database.HamSql.Internal.Utils
import Database.HamSql.Setup
import Database.YamSql
preset :: Eq a => a -> a -> Maybe a
preset d x
| d == x = Nothing
| otherwise = Just x
presetEmpty :: [a] -> Maybe [a]
presetEmpty [] = Nothing
presetEmpty xs = Just xs
......
......@@ -23,6 +23,11 @@ import Database.YamSql.Internal.Utils
join :: [a] -> [[a]] -> [a]
join = intercalate
preset :: Eq a => a -> a -> Maybe a
preset d x
| d == x = Nothing
| otherwise = Just x
err :: Text -> a
err xs =
unsafePerformIO $ do
......
module Database.HamSql.Write
( schemaToDirTree
, toYml
, doWrite
) where
import qualified Data.ByteString as B
import Data.Ord (comparing)
import qualified Data.Text as T
import Data.Yaml
import Data.Yaml.Pretty
import System.Directory.Tree
import Database.HamSql.Internal.Utils
import Database.YamSql
schemaToDirTree :: Schema -> DirTree B.ByteString
schemaToDirTree schema =
Dir
(filePath $ schemaName schema)
([File "schema.yml" (toYml schema {schemaTables = Nothing})] ++
catMaybes
[Dir "tables.d" . map (toFile tableName) <$> (schemaTables schema)])
where
toFile getName obj = File (filePath $ getName obj) (toYml obj)
filePath :: SqlName -> FilePath
filePath = T.unpack . T.replace "\"" "" . unsafePlainName
toYml :: ToJSON a => a -> B.ByteString
toYml =
encodePretty $
(setConfCompare $ comparing ymlOrd) $ (setConfDropNull True) defConfig
doWrite :: FilePath -> DirTree B.ByteString -> IO (AnchoredDirTree ())
doWrite p x = writeDirectoryWith B.writeFile (p :/ x)
ymlOrd :: Text -> Text
ymlOrd x
| x == "name" = "00"
| x == "description" = "05"
| x == "type" = "10"
| x == "ref_table" = "ref_00"
| otherwise = x
......@@ -3,9 +3,11 @@
-- Copyright 2016 by it's authors.
-- Some rights reserved. See COPYING, AUTHORS.
module Database.YamSql
( module X
( module Database.YamSql.Internal.Commons
, module Database.YamSql.Internal.Obj.Schema
, module Database.YamSql.Internal.SqlId
) where
import Database.YamSql.Internal.Commons as X
import Database.YamSql.Internal.Obj.Schema as X
import Database.YamSql.Internal.SqlId as X
import Database.YamSql.Internal.Commons
import Database.YamSql.Internal.Obj.Schema
import Database.YamSql.Internal.SqlId
......@@ -23,6 +23,7 @@ import Database.HamSql.Internal.InquireDeployed
import Database.HamSql.Internal.Load (loadSetup)
import Database.HamSql.Internal.PostgresCon
import Database.HamSql.Setup
import Database.HamSql.Write
import Database.YamSql
main :: IO ()
......@@ -62,6 +63,7 @@ selfTestStmt =
testCaseSteps "stmt" $ \step -> do
(schemasDb, setupLocal) <- deploy step "test/setups/self-test.yml"
--B.putStrLn $ encodePretty (setConfDropNull True defConfig) (setupLocal)
mapM_ (doWrite "/tmp/testout" . schemaToDirTree) schemasDb
step "check statement diff"
assertNoDiff
(pgsqlGetFullStatements (newSetup schemasDb))
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment