{-# LANGUAGE OverloadedStrings #-}

module Wingman.FeatureSet
  ( Feature (..)
  , FeatureSet
  , hasFeature
  , defaultFeatures
  , allFeatures
  , parseFeatureSet
  , prettyFeatureSet
  ) where

import           Data.List  (intercalate)
import           Data.Maybe (listToMaybe, mapMaybe)
import           Data.Set   (Set)
import qualified Data.Set   as S
import qualified Data.Text  as T


------------------------------------------------------------------------------
-- | All the available features. A 'FeatureSet' describes the ones currently
-- available to the user.
data Feature
  = FeatureDestructAll
  | FeatureUseDataCon
  | FeatureRefineHole
  | FeatureKnownMonoid
  deriving (Feature -> Feature -> Bool
(Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool) -> Eq Feature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feature -> Feature -> Bool
$c/= :: Feature -> Feature -> Bool
== :: Feature -> Feature -> Bool
$c== :: Feature -> Feature -> Bool
Eq, Eq Feature
Eq Feature
-> (Feature -> Feature -> Ordering)
-> (Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool)
-> (Feature -> Feature -> Feature)
-> (Feature -> Feature -> Feature)
-> Ord Feature
Feature -> Feature -> Bool
Feature -> Feature -> Ordering
Feature -> Feature -> Feature
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 :: Feature -> Feature -> Feature
$cmin :: Feature -> Feature -> Feature
max :: Feature -> Feature -> Feature
$cmax :: Feature -> Feature -> Feature
>= :: Feature -> Feature -> Bool
$c>= :: Feature -> Feature -> Bool
> :: Feature -> Feature -> Bool
$c> :: Feature -> Feature -> Bool
<= :: Feature -> Feature -> Bool
$c<= :: Feature -> Feature -> Bool
< :: Feature -> Feature -> Bool
$c< :: Feature -> Feature -> Bool
compare :: Feature -> Feature -> Ordering
$ccompare :: Feature -> Feature -> Ordering
$cp1Ord :: Eq Feature
Ord, Int -> Feature -> ShowS
[Feature] -> ShowS
Feature -> String
(Int -> Feature -> ShowS)
-> (Feature -> String) -> ([Feature] -> ShowS) -> Show Feature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feature] -> ShowS
$cshowList :: [Feature] -> ShowS
show :: Feature -> String
$cshow :: Feature -> String
showsPrec :: Int -> Feature -> ShowS
$cshowsPrec :: Int -> Feature -> ShowS
Show, ReadPrec [Feature]
ReadPrec Feature
Int -> ReadS Feature
ReadS [Feature]
(Int -> ReadS Feature)
-> ReadS [Feature]
-> ReadPrec Feature
-> ReadPrec [Feature]
-> Read Feature
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Feature]
$creadListPrec :: ReadPrec [Feature]
readPrec :: ReadPrec Feature
$creadPrec :: ReadPrec Feature
readList :: ReadS [Feature]
$creadList :: ReadS [Feature]
readsPrec :: Int -> ReadS Feature
$creadsPrec :: Int -> ReadS Feature
Read, Int -> Feature
Feature -> Int
Feature -> [Feature]
Feature -> Feature
Feature -> Feature -> [Feature]
Feature -> Feature -> Feature -> [Feature]
(Feature -> Feature)
-> (Feature -> Feature)
-> (Int -> Feature)
-> (Feature -> Int)
-> (Feature -> [Feature])
-> (Feature -> Feature -> [Feature])
-> (Feature -> Feature -> [Feature])
-> (Feature -> Feature -> Feature -> [Feature])
-> Enum Feature
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Feature -> Feature -> Feature -> [Feature]
$cenumFromThenTo :: Feature -> Feature -> Feature -> [Feature]
enumFromTo :: Feature -> Feature -> [Feature]
$cenumFromTo :: Feature -> Feature -> [Feature]
enumFromThen :: Feature -> Feature -> [Feature]
$cenumFromThen :: Feature -> Feature -> [Feature]
enumFrom :: Feature -> [Feature]
$cenumFrom :: Feature -> [Feature]
fromEnum :: Feature -> Int
$cfromEnum :: Feature -> Int
toEnum :: Int -> Feature
$ctoEnum :: Int -> Feature
pred :: Feature -> Feature
$cpred :: Feature -> Feature
succ :: Feature -> Feature
$csucc :: Feature -> Feature
Enum, Feature
Feature -> Feature -> Bounded Feature
forall a. a -> a -> Bounded a
maxBound :: Feature
$cmaxBound :: Feature
minBound :: Feature
$cminBound :: Feature
Bounded)


