{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.BCP47.Internal.Script
  ( Script(Script)
  , scriptFromText
  , scriptToText
  , scriptP
  )
where

import Data.BCP47.Internal.Arbitrary (Arbitrary, alphaString, arbitrary)
import Data.BCP47.Internal.Parser (complete)
import Data.Bifunctor (first)
import Data.Text (Text, pack)
import Data.Void (Void)
import Text.Megaparsec (Parsec, count, parse)
import Text.Megaparsec.Char (letterChar)
import Text.Megaparsec.Error (errorBundlePretty)

-- | Script subtags
--
-- Script subtags are used to indicate the script or writing system
-- variations that distinguish the written forms of a language or its
-- dialects.
--
newtype Script = Script { Script -> Text
scriptToText :: Text }
  deriving stock (Int -> Script -> ShowS
[Script] -> ShowS
Script -> String
(Int -> Script -> ShowS)
-> (Script -> String) -> ([Script] -> ShowS) -> Show Script
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Script] -> ShowS
$cshowList :: [Script] -> ShowS
show :: Script -> String
$cshow :: Script -> String
showsPrec :: Int -> Script -> ShowS
$cshowsPrec :: Int -> Script -> ShowS
Show, Script -> Script -> Bool
(Script -> Script -> Bool)
-> (Script -> Script -> Bool) -> Eq Script
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Script -> Script -> Bool
$c/= :: Script -> Script -> Bool
== :: Script -> Script -> Bool
$c== :: Script -> Script -> Bool
Eq, Eq Script
Eq Script
-> (Script -> Script -> Ordering)
-> (Script -> Script -> Bool)
-> (Script -> Script -> Bool)
-> (Script -> Script -> Bool)
-> (Script -> Script -> Bool)
-> (Script -> Script -> Script)
-> (Script -> Script -> Script)
-> Ord Script
Script -> Script -> Bool
Script -> Script -> Ordering
Script -> Script -> Script
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Script -> Script -> Script
$cmin :: Script -> Script -> Script
max :: Script -> Script -> Script
$cmax :: Script -> Script -> Script
>= :: Script -> Script -> Bool
$c>= :: Script -> Script -> Bool
> :: Script -> Script -> Bool
$c> :: Script -> Script -> Bool
<= :: Script -> Script -> Bool
$c<= :: Script -> Script -> Bool
< :: Script -> Script -> Bool
$c< :: Script -> Script -> Bool
compare :: Script -> Script -> Ordering
$ccompare :: Script -> Script -> Ordering
$cp1Ord :: Eq Script
Ord)

instance Arbitrary Script where
  arbitrary :: Gen Script
arbitrary = Text -> Script
Script (Text -> Script) -> (String -> Text) -> String -> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Script) -> Gen String -> Gen Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen String
alphaString Int
4

-- | Parse a 'Script' subtag from 'Text'
scriptFromText :: Text -> Either Text Script
scriptFromText :: Text -> Either Text Script
scriptFromText =
  (ParseErrorBundle Text Void -> Text)
-> Either (ParseErrorBundle Text Void) Script -> Either Text Script
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) (Either (ParseErrorBundle Text Void) Script -> Either Text Script)
-> (Text -> Either (ParseErrorBundle Text Void) Script)
-> Text
-> Either Text Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Script
-> String -> Text -> Either (ParseErrorBundle Text Void) Script
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text Script
scriptP String
"scriptFromText"

-- | BCP-47 script parser
--
-- @@
--  script        = 4ALPHA              ; ISO 15924 code
-- @@
--
scriptP :: Parsec Void Text Script
scriptP :: Parsec Void Text Script
scriptP = Parsec Void Text Script -> Parsec Void Text Script
forall a. Parsec Void Text a -> Parsec Void Text a
complete (Parsec Void Text Script -> Parsec Void Text Script)
-> Parsec Void Text Script -> Parsec Void Text Script
forall a b. (a -> b) -> a -> b
$ Text -> Script
Script (Text -> Script) -> (String -> Text) -> String -> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Script)
-> ParsecT Void Text Identity String -> Parsec Void Text Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
4 ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar