{-# LANGUAGE NoImplicitPrelude #-}

module Codec.QRCode.Mode.Automatic
  ( automatic
  ) where

import           Codec.QRCode.Base

import           Codec.QRCode.Data.QRSegment.Internal
import           Codec.QRCode.Data.Result
import           Codec.QRCode.Data.TextEncoding
import           Codec.QRCode.Data.ToInput
import           Codec.QRCode.Mode.Alphanumeric
import           Codec.QRCode.Mode.Byte
import           Codec.QRCode.Mode.Kanji
import           Codec.QRCode.Mode.Numeric

-- | Encode a whole string using the mode with the shortest result.
--   Will pick either `numeric`, `alphanumeric`, `kanji` or `text` based on the contents.
--
--   Please refer to the specific documentations for details.
automatic :: ToText a => TextEncoding -> a -> Result QRSegment
automatic :: TextEncoding -> a -> Result QRSegment
automatic TextEncoding
te a
s = [Char] -> Result QRSegment
forall a. ToNumeric a => a -> Result QRSegment
numeric [Char]
s' Result QRSegment -> Result QRSegment -> Result QRSegment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Result QRSegment
forall a. ToText a => a -> Result QRSegment
alphanumeric [Char]
s' Result QRSegment -> Result QRSegment -> Result QRSegment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Result QRSegment
forall a. ToText a => a -> Result QRSegment
kanji [Char]
s' Result QRSegment -> Result QRSegment -> Result QRSegment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextEncoding -> a -> Result QRSegment
forall a. ToText a => TextEncoding -> a -> Result QRSegment
text TextEncoding
te a
s
  where
    s' :: [Char]
    s' :: [Char]
s' = a -> [Char]
forall a. ToText a => a -> [Char]
toString a
s