{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TemplateHaskell #-}

module Parser.Types (
  Atom (..),
  FormatArg (..),
  Flag (..),
  adjustmentFlags,
  Adjustment (..),
  FormatStr,
  MaySpecify (..),
  emptyFlagSet,
  toFlagSet,
  FlagSet (..),
  LengthSpecifier (..),
  flags_,
  spec_,
  signed_,
  prefixed_,
  spaced_,
  adjustment_,
) where

import Data.Foldable (
  elem,
  notElem,
 )
import Data.Set (Set)
import qualified Data.Set as S
import Language.Haskell.TH.Lift
import Lens.Micro.Platform
import Prelude hiding (
  elem,
  notElem,
 )

data Atom
  = Arg FormatArg
  | Str String
  deriving (Int -> Atom -> ShowS
[Atom] -> ShowS
Atom -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Atom] -> ShowS
$cshowList :: [Atom] -> ShowS
show :: Atom -> String
$cshow :: Atom -> String
showsPrec :: Int -> Atom -> ShowS
$cshowsPrec :: Int -> Atom -> ShowS
Show)

data LengthSpecifier
  = HH
  | H
  | BigL
  | LL
  | L
  | J
  | Z
  | T
  deriving (LengthSpecifier -> LengthSpecifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LengthSpecifier -> LengthSpecifier -> Bool
$c/= :: LengthSpecifier -> LengthSpecifier -> Bool
== :: LengthSpecifier -> LengthSpecifier -> Bool
$c== :: LengthSpecifier -> LengthSpecifier -> Bool
Eq)

instance Show LengthSpecifier where
  show :: LengthSpecifier -> String
show LengthSpecifier
HH = String
"hh"
  show LengthSpecifier
H = String
"h"
  show LengthSpecifier
BigL = String
"L"
  show LengthSpecifier
LL = String
"ll"
  show LengthSpecifier
L = String
"l"
  show LengthSpecifier
J = String
"j"
  show LengthSpecifier
Z = String
"z"
  show LengthSpecifier
T = String
"t"

data Flag
  = FlagLJust
  | FlagSigned
  | FlagSpaced
  | FlagPrefixed
  | FlagZeroPadded
  deriving (Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show, Flag -> Flag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Eq Flag
Flag -> Flag -> Bool
Flag -> Flag -> Ordering
Flag -> Flag -> Flag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Flag -> Flag -> Flag
$cmin :: Flag -> Flag -> Flag
max :: Flag -> Flag -> Flag
$cmax :: Flag -> Flag -> Flag
>= :: Flag -> Flag -> Bool
$c>= :: Flag -> Flag -> Bool
> :: Flag -> Flag -> Bool
$c> :: Flag -> Flag -> Bool
<= :: Flag -> Flag -> Bool
$c<= :: Flag -> Flag -> Bool
< :: Flag -> Flag -> Bool
$c< :: Flag -> Flag -> Bool
compare :: Flag -> Flag -> Ordering
$ccompare :: Flag -> Flag -> Ordering
Ord)

adjustmentFlags :: Set Flag
adjustmentFlags :: Set Flag
adjustmentFlags = forall a. Ord a => [a] -> Set a
S.fromList [Flag
FlagLJust, Flag
FlagZeroPadded]

data Adjustment
  = LeftJustified
  | ZeroPadded
  deriving (Int -> Adjustment -> ShowS
[Adjustment] -> ShowS
Adjustment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Adjustment] -> ShowS
$cshowList :: [Adjustment] -> ShowS
show :: Adjustment -> String
$cshow :: Adjustment -> String
showsPrec :: Int -> Adjustment -> ShowS
$cshowsPrec :: Int -> Adjustment -> ShowS
Show, Adjustment -> Adjustment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Adjustment -> Adjustment -> Bool
$c/= :: Adjustment -> Adjustment -> Bool
== :: Adjustment -> Adjustment -> Bool
$c== :: Adjustment -> Adjustment -> Bool
Eq)

