{-# LANGUAGE OverloadedStrings #-}
module Monitor.Loader where

import Data.List
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

import Monitor.DataModel

parseLine :: Text -> Maybe Text
parseLine :: Text -> Maybe Text
parseLine Text
space = case Text -> Text -> [Text]
T.splitOn Text
"=" Text
space of
  [Text
_key, Text
value] -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
value
  [Text]
_ -> Maybe Text
forall a. Maybe a
Nothing

parseDescription :: [Text] -> Maybe String
parseDescription :: [Text] -> Maybe String
parseDescription [Text]
arg = case [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ((Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe Text
parseLine [Text]
arg) of
  [] -> Maybe String
forall a. Maybe a
Nothing
  [Text]
a -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([Text] -> String) -> [Text] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> ([Text] -> [String]) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> Maybe String) -> [Text] -> Maybe String
forall a b. (a -> b) -> a -> b
$ [Text]
a

parseAssertion :: [Text] -> Maybe Assertion
parseAssertion :: [Text] -> Maybe Assertion
parseAssertion [Text]
arg = case [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ((Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe Text
parseLine [Text]
arg) of
  [] -> Maybe Assertion
forall a. Maybe a
Nothing
  (Text
a:[Text]
_) -> Assertion -> Maybe Assertion
forall a. a -> Maybe a
Just (Assertion -> Maybe Assertion)
-> (Text -> Assertion) -> Text -> Maybe Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Assertion
readAssertion (String -> Assertion) -> (Text -> String) -> Text -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Assertion) -> Text -> Maybe Assertion
forall a b. (a -> b) -> a -> b
$ Text
a

parseFrequency :: [Text] -> Maybe Int
parseFrequency :: [Text] -> Maybe Int
parseFrequency [Text]
arg = case [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ((Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe Text
parseLine [Text]
arg) of
  [] -> Maybe Int
forall a. Maybe a
Nothing
  (Text
a:[Text]
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Text -> Int) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (Text -> String) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int) -> Text -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text
a

parseJob :: Text -> Job
parseJob :: Text -> Job
parseJob Text
txt = Job :: Maybe String -> Maybe Int -> Maybe Assertion -> ByteString -> Job
Job {
    jobSQL :: ByteString
jobSQL = ByteString
sql
  , jobDescription :: Maybe String
jobDescription = [Text] -> Maybe String
parseDescription [Text]
mDescription
  , jobAssertion :: Maybe Assertion
jobAssertion = [Text] -> Maybe Assertion
parseAssertion [Text]
mAssertion
  , jobFrequency :: Maybe Int
jobFrequency = [Text] -> Maybe Int
parseFrequency [Text]
mFrequency
  }
  where
    comments :: [Text]
comments = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isPrefixOf Text
"--") ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
txt
    sql :: ByteString
sql = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
T.isPrefixOf Text
"--") ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
txt
    mDescription :: [Text]
mDescription = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isInfixOf Text
"description") [Text]
comments
    mFrequency :: [Text]
mFrequency = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isInfixOf Text
"frequency") [Text]
comments
    mAssertion :: [Text]
mAssertion = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isInfixOf Text
"assertion") [Text]
comments