{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}

module HsDev.Database.SQLite.Schema (
	schema, commands
	) where

import qualified Data.Text as T
import Data.List (unfoldr)
import Database.SQLite.Simple (Query(..))

import HsDev.Database.SQLite.Schema.TH

schema :: T.Text
schema :: Text
schema = String -> Text
T.pack String
$schemaExp

commands :: [Query]
commands :: [Query]
commands = ([Text] -> Query) -> [[Text]] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Query
Query (Text -> Query) -> ([Text] -> Text) -> [Text] -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines) ([[Text]] -> [Query]) -> (Text -> [[Text]]) -> Text -> [Query]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Maybe ([Text], [Text])) -> [Text] -> [[Text]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr [Text] -> Maybe ([Text], [Text])
takeStmt ([Text] -> [[Text]]) -> (Text -> [Text]) -> Text -> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Query]) -> Text -> [Query]
forall a b. (a -> b) -> a -> b
$ Text
schema where
	takeStmt :: [T.Text] -> Maybe ([T.Text], [T.Text])
	takeStmt :: [Text] -> Maybe ([Text], [Text])
takeStmt [Text]
ls = case (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Text -> Bool
endsStmt [Text]
ls of
		([Text]
_, []) -> Maybe ([Text], [Text])
forall a. Maybe a
Nothing
		([Text]
hs, Text
t:[Text]
ts) -> ([Text], [Text]) -> Maybe ([Text], [Text])
forall a. a -> Maybe a
Just ([Text]
hs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
t], [Text]
ts)
	comment :: T.Text -> Bool
	comment :: Text -> Bool
comment Text
t = Text
"-- " Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.strip Text
t
	endsStmt :: T.Text -> Bool
	endsStmt :: Text -> Bool
endsStmt Text
t = Bool -> Bool
not (Text -> Bool
comment Text
t) Bool -> Bool -> Bool
&& Text
";" Text -> Text -> Bool
`T.isSuffixOf` Text -> Text
T.strip Text
t