{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}

module Options.Nested.Flag where

import           Data.Attoparsec.Text
import qualified Data.Text            as T

import           Control.Applicative
import           Data.Monoid


class ( Show a
      , Eq a ) => FlagLabel a where
  type Parsed
  parserFlagLabel :: a -> Parser Parsed

data SmallFlag = SmallFlag Char deriving Eq

instance Show SmallFlag where
  show (SmallFlag c) = "-" <> [c]

instance FlagLabel SmallFlag where
  type Parsed = T.Text
  parserFlagLabel (SmallFlag c) = string $ "-" <> T.pack [c]

data LargeFlag = LargeFlag T.Text deriving Eq

instance Show LargeFlag where
  show (LargeFlag s) = "--" <> T.unpack s

instance FlagLabel LargeFlag where
  type Parsed = T.Text
  parserFlagLabel (LargeFlag s) = string $ "--" <> s


-- | Very degenerate, but simple. We are trusting the programmer to not be
-- silly.
data Flag where
  SingleFlag :: FlagLabel a =>
                a
             -> Flag
  DoubleFlag :: ( FlagLabel a
                , FlagLabel b ) =>
                a
             -> b
             -> Flag

instance Eq Flag where
  (SingleFlag x) == (SingleFlag y) = x == y
  (DoubleFlag a b) == (DoubleFlag c d) = (a == c && b == d)
                                      || (a == d && b == c)
  _ == _ = False

instance Show Flag where
  show (SingleFlag a) = show a
  show (DoubleFlag x y) = "(" <> show x <> "/" <> show y <> ")"

instance FlagLabel Flag where
  type Parsed = T.Text
  parserFlagLabel (SingleFlag a) = parserFlagLabel a
  parserFlagLabel (DoubleFlag x y) = parserFlagLabel x <|> parserFlagLabel y
