{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | A data type with ten nullary constructors [0-9] and combinators.
module Data.Digit
(
  Digit
, foldDigit
, HasDigit(..)
, AsDigit(..)
, ManyDigit(..)
, D0(..)
, D1(..)
, D2(..)
, D3(..)
, D4(..)
, D5(..)
, D6(..)
, D7(..)
, D8(..)
, D9(..)
, mod10
, absrem10
, divMod10
, parsedigit
, digitQ
, (/+/)
) where

import Data.Data (Data)
import Data.Maybe(fromMaybe)
import Data.Typeable (Typeable)
import Language.Haskell.TH(ExpQ, PatQ, varE, varP, mkName)
import Language.Haskell.TH.Quote(QuasiQuoter(QuasiQuoter), quotePat, quoteExp, quoteDec, dataToExpQ, dataToPatQ, quoteType)
import Prelude(fromEnum, Bounded, error) -- livin on the edge
import Text.Parser.Char(CharParsing, char)
import Text.Parser.Combinators((<?>))
import Papa

-- $setup
-- >>> import Prelude

-- | A data type with ten nullary constructors.
data Digit =
  D0
  | D1
  | D2
  | D3
  | D4
  | D5
  | D6
  | D7
  | D8
  | D9
  deriving (Eq, Ord, Enum, Bounded, Data, Typeable)

instance Show Digit where
  show =
    show . fromEnum

-- | Catamorphism for @Digit@.
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D0 == q0
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D1 == q1
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D2 == q2
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D3 == q3
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D4 == q4
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D5 == q5
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D6 == q6
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D7 == q7
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D8 == q8
--
-- prop> foldDigit q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 D9 == q9
foldDigit ::
  a -- ^ Zero.
  -> a -- ^ One.
  -> a -- ^ Two.
  -> a -- ^ Three.
  -> a -- ^ Four.
  -> a -- ^ Five.
  -> a -- ^ Six.
  -> a -- ^ Seven.
  -> a -- ^ Eight.
  -> a -- ^ Nine.
  -> Digit -- ^ The digit to fold.
  -> a
foldDigit q0 _  _  _  _  _  _  _  _  _  D0 =
  q0
foldDigit _  q1 _  _  _  _  _  _  _  _  D1 =
  q1
foldDigit _  _  q2 _  _  _  _  _  _  _  D2 =
  q2
foldDigit _  _  _  q3 _  _  _  _  _  _  D3 =
  q3
foldDigit _  _  _  _  q4 _  _  _  _  _  D4 =
  q4
foldDigit _  _  _  _  _  q5 _  _  _  _  D5 =
  q5
foldDigit _  _  _  _  _  _  q6 _  _  _  D6 =
  q6
foldDigit _  _  _  _  _  _  _  q7 _  _  D7 =
  q7
foldDigit _  _  _  _  _  _  _  _  q8 _  D8 =
  q8
foldDigit _  _  _  _  _  _  _  _  _  q9 D9 =
  q9

class HasDigit a where
  hasdigit ::
    Lens' a Digit

instance HasDigit Digit where
  hasdigit =
    id

class D0 d where
  d0 ::
    Prism'
      d
      ()
  x0 ::
    D0 d =>
    d
  x0 =
    d0 # ()

instance D0 Digit where
  d0 =
    prism'
      (\() -> D0)
      (\d -> case d of
               D0 -> Just ()
               _ -> Nothing)

class D1 d where
  d1 ::
    Prism'
      d
      ()
  x1 ::
    D1 d =>
    d
  x1 =
    d1 # ()

instance D1 Digit where
  d1 =
    prism'
      (\() -> D1)
      (\d -> case d of
               D1 -> Just ()
               _ -> Nothing)

class D2 d where
  d2 ::
    Prism'
      d
      ()
  x2 ::
    D2 d =>
    d
  x2 =
    d2 # ()

instance D2 Digit where
  d2 =
    prism'
      (\() -> D2)
      (\d -> case d of
               D2 -> Just ()
               _ -> Nothing)

class D3 d where
  d3 ::
    Prism'
      d
      ()
  x3 ::
    D3 d =>
    d
  x3 =
    d3 # ()

instance D3 Digit where
  d3 =
    prism'
      (\() -> D3)
      (\d -> case d of
               D3 -> Just ()
               _ -> Nothing)

class D4 d where
  d4 ::
    Prism'
      d
      ()
  x4 ::
    D4 d =>
    d
  x4 =
    d4 # ()

instance D4 Digit where
  d4 =
    prism'
      (\() -> D4)
      (\d -> case d of
               D4 -> Just ()
               _ -> Nothing)

class D5 d where
  d5 ::
    Prism'
      d
      ()
  x5 ::
    D5 d =>
    d
  x5 =
    d5 # ()

instance D5 Digit where
  d5 =
    prism'
      (\() -> D5)
      (\d -> case d of
               D5 -> Just ()
               _ -> Nothing)

class D6 d where
  d6 ::
    Prism'
      d
      ()
  x6 ::
    D6 d =>
    d
  x6 =
    d6 # ()

instance D6 Digit where
  d6 =
    prism'
      (\() -> D6)
      (\d -> case d of
               D6 -> Just ()
               _ -> Nothing)

class D7 d where
  d7 ::
    Prism'
      d
      ()
  x7 ::
    D7 d =>
    d
  x7 =
    d7 # ()

instance D7 Digit where
  d7 =
    prism'
      (\() -> D7)
      (\d -> case d of
               D7 -> Just ()
               _ -> Nothing)

class D8 d where
  d8 ::
    Prism'
      d
      ()
  x8 ::
    D8 d =>
    d
  x8 =
    d8 # ()

instance D8 Digit where
  d8 =
    prism'
      (\() -> D8)
      (\d -> case d of
               D8 -> Just ()
               _ -> Nothing)

class D9 d where
  d9 ::
    Prism'
      d
      ()
  x9 ::
    D9 d =>
    d
  x9 =
    d9 # ()

instance D9 Digit where
  d9 =
    prism'
      (\() -> D9)
      (\d -> case d of
               D9 -> Just ()
               _ -> Nothing)

class AsDigit a where
  digit ::
    Prism'
      a
      Digit

instance AsDigit Digit where
  digit =
    id      

-- | 
--
-- >>> (5 :: Int) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Int) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Int) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Int) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Int) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Int
-- 5
--
-- >>> digitIntegral # D9 :: Int
-- 9
--
-- >>> digitIntegral # D0 :: Int
-- 0
instance AsDigit Int where
  digit =
    digitIntegral

