{-# LANGUAGE BangPatterns, DefaultSignatures, LambdaCase,
             ScopedTypeVariables #-}
module Frames.ColumnTypeable where
import Control.Monad (MonadPlus)
import Data.Maybe (fromMaybe)
import Data.Readable (Readable(fromText))
import Data.Typeable (Proxy(..), typeRep, Typeable)
import qualified Data.Text as T
import Data.Int (Int32, Int64)
import Data.Vinyl.Functor (Const(..))
import Language.Haskell.TH

data Parsed a = Possibly a | Definitely a deriving (Parsed a -> Parsed a -> Bool
(Parsed a -> Parsed a -> Bool)
-> (Parsed a -> Parsed a -> Bool) -> Eq (Parsed a)
forall a. Eq a => Parsed a -> Parsed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parsed a -> Parsed a -> Bool
$c/= :: forall a. Eq a => Parsed a -> Parsed a -> Bool
== :: Parsed a -> Parsed a -> Bool
$c== :: forall a. Eq a => Parsed a -> Parsed a -> Bool
Eq, Eq (Parsed a)
Eq (Parsed a)
-> (Parsed a -> Parsed a -> Ordering)
-> (Parsed a -> Parsed a -> Bool)
-> (Parsed a -> Parsed a -> Bool)
-> (Parsed a -> Parsed a -> Bool)
-> (Parsed a -> Parsed a -> Bool)
-> (Parsed a -> Parsed a -> Parsed a)
-> (Parsed a -> Parsed a -> Parsed a)
-> Ord (Parsed a)
Parsed a -> Parsed a -> Bool
Parsed a -> Parsed a -> Ordering
Parsed a -> Parsed a -> Parsed a
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
forall a. Ord a => Eq (Parsed a)
forall a. Ord a => Parsed a -> Parsed a -> Bool
forall a. Ord a => Parsed a -> Parsed a -> Ordering
forall a. Ord a => Parsed a -> Parsed a -> Parsed a
min :: Parsed a -> Parsed a -> Parsed a
$cmin :: forall a. Ord a => Parsed a -> Parsed a -> Parsed a
max :: Parsed a -> Parsed a -> Parsed a
$cmax :: forall a. Ord a => Parsed a -> Parsed a -> Parsed a
>= :: Parsed a -> Parsed a -> Bool
$c>= :: forall a. Ord a => Parsed a -> Parsed a -> Bool
> :: Parsed a -> Parsed a -> Bool
$c> :: forall a. Ord a => Parsed a -> Parsed a -> Bool
<= :: Parsed a -> Parsed a -> Bool
$c<= :: forall a. Ord a => Parsed a -> Parsed a -> Bool
< :: Parsed a -> Parsed a -> Bool
$c< :: forall a. Ord a => Parsed a -> Parsed a -> Bool
compare :: Parsed a -> Parsed a -> Ordering
$ccompare :: forall a. Ord a => Parsed a -> Parsed a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Parsed a)
Ord, Int -> Parsed a -> ShowS
[Parsed a] -> ShowS
Parsed a -> String
(Int -> Parsed a -> ShowS)
-> (Parsed a -> String) -> ([Parsed a] -> ShowS) -> Show (Parsed a)
forall a. Show a => Int -> Parsed a -> ShowS
forall a. Show a => [Parsed a] -> ShowS
forall a. Show a => Parsed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parsed a] -> ShowS
$cshowList :: forall a. Show a => [Parsed a] -> ShowS
show :: Parsed a -> String
$cshow :: forall a. Show a => Parsed a -> String
showsPrec :: Int -> Parsed a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Parsed a -> ShowS
Show)

parsedValue :: Parsed a -> a
parsedValue :: Parsed a -> a
parsedValue (Possibly a
a) = a
a
parsedValue (Definitely a
a) = a
a

instance Functor Parsed where
  fmap :: (a -> b) -> Parsed a -> Parsed b
fmap a -> b
f (Possibly a
x) = b -> Parsed b
forall a. a -> Parsed a
Possibly (a -> b
f a
x)
  fmap a -> b
f (Definitely a
x) = b -> Parsed b
forall a. a -> Parsed a
Definitely (a -> b
f a
x)

