{-# LANGUAGE Safe #-}

-----------------------------------------------------------------------------
-- |
-- Module      : Passman.Core.Mode
-- Copyright   : Matthew Harm Bekkema 2016
-- License     : GPL-2
-- Maintainer  : mbekkema97@gmail.com
-- Stability   : experimental
-- Portability : POSIX
-----------------------------------------------------------------------------

module Passman.Core.Mode
(
-- * Mode
 Mode
-- * Base modes
, modeS
, modeN
, modeC
, modeL
-- * Constants
, validModes
, defaultMode
-- * Combining modes
, (<+>)
, combineModes
-- * Splitting modes
, (<->)
, splitMode
-- * Parsing modes
, readModeMay
, readModeDef
-- * Convert mode to character set
, modeToConstraint
) where

import Control.Monad (mfilter)
import Data.Bits ((.|.), testBit, clearBit, setBit)
import Data.List (sort, (\\))
import Data.Maybe (fromMaybe)
import Text.Read
import qualified Text.Read.Lex as L

-- | Represents the sets of characters that generated passwords may contain.
newtype Mode = Mode Int
    deriving Eq

instance Show Mode where
  show = map helper . splitMode
    where
      helper x
        | x == modeS = 's'
        | x == modeN = 'n'
        | x == modeC = 'c'
        | x == modeL = 'l'
        | otherwise  = error "show: Invalid sigleton mode"

instance Read Mode where
  readPrec =
    parens
    ( do L.Ident s <- lexP
         case filter ((==) s . snd) modeStrings of
           [(m,_)]  -> return m
           _       -> pfail
    )
    where
      modeStrings = map (\m -> (m, show m)) validModes
  readListPrec = readListPrecDefault
  readList     = readListDefault

lower, upper, numbers, symbols :: String
lower = ['a'..'z']
upper = ['A'..'Z']
numbers = ['0'..'9']
symbols = "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~"

modeS, modeN, modeC, modeL :: Mode
-- | Represents the character set: !\"#$%&\'()*+,-./:;\<\=\>?\@[\\]^_\`{|}~
modeS = Mode $ setBit 0 0
-- | Represents the character set: 0123456789
modeN = Mode $ setBit 0 1
-- | Represents the character set: ABCDEFGHIJKLMNOPQRSTUVWXYZ
modeC = Mode $ setBit 0 2
-- | Represents the character set: abcdefghijklmnopqrstuvwxyz
modeL = Mode $ setBit 0 3

-- | The combination of `modeN`, `modeC` and `modeL`
defaultMode :: Mode
defaultMode = modeN <+> modeC <+> modeL

-- | Join two modes together. For example `modeC` `<+>` `modeL` represents the
-- character set: ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz
(<+>) :: Mode -> Mode -> Mode
Mode x <+> Mode y = Mode (x .|. y)

-- | Subtracts a mode from another mode. Returns `Nothing` if the result would
-- be empty
(<->) :: Mode -> Mode -> Maybe Mode
x <-> y = combineModes $ x' \\ y'
  where
    x' = splitMode x
    y' = splitMode y

-- | List of every valid mode
validModes :: [Mode]
validModes = map Mode [1..15]

-- | Split a mode into its base modes.
splitMode :: Mode -> [Mode]
splitMode (Mode x)
  | x == 0      = []
  | testBit x 0 = modeS : splitMode (Mode $ clearBit x 0)
  | testBit x 1 = modeN : splitMode (Mode $ clearBit x 1)
  | testBit x 2 = modeC : splitMode (Mode $ clearBit x 2)
  | testBit x 3 = modeL : splitMode (Mode $ clearBit x 3)
  | otherwise   = error "splitMode"

-- | Combines a list of modes using `<+>`. Returns `Nothing` on empty list.
combineModes :: [Mode] -> Maybe Mode
combineModes = mfilter (Mode 0 /=) . return . foldr (<+>) (Mode 0)

-- | Reads a string for the characters: 's', 'n', 'c' or 'l'. Constructs a mode
-- based on those characters where 's' represents `modeS`, 'n' represents
-- `modeN`, 'c' represents `modeC` and 'l' represents `modeL`. Returns `Nothing`
-- if the string does not contain 's', 'n', 'c' or 'l'.
readModeMay :: String -> Maybe Mode
readModeMay = combineModes . map helper
  where
    helper :: Char -> Mode
    helper 's' = modeS
    helper 'n' = modeN
    helper 'c' = modeC
    helper 'l' = modeL
    helper  _  = Mode 0

-- | Like `readModeMay`, but returns `defaultMode` instead of `Nothing`.
readModeDef :: String -> Mode
readModeDef = fromMaybe defaultMode . readModeMay

-- | Get the character set that the specified mode represents
modeToConstraint :: Mode -> String
modeToConstraint = sort . concatMap helper . splitMode
  where
    helper :: Mode -> String
    helper x
      | x == modeS = symbols
      | x == modeN = numbers
      | x == modeC = upper
      | x == modeL = lower
      | otherwise  = error "modeToConstraint: Invalid sigleton mode"