-- | 
--
-- >>> (5 :: Int8) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Int8) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Int8) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Int8) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Int8) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Int8
-- 5
--
-- >>> digitIntegral # D9 :: Int8
-- 9
--
-- >>> digitIntegral # D0 :: Int8
-- 0
instance AsDigit Int8 where
  digit =
    digitIntegral

-- | 
--
-- >>> (5 :: Int16) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Int16) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Int16) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Int16) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Int16) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Int16
-- 5
--
-- >>> digitIntegral # D9 :: Int16
-- 9
--
-- >>> digitIntegral # D0 :: Int16
-- 0   
instance AsDigit Int16 where
  digit =
    digitIntegral
    
-- | 
--
-- >>> (5 :: Int32) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Int32) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Int32) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Int32) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Int32) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Int32
-- 5
--
-- >>> digitIntegral # D9 :: Int32
-- 9
--
-- >>> digitIntegral # D0 :: Int32
-- 0
instance AsDigit Int32 where
  digit =
    digitIntegral

-- | 
--
-- >>> (5 :: Int64) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Int64) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Int64) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Int64) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Int64) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Int64
-- 5
--
-- >>> digitIntegral # D9 :: Int64
-- 9
--
-- >>> digitIntegral # D0 :: Int64
-- 0
instance AsDigit Int64 where
  digit =
    digitIntegral