-- | Values that can be read from a 'T.Text' with more or less
-- discrimination.
class Parseable a where
  -- | Returns 'Nothing' if a value of the given type can not be read;
  -- returns 'Just Possibly' if a value can be read, but is likely
  -- ambiguous (e.g. an empty string); returns 'Just Definitely' if a
  -- value can be read and is unlikely to be ambiguous."
  parse :: MonadPlus m => T.Text -> m (Parsed a)
  default parse :: (Readable a, MonadPlus m)
                => T.Text -> m (Parsed a)
  parse = (a -> Parsed a) -> m a -> m (Parsed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Parsed a
forall a. a -> Parsed a
Definitely (m a -> m (Parsed a)) -> (Text -> m a) -> Text -> m (Parsed a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m a
forall a (m :: * -> *). (Readable a, MonadPlus m) => Text -> m a
fromText
  {-# INLINE parse #-}

  -- | Combine two parse results such that the combination can
  -- fail. Useful when we have two 'Possibly' parsed values that are
  -- different enough to suggest the parse of each should be
  -- considered a failure. The default implementation is to 'return'
  -- the first argument.
  parseCombine :: MonadPlus m => Parsed a -> Parsed a -> m (Parsed a)
  default parseCombine :: MonadPlus m => Parsed a -> Parsed a -> m (Parsed a)
  parseCombine = m (Parsed a) -> Parsed a -> m (Parsed a)
forall a b. a -> b -> a
const (m (Parsed a) -> Parsed a -> m (Parsed a))
-> (Parsed a -> m (Parsed a))
-> Parsed a
-> Parsed a
-> m (Parsed a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsed a -> m (Parsed a)
forall (m :: * -> *) a. Monad m => a -> m a
return

  representableAsType :: Parsed a -> Const (Either (String -> Q [Dec]) Type) a
  default
    representableAsType :: Typeable a
                        => Parsed a -> Const (Either (String -> Q [Dec]) Type) a
  representableAsType =
    Const (Either (String -> Q [Dec]) Type) a
-> Parsed a -> Const (Either (String -> Q [Dec]) Type) a
forall a b. a -> b -> a
const (Either (String -> Q [Dec]) Type
-> Const (Either (String -> Q [Dec]) Type) a
forall k a (b :: k). a -> Const a b
Const (Type -> Either (String -> Q [Dec]) Type
forall a b. b -> Either a b
Right (Name -> Type
ConT (String -> Name
mkName (TypeRep -> String
forall a. Show a => a -> String
show (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)))))))

-- | Discard any estimate of a parse's ambiguity.
discardConfidence :: Parsed a -> a
discardConfidence :: Parsed a -> a
discardConfidence (Possibly a
x) = a
x
discardConfidence (Definitely a
x) = a
x

-- | Acts just like 'fromText': tries to parse a value from a 'T.Text'
-- and discards any estimate of the parse's ambiguity.
parse' :: (MonadPlus m, Parseable a) => T.Text -> m a
parse' :: Text -> m a
parse' = (Parsed a -> a) -> m (Parsed a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Parsed a -> a
forall a. Parsed a -> a
discardConfidence (m (Parsed a) -> m a) -> (Text -> m (Parsed a)) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m (Parsed a)
forall a (m :: * -> *).
(Parseable a, MonadPlus m) =>
Text -> m (Parsed a)
parse

parseIntish :: (Readable a, MonadPlus f) => T.Text -> f (Parsed a)
parseIntish :: Text -> f (Parsed a)
parseIntish Text
t =
  a -> Parsed a
forall a. a -> Parsed a
Definitely (a -> Parsed a) -> f a -> f (Parsed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f a
forall a (m :: * -> *). (Readable a, MonadPlus m) => Text -> m a
fromText (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t (Text -> Text -> Maybe Text
T.stripSuffix (String -> Text
T.pack String
".0") Text
t))

instance Parseable Bool where

instance Parseable Int where
  parse :: Text -> m (Parsed Int)
parse = Text -> m (Parsed Int)
forall a (f :: * -> *).
(Readable a, MonadPlus f) =>
Text -> f (Parsed a)
parseIntish
instance Parseable Int32 where
  parse :: Text -> m (Parsed Int32)
parse = Text -> m (Parsed Int32)
forall a (f :: * -> *).
(Readable a, MonadPlus f) =>
Text -> f (Parsed a)
parseIntish
instance Parseable Int64 where
  parse :: Text -> m (Parsed Int64)
parse = Text -> m (Parsed Int64)
forall a (f :: * -> *).
(Readable a, MonadPlus f) =>
Text -> f (Parsed a)
parseIntish
instance Parseable Integer where
  parse :: Text -> m (Parsed Integer)
parse = Text -> m (Parsed Integer)
forall a (f :: * -> *).
(Readable a, MonadPlus f) =>
Text -> f (Parsed a)
parseIntish

instance Parseable Float where
instance Parseable Double where
  -- Some CSV's export Doubles in a format like '1,000.00', filtering
  -- out commas lets us parse those sucessfully
  parse :: Text -> m (Parsed Double)
parse = (Double -> Parsed Double) -> m Double -> m (Parsed Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Parsed Double
forall a. a -> Parsed a
Definitely (m Double -> m (Parsed Double))
-> (Text -> m Double) -> Text -> m (Parsed Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Double
forall a (m :: * -> *). (Readable a, MonadPlus m) => Text -> m a
fromText (Text -> m Double) -> (Text -> Text) -> Text -> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',')
instance Parseable T.Text where

-- | This class relates a universe of possible column types to Haskell
-- types, and provides a mechanism to infer which type best represents
-- some textual data.
class ColumnTypeable a where
  colType :: a -> Either (String -> Q [Dec]) Type
  inferType :: T.Text -> a