{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module HWM.Core.Parsing
  ( parseField,
    fromByteString,
    firstWord,
    removeHead,
    unconsM,
    sepBy,
    fromToString,
    SourceText,
    genUrl,
    Parse (..),
    parseOptions,
  )
where

import Data.ByteString.Char8 (unpack)
import Data.Char (isSeparator)
import Data.Text
  ( break,
    drop,
    intercalate,
    pack,
    singleton,
    splitOn,
    strip,
    uncons,
  )
import qualified Data.Text as T
import Relude hiding
  ( break,
    drop,
    head,
    intercalate,
    isPrefixOf,
    null,
    uncons,
    words,
  )

type SourceText = Text

parseOptions :: [Text] -> [Text]
parseOptions :: [Text] -> [Text]
parseOptions [Text]
raw = [Text]
raw [Text] -> (Text -> [Text]) -> [Text]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((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
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
",")

parseField :: SourceText -> (SourceText, SourceText)
parseField :: Text -> (Text, Text)
parseField = (Text -> Text) -> (Text, Text) -> (Text, Text)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Text -> Text
strip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
drop Int
1) ((Text, Text) -> (Text, Text))
-> (Text -> (Text, Text)) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> (Text, Text)
breakAt (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')

firstWord :: SourceText -> (SourceText, SourceText)
firstWord :: Text -> (Text, Text)
firstWord = (Char -> Bool) -> Text -> (Text, Text)
breakAt Char -> Bool
isSeparator

fromByteString :: ByteString -> SourceText
fromByteString :: ByteString -> Text
fromByteString = String -> Text
pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpack

ignoreSpaces :: SourceText -> SourceText
ignoreSpaces :: Text -> Text
ignoreSpaces = (Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSeparator)

breakAt :: (Char -> Bool) -> SourceText -> (SourceText, SourceText)
breakAt :: (Char -> Bool) -> Text -> (Text, Text)
breakAt Char -> Bool
f = (Text -> Text) -> (Text -> Text) -> (Text, Text) -> (Text, Text)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> Text
strip Text -> Text
strip ((Text, Text) -> (Text, Text))
-> (Text -> (Text, Text)) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> (Text, Text)
break Char -> Bool
f (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip

sepBy :: (MonadFail m, Parse a) => SourceText -> SourceText -> m [a]
sepBy :: forall (m :: * -> *) a.
(MonadFail m, Parse a) =>
Text -> Text -> m [a]
sepBy Text
sep = (Text -> m a) -> [Text] -> m [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Text -> m a
forall a (m :: * -> *). (Parse a, MonadFail m) => Text -> m a
forall (m :: * -> *). MonadFail m => Text -> m a
parse ([Text] -> m [a]) -> (Text -> [Text]) -> Text -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
splitOn Text
sep (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
ignoreSpaces

removeHead :: Char -> SourceText -> (Bool, SourceText)
removeHead :: Char -> Text -> (Bool, Text)
removeHead Char
should Text
txt = (Bool, Text)
-> ((Char, Text) -> (Bool, Text))
-> Maybe (Char, Text)
-> (Bool, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False, Text
txt) (Char, Text) -> (Bool, Text)
has (Text -> Maybe (Char, Text)
uncons Text
txt)
  where
    has :: (Char, Text) -> (Bool, Text)
has (Char
x, Text
xs)
      | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
should = (Bool
True, Text
xs)
      | Bool
otherwise = (Bool
False, Text
txt)

unconsM :: (MonadFail m) => String -> SourceText -> m (SourceText, SourceText)
unconsM :: forall (m :: * -> *).
MonadFail m =>
String -> Text -> m (Text, Text)
unconsM String
m Text
x = (Char -> Text) -> (Char, Text) -> (Text, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Char -> Text
singleton ((Char, Text) -> (Text, Text)) -> m (Char, Text) -> m (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Char, Text)
-> ((Char, Text) -> m (Char, Text))
-> Maybe (Char, Text)
-> m (Char, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m (Char, Text)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Char, Text)) -> String -> m (Char, Text)
forall a b. (a -> b) -> a -> b
$ String
m String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"<>: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
x) (Char, Text) -> m (Char, Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe (Char, Text)
uncons Text
x)

fromToString :: (ToString a) => a -> SourceText
fromToString :: forall a. ToString a => a -> Text
fromToString = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. ToString a => a -> String
toString

genUrl :: Text -> [Text] -> Text
genUrl :: Text -> [Text] -> Text
genUrl Text
domain = Text -> [Text] -> Text
intercalate Text
"/" ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
domain Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)

class Parse a where
  parse :: (MonadFail m) => Text -> m a

instance Parse Int where
  parse :: forall (m :: * -> *). MonadFail m => Text -> m Int
parse Text
t =
    m Int -> (Int -> m Int) -> Maybe Int -> m Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m Int
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Int) -> String -> m Int
forall a b. (a -> b) -> a -> b
$ String
"Could not parse Int: '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'!") Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString Text
t)