data MaySpecify
  = Given Integer
  | Need
  deriving (Int -> MaySpecify -> ShowS
[MaySpecify] -> ShowS
MaySpecify -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaySpecify] -> ShowS
$cshowList :: [MaySpecify] -> ShowS
show :: MaySpecify -> String
$cshow :: MaySpecify -> String
showsPrec :: Int -> MaySpecify -> ShowS
$cshowsPrec :: Int -> MaySpecify -> ShowS
Show)

data FormatArg = FormatArg
  { FormatArg -> FlagSet
flags :: FlagSet
  , FormatArg -> Maybe MaySpecify
width :: Maybe MaySpecify
  , FormatArg -> Maybe MaySpecify
precision :: Maybe MaySpecify
  , FormatArg -> Char
spec :: Char
  , FormatArg -> Maybe LengthSpecifier
lengthSpec :: Maybe LengthSpecifier
  }
  deriving (Int -> FormatArg -> ShowS
[FormatArg] -> ShowS
FormatArg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatArg] -> ShowS
$cshowList :: [FormatArg] -> ShowS
show :: FormatArg -> String
$cshow :: FormatArg -> String
showsPrec :: Int -> FormatArg -> ShowS
$cshowsPrec :: Int -> FormatArg -> ShowS
Show)

type FormatStr = [Atom]

data FlagSet = FlagSet
  { FlagSet -> Maybe Adjustment
adjustment :: Maybe Adjustment
  , FlagSet -> Bool
signed :: Bool
  , FlagSet -> Bool
spaced :: Bool
  , FlagSet -> Bool
prefixed :: Bool
  }
  deriving (Int -> FlagSet -> ShowS
[FlagSet] -> ShowS
FlagSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagSet] -> ShowS
$cshowList :: [FlagSet] -> ShowS
show :: FlagSet -> String
$cshow :: FlagSet -> String
showsPrec :: Int -> FlagSet -> ShowS
$cshowsPrec :: Int -> FlagSet -> ShowS
Show)

emptyFlagSet :: FlagSet
emptyFlagSet :: FlagSet
emptyFlagSet = Maybe Adjustment -> Bool -> Bool -> Bool -> FlagSet
FlagSet forall a. Maybe a
Nothing Bool
False Bool
False Bool
False

toFlagSet :: Set Flag -> FlagSet
toFlagSet :: Set Flag -> FlagSet
toFlagSet Set Flag
fs = FlagSet
set'
 where
  adjustment :: Maybe Adjustment
adjustment
    | Flag
FlagLJust forall a. Ord a => a -> Set a -> Bool
`S.member` Set Flag
fs = forall a. a -> Maybe a
Just Adjustment
LeftJustified
    | Flag
FlagZeroPadded forall a. Ord a => a -> Set a -> Bool
`S.member` Set Flag
fs = forall a. a -> Maybe a
Just Adjustment
ZeroPadded
    | Bool
otherwise = forall a. Maybe a
Nothing
  set' :: FlagSet
set' =
    FlagSet
      { signed :: Bool
signed = Flag
FlagSigned forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set Flag
fs
      , prefixed :: Bool
prefixed = Flag
FlagPrefixed forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set Flag
fs
      , Maybe Adjustment
adjustment :: Maybe Adjustment
adjustment :: Maybe Adjustment
adjustment
      , spaced :: Bool
spaced = Flag
FlagSpaced forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set Flag
fs Bool -> Bool -> Bool
&& Flag
FlagSigned forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Flag
fs
      }

makeLensesFor
  [ ("adjustment", "adjustment_")
  , ("signed", "signed_")
  , ("spaced", "spaced_")
  , ("prefixed", "prefixed_")
  ]
  ''FlagSet

makeLensesFor
  [ ("flags", "flags_")
  , ("spec", "spec_")
  ]
  ''FormatArg

deriveLiftMany [''Adjustment, ''FlagSet, ''LengthSpecifier]