------------------------------------------------------------------------------
-- | A collection of enabled features.
type FeatureSet = Set Feature


------------------------------------------------------------------------------
-- | Parse a feature set.
parseFeatureSet :: T.Text -> FeatureSet
parseFeatureSet :: Text -> FeatureSet
parseFeatureSet
  = FeatureSet -> FeatureSet -> FeatureSet
forall a. Monoid a => a -> a -> a
mappend FeatureSet
defaultFeatures
  (FeatureSet -> FeatureSet)
-> (Text -> FeatureSet) -> Text -> FeatureSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Feature] -> FeatureSet
forall a. Ord a => [a] -> Set a
S.fromList
  ([Feature] -> FeatureSet)
-> (Text -> [Feature]) -> Text -> FeatureSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Feature) -> [Text] -> [Feature]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe Feature
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Feature)
-> (Text -> String) -> Text -> Maybe Feature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Monoid a => a -> a -> a
mappend String
featurePrefix ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
rot13 ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
  ([Text] -> [Feature]) -> (Text -> [Text]) -> Text -> [Feature]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')


------------------------------------------------------------------------------
-- | Features that are globally enabled for all users.
defaultFeatures :: FeatureSet
defaultFeatures :: FeatureSet
defaultFeatures = [Feature] -> FeatureSet
forall a. Ord a => [a] -> Set a
S.fromList
  [
  ]


------------------------------------------------------------------------------
-- | All available features.
allFeatures :: FeatureSet
allFeatures :: FeatureSet
allFeatures = [Feature] -> FeatureSet
forall a. Ord a => [a] -> Set a
S.fromList ([Feature] -> FeatureSet) -> [Feature] -> FeatureSet
forall a b. (a -> b) -> a -> b
$ Feature -> Feature -> [Feature]
forall a. Enum a => a -> a -> [a]
enumFromTo Feature
forall a. Bounded a => a
minBound Feature
forall a. Bounded a => a
maxBound


------------------------------------------------------------------------------
-- | Pretty print a feature set.
prettyFeatureSet :: FeatureSet -> String
prettyFeatureSet :: FeatureSet -> String
prettyFeatureSet
  = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/"
  ([String] -> String)
-> (FeatureSet -> [String]) -> FeatureSet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Feature -> String) -> [Feature] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS
rot13 ShowS -> (Feature -> String) -> Feature -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
featurePrefix) ShowS -> (Feature -> String) -> Feature -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Feature -> String
forall a. Show a => a -> String
show)
  ([Feature] -> [String])
-> (FeatureSet -> [Feature]) -> FeatureSet -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FeatureSet -> [Feature]
forall a. Set a -> [a]
S.toList


------------------------------------------------------------------------------
-- | Is a given 'Feature' currently enabled?
hasFeature :: Feature -> FeatureSet -> Bool
hasFeature :: Feature -> FeatureSet -> Bool
hasFeature = Feature -> FeatureSet -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member


------------------------------------------------------------------------------
-- | Like 'read', but not partial.
readMaybe :: Read a => String -> Maybe a
readMaybe :: String -> Maybe a
readMaybe = ((a, String) -> a) -> Maybe (a, String) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, String) -> a
forall a b. (a, b) -> a
fst (Maybe (a, String) -> Maybe a)
-> (String -> Maybe (a, String)) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, String)] -> Maybe (a, String)
forall a. [a] -> Maybe a
listToMaybe ([(a, String)] -> Maybe (a, String))
-> (String -> [(a, String)]) -> String -> Maybe (a, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(a, String)]
forall a. Read a => ReadS a
reads


featurePrefix :: String
featurePrefix :: String
featurePrefix = String
"Feature"


rot13 :: String -> String
rot13 :: ShowS
rot13 = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Char -> Int) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Integral a => a -> a
rot13int (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)


rot13int :: Integral a => a -> a
rot13int :: a -> a
rot13int a
x
  | (a -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Word) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
97 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
26 = a
97 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a -> a
forall a. Integral a => a -> a -> a
rem (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
84) a
26
  | (a -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Word) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
65 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
26 = a
65 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a -> a
forall a. Integral a => a -> a -> a
rem (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
52) a
26
  | Bool
otherwise   = a
x