-- | 
--
-- >>> (5 :: Integer) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Integer) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Integer) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Integer) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Integer) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Integer
-- 5
--
-- >>> digitIntegral # D9 :: Integer
-- 9
--
-- >>> digitIntegral # D0 :: Integer
-- 0
instance AsDigit Integer where
  digit =
    digitIntegral

-- | 
--
-- >>> (5 :: Identity Int) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Identity Int) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Identity Int) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Identity Int) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Identity Int) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Identity Int
-- Identity 5
--
-- >>> digitIntegral # D9 :: Identity Int
-- Identity 9
--
-- >>> digitIntegral # D0 :: Identity Int
-- Identity 0
instance Integral a => AsDigit (Identity a) where
  digit =
    digitIntegral

-- | 
--
-- >>> (5 :: Const Int String) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Const Int String) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Const Int String) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Const Int String) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Const Int String) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Const Int String
-- Const 5
--
-- >>> digitIntegral # D9 :: Const Int String
-- Const 9
--
-- >>> digitIntegral # D0 :: Const Int String
-- Const 0
instance Integral a => AsDigit (Const a b) where
  digit =
    digitIntegral

-- | 
--
-- >>> (5 :: Word) ^? digitIntegral
-- Just 5
--
-- >>> (0 :: Word) ^? digitIntegral
-- Just 0
--
-- >>> (9 :: Word) ^? digitIntegral
-- Just 9
--
-- >>> (10 :: Word) ^? digitIntegral
-- Nothing
--
-- >>> ((-5) :: Word) ^? digitIntegral
-- Nothing
--
-- >>> digitIntegral # D5 :: Word
-- 5
--
-- >>> digitIntegral # D9 :: Word
-- 9
--
-- >>> digitIntegral # D0 :: Word
-- 0
instance AsDigit Word where
  digit =
    digitIntegral

-- | 
--
-- >>> '5' ^? digit
-- Just 5
--
-- >>> '0' ^? digit
-- Just 0
--
-- >>> '9' ^? digit
-- Just 9
--
-- >>> 'a' ^? digit
-- Nothing
--
-- >>> '@' ^? digit
-- Nothing
--
-- >>> digit # D5 :: Char
-- '5'
--
-- >>> digit # D9 :: Char
-- '9'
--
-- >>> digit # D0 :: Char
-- '0'
instance AsDigit Char where
  digit =
    prism'
      (\d -> case d of D0 -> '0'
                       D1 -> '1'
                       D2 -> '2'
                       D3 -> '3'
                       D4 -> '4'
                       D5 -> '5'
                       D6 -> '6'
                       D7 -> '7'
                       D8 -> '8'
                       D9 -> '9')
      (\n -> case n of '0' -> Just D0
                       '1' -> Just D1
                       '2' -> Just D2
                       '3' -> Just D3
                       '4' -> Just D4
                       '5' -> Just D5
                       '6' -> Just D6
                       '7' -> Just D7
                       '8' -> Just D8
                       '9' -> Just D9
                       _ -> Nothing)

class ManyDigit a where
  digitT ::
    Traversal'
      a
      Digit

instance ManyDigit Digit where
  digitT =
    id
    
-- | Modulus with 10.
--
-- >>> mod10 0
-- 0
--
-- >>> mod10 1
-- 1
--
-- >>> mod10 8
-- 8
--
-- >>> mod10 9
-- 9
--
-- >>> mod10 10
-- 0
--
-- >>> mod10 90
-- 0
--
-- >>> mod10 91
-- 1
--
-- >>> mod10 (-1)
-- 9
--
-- >>> mod10 (-12)
-- 8
mod10 ::
  Integral a =>
  a
  -> Digit
mod10 n =
  let r = n `mod` 10
  in fromMaybe (mod10 r) (r ^? digitIntegral)

