-- |
-- Copyright: (c) 2022 Manuel Spagnolo
-- SPDX-License-Identifier: MIT
-- Maintainer: Manuel Spagnolo <spagnolo.manu@gmail.com>
--
-- Generate a QR code from a given input string.
-- The output of the entry point `generate` is an array representing the drawable representation of the QR code,
-- meaning a data structure that can be mapped - for instance - to terminal output or images.
--
-- The module includes a CLI utility which prints the QR code directly in the terminal as an example.
--
-- You can install it via
--
-- @
-- cabal install exe:kewar
-- @
--
-- And use it like
--
-- @
-- kewar "Hello World"
-- ██████████████  ██  ██  ████████    ██████████████
-- ██          ██    ██████  ████████  ██          ██
-- ██  ██████  ██        ██████  ██    ██  ██████  ██
-- ██  ██████  ██      ██      ████    ██  ██████  ██
-- ██  ██████  ██  ████  ██      ████  ██  ██████  ██
-- ██          ██  ██    ██            ██          ██
-- ██████████████  ██  ██  ██  ██  ██  ██████████████
--                         ██  ██  ██                
--   ██████████████                ██    ████      ██
--       ██████  ██  ██████  ██████      ██    ██    
--     ██████  ██  ██  ████  ██████████    ████  ████
--       ██      ██████████  ██  ██    ██        ████
-- ██  ██    ██████      ██    ████  ████████████████
-- ██  ████████      ████████    ████    ██    ██    
-- ██          ██  ██      ██  ██    ██████████  ████
-- ██  ██    ██  ██  ████  ██  ██  ██  ██████      ██
-- ██      ██  ██  ████  ██        ██████████████    
--                                 ██      ██  ██  ██
-- ██████████████  ██████  ████  ████  ██  ██  ██████
-- ██          ██  ██  ██    ████████      ████  ██  
-- ██  ██████  ██  ██  ████      ████████████████    
-- ██  ██████  ██  ████        ██      ██  ████    ██
-- ██  ██████  ██  ██    ██    ████    ████  ██    ██
-- ██          ██  ██  ██████    ██  ██  ████      ██
-- ██████████████    ████  ████    ██    ██      ████
-- @

module Kewar
  ( generate,
    CorrectionLevel (..),
    Grid,
    cols,
    rows,
    Module (..),
    Position,
  )
where

import Kewar.Encoding (encodeData, encodeError, mode, version)
import Kewar.Layout (Grid, Module (..), Position, cols, placeBits, rows)
import Kewar.Types (CorrectionLevel (..), Exception, Mode)

-- | Entry point of the library. Attempts generating a QR Code Grid from a given input string.
generate :: String -> CorrectionLevel -> Either Exception Grid
generate :: String -> CorrectionLevel -> Either Exception Grid
generate String
i CorrectionLevel
cl = case Either Exception Mode
maybeMode of
  Left Exception
e -> Exception -> Either Exception Grid
forall a b. a -> Either a b
Left Exception
e
  Right Mode
m -> Grid -> Either Exception Grid
forall a b. b -> Either a b
Right (Grid -> Either Exception Grid) -> Grid -> Either Exception Grid
forall a b. (a -> b) -> a -> b
$ String -> CorrectionLevel -> Mode -> Grid
generateWithMode String
i CorrectionLevel
cl Mode
m
  where
    maybeMode :: Either Exception Mode
maybeMode = String -> Either Exception Mode
mode String
i

generateWithMode :: String -> CorrectionLevel -> Mode -> Grid
generateWithMode :: String -> CorrectionLevel -> Mode -> Grid
generateWithMode String
i CorrectionLevel
cl Mode
m = do
  let v :: Version
v = String -> Mode -> CorrectionLevel -> Version
version String
i Mode
m CorrectionLevel
cl
  let encoded :: [Group]
encoded = String -> Mode -> Version -> CorrectionLevel -> [Group]
encodeData String
i Mode
m Version
v CorrectionLevel
cl
  let ecw :: [Group]
ecw = [Group] -> CorrectionLevel -> Version -> [Group]
encodeError [Group]
encoded CorrectionLevel
cl Version
v
  Version -> CorrectionLevel -> [Group] -> [Group] -> Grid
placeBits Version
v CorrectionLevel
cl [Group]
encoded [Group]
ecw