-- | Absolute value of remainder 10.
--
-- >>> absrem10 0
-- 0
--
-- >>> absrem10 1
-- 1
--
-- >>> absrem10 8
-- 8
--
-- >>> absrem10 9
-- 9
--
-- >>> absrem10 10
-- 0
--
-- >>> absrem10 90
-- 0
--
-- >>> absrem10 91
-- 1
--
-- >>> absrem10 (-1)
-- 1
--
-- >>> absrem10 (-12)
-- 2
absrem10 ::
  Integral a =>
  a
  -> Digit
absrem10 n =
  let r = abs n `rem` 10
  in fromMaybe (absrem10 r) (r ^? digitIntegral)

-- | Division/modulus with 10.
--
-- >>> divMod10 0
-- (0,0)
--
-- >>> divMod10 1
-- (0,1)
--
-- >>> divMod10 8
-- (0,8)
--
-- >>> divMod10 9
-- (0,9)
--
-- >>> divMod10 10
-- (1,0)
--
-- >>> divMod10 90
-- (9,0)
--
-- >>> divMod10 91
-- (9,1)
--
-- >>> divMod10 (-1)
-- (-1,9)
divMod10 ::
  Integral a =>
  a
  -> (a, Digit)
divMod10 n =
  let (x, r) = n `divMod` 10
  in (x, mod10 r)

parsedigit ::
  CharParsing p =>
  p Digit
parsedigit =
  let p = asum ((\d -> d <$ char (digit # d)) <$> [D0 .. D9])
  in p <?> "Digit"

-- | A QuasiQuoter for any range of @Digit@.
--
-- [digitQ|4|] :: Digit
-- 4
--
-- named [digitQ|4|]  = "four"
-- named [digitQ|$x|] = "not four, " ++ show x ++ " instead"
--
-- mod10D x = let y = mod x 10 in [digitQ|$y|]
digitQ :: QuasiQuoter
digitQ = QuasiQuoter {
    quoteExp =  let dexp ::
                      [Char]
                      -> ExpQ
                    dexp ('$':vn) =
                      varE (mkName vn)
                    dexp (d:[]) =
                      maybe (error "not a digit") (dataToExpQ (const Nothing)) (d ^? digit)
                    dexp _ =
                      error "not a digit"
                in  dexp
  , quotePat =  let dpat ::
                      [Char]
                      -> PatQ
                    dpat ('$':vn) =
                      varP (mkName vn)
                    dpat (d:[]) =
                      maybe (error "not a digit") (dataToPatQ (const Nothing)) (d ^? digit)
                    dpat _ =
                      error "not a digit"
                in  dpat
  , quoteType =
      error "not quotable"
  , quoteDec =
      error "not quotable"
  }

-- |
--
-- >>> D0 /+/ D0
-- (0,0)
--
-- >>> D0 /+/ D1
-- (0,1)
--
-- >>> D1 /+/ D0
-- (0,1)
--
-- >>> D4 /+/ D5
-- (0,9)
--
-- >>> D5 /+/ D5
-- (1,0)
--
-- >>> D5 /+/ D6
-- (1,1)
--
-- >>> D8 /+/ D7
-- (1,5)
--
-- >>> D9 /+/ D9
-- (1,8)
(/+/) ::
  Digit
  -> Digit
  -> (Digit, Digit)
a /+/ b =
  let (x, r) = divMod10 (digitIntegral # a + digitIntegral # b)
  in (mod10 (x :: Integer), r) 

---- not exported
digitIntegral ::
  Integral a =>
  Prism' a Digit
digitIntegral =
  prism'
    (\n -> case n of D0 -> 0
                     D1 -> 1
                     D2 -> 2
                     D3 -> 3
                     D4 -> 4
                     D5 -> 5
                     D6 -> 6
                     D7 -> 7
                     D8 -> 8
                     D9 -> 9)
    (\n -> case n of 0 -> Just D0
                     1 -> Just D1
                     2 -> Just D2
                     3 -> Just D3
                     4 -> Just D4
                     5 -> Just D5
                     6 -> Just D6
                     7 -> Just D7
                     8 -> Just D8
                     9 -> Just D9
                     _ -> Nothing)